module_advect_em_ad.F
References to this file elsewhere.
1 ! DISCLAIMER
2 !
3 ! This file was generated by TAF version 1.7.18
4 !
5 ! FASTOPT DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED,
6 ! INCLUDING (WITHOUT LIMITATION) ALL IMPLIED WARRANTIES OF
7 ! MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, WITH
8 ! RESPECT TO THE SOFTWARE AND USER PROGRAMS. IN NO EVENT
9 ! SHALL FASTOPT BE LIABLE FOR ANY LOST OR ANTICIPATED PROF-
10 ! ITS, OR ANY INDIRECT, INCIDENTAL, EXEMPLARY, SPECIAL, OR
11 ! CONSEQUENTIAL DAMAGES, WHETHER OR NOT FASTOPT WAS ADVISED
12 ! OF THE POSSIBILITY OF SUCH DAMAGES.
13 !
14 ! Haftungsbeschraenkung
15 ! FastOpt gibt ausdruecklich keine Gewaehr, explizit oder indirekt,
16 ! bezueglich der Brauchbarkeit der Software fuer einen bestimmten
17 ! Zweck. Unter keinen Umstaenden ist FastOpt haftbar fuer
18 ! irgendeinen Verlust oder nicht eintretenden erwarteten Gewinn und
19 ! allen indirekten, zufaelligen, exemplarischen oder speziellen
20 ! Schaeden oder Folgeschaeden unabhaengig von einer eventuellen
21 ! Mitteilung darueber an FastOpt.
22 !
23 module a_module_advect_em
24 !******************************************************************
25 !******************************************************************
26 !** This routine was generated by Automatic differentiation. **
27 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
28 !******************************************************************
29 !******************************************************************
30 !==============================================
31 ! referencing used modules
32 !==============================================
33 use module_bc
34 use a_module_bc
35 use module_model_constants
36 use module_wrf_error
37 use module_advect_em
38
39 !==============================================
40 ! all entries are defined explicitly
41 !==============================================
42 implicit none
43
44 contains
45 subroutine a_advect_scalar( field, a_field, field_old, a_field_old, a_tendency, ru, a_ru, rv, a_rv, rom, a_rom, config_flags, msft,&
46 & fzm, fzp, rdx, rdy, rdzw, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
47 !******************************************************************
48 !******************************************************************
49 !** This routine was generated by Automatic differentiation. **
50 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
51 !******************************************************************
52 !******************************************************************
53 !==============================================
54 ! all entries are defined explicitly
55 !==============================================
56 implicit none
57
58 !==============================================
59 ! declare arguments
60 !==============================================
61 integer, intent(in) :: ime
62 integer, intent(in) :: ims
63 integer, intent(in) :: jme
64 integer, intent(in) :: jms
65 integer, intent(in) :: kme
66 integer, intent(in) :: kms
67 real, intent(inout) :: a_field(ims:ime,kms:kme,jms:jme)
68 real, intent(inout) :: a_field_old(ims:ime,kms:kme,jms:jme)
69 real, intent(inout) :: a_rom(ims:ime,kms:kme,jms:jme)
70 real, intent(inout) :: a_ru(ims:ime,kms:kme,jms:jme)
71 real, intent(inout) :: a_rv(ims:ime,kms:kme,jms:jme)
72 real, intent(inout) :: a_tendency(ims:ime,kms:kme,jms:jme)
73 type (grid_config_rec_type), intent(in) :: config_flags
74 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
75 real, intent(in) :: field_old(ims:ime,kms:kme,jms:jme)
76 real, intent(in) :: fzm(kms:kme)
77 real, intent(in) :: fzp(kms:kme)
78 integer, intent(in) :: ide
79 integer, intent(in) :: ids
80 integer, intent(in) :: ite
81 integer, intent(in) :: its
82 integer, intent(in) :: jde
83 integer, intent(in) :: jds
84 integer, intent(in) :: jte
85 integer, intent(in) :: jts
86 integer, intent(in) :: kde
87 integer, intent(in) :: kte
88 integer, intent(in) :: kts
89 real, intent(in) :: msft(ims:ime,jms:jme)
90 real, intent(in) :: rdx
91 real, intent(in) :: rdy
92 real, intent(in) :: rdzw(kms:kme)
93 real, intent(in) :: rom(ims:ime,kms:kme,jms:jme)
94 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
95 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
96
97 !==============================================
98 ! declare local variables
99 !==============================================
100 real a_fqx(its:ite+1,kts:kte)
101 real a_fqy(its:ite,kts:kte,2)
102 real a_ub
103 real a_vb
104 real a_vel
105 real a_vflux(its:ite,kts:kte)
106 logical degrade_xe
107 logical degrade_xs
108 logical degrade_ye
109 logical degrade_ys
110 integer horz_order
111 integer i
112 integer i_end
113 integer i_end_f
114 integer i_start
115 integer i_start_f
116 integer j
117 integer j1
118 integer j2
119 integer j3
120 integer j4
121 integer j_end
122 integer j_end_f
123 integer j_start
124 integer j_start_f
125 integer jp0
126 integer jp1
127 integer jtmp
128 integer k
129 integer ktf
130 real mrdx
131 real mrdy
132 logical specified
133 real ub
134 real vb
135 real vel
136 integer vert_order
137
138 !----------------------------------------------
139 ! RESET LOCAL ADJOINT VARIABLES
140 !----------------------------------------------
141 a_fqx(:,:) = 0.
142 a_fqy(:,:,:) = 0.
143 a_ub = 0.
144 a_vb = 0.
145 a_vel = 0.
146 a_vflux(:,:) = 0.
147
148 !----------------------------------------------
149 ! ROUTINE BODY
150 !----------------------------------------------
151 specified = .false.
152 ! recompute : specified
153 if (config_flags%specified .or. config_flags%nested) then
154 specified = .true.
155 endif
156 ! recompute : specified
157 ktf = min(kte,kde-1)
158 ! recompute : ktf
159 horz_order = config_flags%h_sca_adv_order
160 ! recompute : horz_order
161 vert_order = config_flags%v_sca_adv_order
162 ! recompute : vert_order
163 horizontal_order_tesu: if (horz_order .eq. 6) then
164 ktf = min(kte,kde-1)
165 else if (horz_order .eq. 5) then horizontal_order_tesu
166 ktf = min(kte,kde-1)
167 else if (horz_order .eq. 4) then horizontal_order_tesu
168 ktf = min(kte,kde-1)
169 else if (horz_order .eq. 3) then horizontal_order_tesu
170 ktf = min(kte,kde-1)
171 endif horizontal_order_tesu
172 ! recompute : ktf
173 i_start = its
174 ! recompute : i_start
175 i_end = min(ite,ide-1)
176 ! recompute : i_end
177 j_start = jts
178 ! recompute : j_start
179 j_end = min(jte,jde-1)
180 ! recompute : j_end
181 a_vert_order_test: if (vert_order .eq. 6) then
182 do j = j_end, j_start, -1
183 do k = kts, ktf
184 do i = i_start, i_end
185 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
186 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
187 end do
188 end do
189 do i = i_start, i_end
190 a_vel = 0.
191 k = ktf-1
192 ! recompute : k
193 vel = rom(i,k,j)
194 ! recompute : vel
195 k = ktf
196 ! recompute : k
197 a_field(i,k-1,j) = a_field(i,k-1,j)+a_vflux(i,k)*rom(i,k,j)*fzp(k)
198 a_field(i,k,j) = a_field(i,k,j)+a_vflux(i,k)*rom(i,k,j)*fzm(k)
199 a_rom(i,k,j) = a_rom(i,k,j)+a_vflux(i,k)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
200 a_vflux(i,k) = 0.
201 ! recdepend vars : ktf
202 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3728
203 ! recompute vars : k
204 k = ktf-1
205 ! recompute vars : k
206 a_field(i,k-2,j) = a_field(i,k-2,j)-0.083333333*a_vflux(i,k)*vel
207 a_field(i,k-1,j) = a_field(i,k-1,j)+0.58333333*a_vflux(i,k)*vel
208 a_field(i,k+1,j) = a_field(i,k+1,j)-0.083333333*a_vflux(i,k)*vel
209 a_field(i,k,j) = a_field(i,k,j)+0.58333333*a_vflux(i,k)*vel
210 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(field(i,k,j)+field(i,k-1,j))-0.083333333*(field(i,k+1,j)+field(i,k-2,j)))
211 a_vflux(i,k) = 0.
212 ! recdepend vars : ktf
213 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3728
214 ! recompute vars : k
215 k = ktf-1
216 ! recompute vars : k
217 a_rom(i,k,j) = a_rom(i,k,j)+a_vel
218 a_vel = 0.
219 ! recdepend vars : kts
220 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3723
221 ! recompute vars : k
222 k = kts+2
223 ! recompute vars : k
224 ! recdepend vars : i,j,k,rom
225 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3724
226 ! recompute vars : vel
227 vel = rom(i,k,j)
228 ! recompute vars : vel
229 a_field(i,k-2,j) = a_field(i,k-2,j)-0.083333333*a_vflux(i,k)*vel
230 a_field(i,k-1,j) = a_field(i,k-1,j)+0.58333333*a_vflux(i,k)*vel
231 a_field(i,k+1,j) = a_field(i,k+1,j)-0.083333333*a_vflux(i,k)*vel
232 a_field(i,k,j) = a_field(i,k,j)+0.58333333*a_vflux(i,k)*vel
233 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(field(i,k,j)+field(i,k-1,j))-0.083333333*(field(i,k+1,j)+field(i,k-2,j)))
234 a_vflux(i,k) = 0.
235 ! recdepend vars : kts
236 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3723
237 ! recompute vars : k
238 k = kts+2
239 ! recompute vars : k
240 a_rom(i,k,j) = a_rom(i,k,j)+a_vel
241 a_vel = 0.
242 ! recdepend vars : kts
243 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3720
244 ! recompute vars : k
245 k = kts+1
246 ! recompute vars : k
247 a_field(i,k-1,j) = a_field(i,k-1,j)+a_vflux(i,k)*rom(i,k,j)*fzp(k)
248 a_field(i,k,j) = a_field(i,k,j)+a_vflux(i,k)*rom(i,k,j)*fzm(k)
249 a_rom(i,k,j) = a_rom(i,k,j)+a_vflux(i,k)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
250 a_vflux(i,k) = 0.
251 end do
252 do k = kts+3, ktf-2
253 a_vel = 0.
254 do i = i_start, i_end
255 a_vel = 0.
256 vel = rom(i,k,j)
257 ! recompute : vel
258 a_field(i,k-3,j) = a_field(i,k-3,j)+0.016666667*a_vflux(i,k)*vel
259 a_field(i,k-2,j) = a_field(i,k-2,j)-0.13333333*a_vflux(i,k)*vel
260 a_field(i,k-1,j) = a_field(i,k-1,j)+0.61666667*a_vflux(i,k)*vel
261 a_field(i,k+2,j) = a_field(i,k+2,j)+0.016666667*a_vflux(i,k)*vel
262 a_field(i,k+1,j) = a_field(i,k+1,j)-0.13333333*a_vflux(i,k)*vel
263 a_field(i,k,j) = a_field(i,k,j)+0.61666667*a_vflux(i,k)*vel
264 a_vel = a_vel+a_vflux(i,k)*(0.61666667*(field(i,k,j)+field(i,k-1,j))-0.13333333*(field(i,k+1,j)+field(i,k-2,j))+&
265 &0.016666667*(field(i,k+2,j)+field(i,k-3,j)))
266 a_vflux(i,k) = 0.
267 a_rom(i,k,j) = a_rom(i,k,j)+a_vel
268 a_vel = 0.
269 end do
270 end do
271 end do
272 else if (vert_order .eq. 5) then a_vert_order_test
273 do j = j_end, j_start, -1
274 do k = kts, ktf
275 do i = i_start, i_end
276 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
277 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
278 end do
279 end do
280 do i = i_start, i_end
281 a_vel = 0.
282 k = ktf-1
283 ! recompute : k
284 vel = rom(i,k,j)
285 ! recompute : vel
286 k = ktf
287 ! recompute : k
288 a_field(i,k-1,j) = a_field(i,k-1,j)+a_vflux(i,k)*rom(i,k,j)*fzp(k)
289 a_field(i,k,j) = a_field(i,k,j)+a_vflux(i,k)*rom(i,k,j)*fzm(k)
290 a_rom(i,k,j) = a_rom(i,k,j)+a_vflux(i,k)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
291 a_vflux(i,k) = 0.
292 ! recdepend vars : ktf
293 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3769
294 ! recompute vars : k
295 k = ktf-1
296 ! recompute vars : k
297 a_field(i,k-2,j) = a_field(i,k-2,j)+a_vflux(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))
298 a_field(i,k-1,j) = a_field(i,k-1,j)+a_vflux(i,k)*vel*(0.58333333+0.25*sign(1.,-vel))
299 a_field(i,k+1,j) = a_field(i,k+1,j)+a_vflux(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))
300 a_field(i,k,j) = a_field(i,k,j)+a_vflux(i,k)*vel*(0.58333333+(-0.25)*sign(1.,-vel))
301 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(field(i,k,j)+field(i,k-1,j))-0.083333333*(field(i,k+1,j)+field(i,k-2,j))+0.083333333*&
302 &(field(i,k+1,j)-field(i,k-2,j)-3.*(field(i,k,j)-field(i,k-1,j)))*sign(1.,-vel))
303 a_vflux(i,k) = 0.
304 ! recdepend vars : ktf
305 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3769
306 ! recompute vars : k
307 k = ktf-1
308 ! recompute vars : k
309 a_rom(i,k,j) = a_rom(i,k,j)+a_vel
310 a_vel = 0.
311 ! recdepend vars : kts
312 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3764
313 ! recompute vars : k
314 k = kts+2
315 ! recompute vars : k
316 ! recdepend vars : i,j,k,rom
317 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3765
318 ! recompute vars : vel
319 vel = rom(i,k,j)
320 ! recompute vars : vel
321 a_field(i,k-2,j) = a_field(i,k-2,j)+a_vflux(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))
322 a_field(i,k-1,j) = a_field(i,k-1,j)+a_vflux(i,k)*vel*(0.58333333+0.25*sign(1.,-vel))
323 a_field(i,k+1,j) = a_field(i,k+1,j)+a_vflux(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))
324 a_field(i,k,j) = a_field(i,k,j)+a_vflux(i,k)*vel*(0.58333333+(-0.25)*sign(1.,-vel))
325 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(field(i,k,j)+field(i,k-1,j))-0.083333333*(field(i,k+1,j)+field(i,k-2,j))+0.083333333*&
326 &(field(i,k+1,j)-field(i,k-2,j)-3.*(field(i,k,j)-field(i,k-1,j)))*sign(1.,-vel))
327 a_vflux(i,k) = 0.
328 ! recdepend vars : kts
329 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3764
330 ! recompute vars : k
331 k = kts+2
332 ! recompute vars : k
333 a_rom(i,k,j) = a_rom(i,k,j)+a_vel
334 a_vel = 0.
335 ! recdepend vars : kts
336 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3761
337 ! recompute vars : k
338 k = kts+1
339 ! recompute vars : k
340 a_field(i,k-1,j) = a_field(i,k-1,j)+a_vflux(i,k)*rom(i,k,j)*fzp(k)
341 a_field(i,k,j) = a_field(i,k,j)+a_vflux(i,k)*rom(i,k,j)*fzm(k)
342 a_rom(i,k,j) = a_rom(i,k,j)+a_vflux(i,k)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
343 a_vflux(i,k) = 0.
344 end do
345 do k = kts+3, ktf-2
346 a_vel = 0.
347 do i = i_start, i_end
348 a_vel = 0.
349 vel = rom(i,k,j)
350 ! recompute : vel
351 a_field(i,k-3,j) = a_field(i,k-3,j)+a_vflux(i,k)*vel*(0.016666667-(-0.016666667)*sign(1.,-vel))
352 a_field(i,k-2,j) = a_field(i,k-2,j)+a_vflux(i,k)*vel*((-0.13333333)-0.083333333*sign(1.,-vel))
353 a_field(i,k-1,j) = a_field(i,k-1,j)+a_vflux(i,k)*vel*(0.61666667-(-0.16666667)*sign(1.,-vel))
354 a_field(i,k+2,j) = a_field(i,k+2,j)+a_vflux(i,k)*vel*(0.016666667-0.016666667*sign(1.,-vel))
355 a_field(i,k+1,j) = a_field(i,k+1,j)+a_vflux(i,k)*vel*((-0.13333333)-(-0.083333333)*sign(1.,-vel))
356 a_field(i,k,j) = a_field(i,k,j)+a_vflux(i,k)*vel*(0.61666667-0.16666667*sign(1.,-vel))
357 a_vel = a_vel+a_vflux(i,k)*(0.61666667*(field(i,k,j)+field(i,k-1,j))-0.13333333*(field(i,k+1,j)+field(i,k-2,j))+&
358 &0.016666667*(field(i,k+2,j)+field(i,k-3,j))-0.016666667*(field(i,k+2,j)-field(i,k-3,j)-5.*(field(i,k+1,j)-field(i,k-2,j))+&
359 &10.*(field(i,k,j)-field(i,k-1,j)))*sign(1.,-vel))
360 a_vflux(i,k) = 0.
361 a_rom(i,k,j) = a_rom(i,k,j)+a_vel
362 a_vel = 0.
363 end do
364 end do
365 end do
366 else if (vert_order .eq. 4) then a_vert_order_test
367 do j = j_end, j_start, -1
368 do k = kts, ktf
369 do i = i_start, i_end
370 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
371 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
372 end do
373 end do
374 do i = i_start, i_end
375 k = ktf
376 ! recompute : k
377 a_field(i,k-1,j) = a_field(i,k-1,j)+a_vflux(i,k)*rom(i,k,j)*fzp(k)
378 a_field(i,k,j) = a_field(i,k,j)+a_vflux(i,k)*rom(i,k,j)*fzm(k)
379 a_rom(i,k,j) = a_rom(i,k,j)+a_vflux(i,k)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
380 a_vflux(i,k) = 0.
381 ! recdepend vars : kts
382 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3802
383 ! recompute vars : k
384 k = kts+1
385 ! recompute vars : k
386 a_field(i,k-1,j) = a_field(i,k-1,j)+a_vflux(i,k)*rom(i,k,j)*fzp(k)
387 a_field(i,k,j) = a_field(i,k,j)+a_vflux(i,k)*rom(i,k,j)*fzm(k)
388 a_rom(i,k,j) = a_rom(i,k,j)+a_vflux(i,k)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
389 a_vflux(i,k) = 0.
390 end do
391 do k = kts+2, ktf-1
392 a_vel = 0.
393 do i = i_start, i_end
394 a_vel = 0.
395 vel = rom(i,k,j)
396 ! recompute : vel
397 a_field(i,k-2,j) = a_field(i,k-2,j)-0.083333333*a_vflux(i,k)*vel
398 a_field(i,k-1,j) = a_field(i,k-1,j)+0.58333333*a_vflux(i,k)*vel
399 a_field(i,k+1,j) = a_field(i,k+1,j)-0.083333333*a_vflux(i,k)*vel
400 a_field(i,k,j) = a_field(i,k,j)+0.58333333*a_vflux(i,k)*vel
401 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(field(i,k,j)+field(i,k-1,j))-0.083333333*(field(i,k+1,j)+field(i,k-2,j)))
402 a_vflux(i,k) = 0.
403 a_rom(i,k,j) = a_rom(i,k,j)+a_vel
404 a_vel = 0.
405 end do
406 end do
407 end do
408 else if (vert_order .eq. 3) then a_vert_order_test
409 do j = j_end, j_start, -1
410 do k = kts, ktf
411 do i = i_start, i_end
412 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
413 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
414 end do
415 end do
416 do i = i_start, i_end
417 k = ktf
418 ! recompute : k
419 a_field(i,k-1,j) = a_field(i,k-1,j)+a_vflux(i,k)*rom(i,k,j)*fzp(k)
420 a_field(i,k,j) = a_field(i,k,j)+a_vflux(i,k)*rom(i,k,j)*fzm(k)
421 a_rom(i,k,j) = a_rom(i,k,j)+a_vflux(i,k)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
422 a_vflux(i,k) = 0.
423 ! recdepend vars : kts
424 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3831
425 ! recompute vars : k
426 k = kts+1
427 ! recompute vars : k
428 a_field(i,k-1,j) = a_field(i,k-1,j)+a_vflux(i,k)*rom(i,k,j)*fzp(k)
429 a_field(i,k,j) = a_field(i,k,j)+a_vflux(i,k)*rom(i,k,j)*fzm(k)
430 a_rom(i,k,j) = a_rom(i,k,j)+a_vflux(i,k)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
431 a_vflux(i,k) = 0.
432 end do
433 do k = kts+2, ktf-1
434 a_vel = 0.
435 do i = i_start, i_end
436 a_vel = 0.
437 vel = rom(i,k,j)
438 ! recompute : vel
439 a_field(i,k-2,j) = a_field(i,k-2,j)+a_vflux(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))
440 a_field(i,k-1,j) = a_field(i,k-1,j)+a_vflux(i,k)*vel*(0.58333333+0.25*sign(1.,-vel))
441 a_field(i,k+1,j) = a_field(i,k+1,j)+a_vflux(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))
442 a_field(i,k,j) = a_field(i,k,j)+a_vflux(i,k)*vel*(0.58333333+(-0.25)*sign(1.,-vel))
443 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(field(i,k,j)+field(i,k-1,j))-0.083333333*(field(i,k+1,j)+field(i,k-2,j))+&
444 &0.083333333*(field(i,k+1,j)-field(i,k-2,j)-3.*(field(i,k,j)-field(i,k-1,j)))*sign(1.,-vel))
445 a_vflux(i,k) = 0.
446 a_rom(i,k,j) = a_rom(i,k,j)+a_vel
447 a_vel = 0.
448 end do
449 end do
450 end do
451 else if (vert_order .eq. 2) then a_vert_order_test
452 do j = j_start, j_end
453 do k = kts, ktf
454 do i = i_start, i_end
455 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
456 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
457 end do
458 end do
459 do k = kts+1, ktf
460 do i = i_start, i_end
461 a_field(i,k-1,j) = a_field(i,k-1,j)+a_vflux(i,k)*rom(i,k,j)*fzp(k)
462 a_field(i,k,j) = a_field(i,k,j)+a_vflux(i,k)*rom(i,k,j)*fzm(k)
463 a_rom(i,k,j) = a_rom(i,k,j)+a_vflux(i,k)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
464 a_vflux(i,k) = 0.
465 end do
466 end do
467 end do
468 endif a_vert_order_test
469 ! recdepend vars : its
470 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3621
471 ! recompute vars : i_start
472 i_start = its
473 ! recompute vars : i_start
474 ! recdepend vars : i_start,ide,ite
475 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3622
476 ! recompute vars : i_end
477 i_end = min(ite,ide-1)
478 ! recompute vars : i_end
479 ! recdepend vars : i_end,i_start,jde,jte
480 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3624
481 ! recompute vars : j_end
482 j_end = min(jte,jde-1)
483 ! recompute vars : j_end
484 if (config_flags%open_ye .and. jte .eq. jde) then
485 do i = i_start, i_end
486 a_vb = 0.
487 do k = kts, ktf
488 a_vb = 0.
489 vb = max(0.5*(rv(i,k,jte-1)+rv(i,k,jte)),0.)
490 ! recompute : vb
491 a_field(i,k,j_end) = a_field(i,k,j_end)-a_tendency(i,k,j_end)*rdy*(rv(i,k,jte)-rv(i,k,jte-1))
492 a_field_old(i,k,j_end-1) = a_field_old(i,k,j_end-1)+a_tendency(i,k,j_end)*rdy*vb
493 a_field_old(i,k,j_end) = a_field_old(i,k,j_end)-a_tendency(i,k,j_end)*rdy*vb
494 a_rv(i,k,jte-1) = a_rv(i,k,jte-1)+a_tendency(i,k,j_end)*rdy*field(i,k,j_end)
495 a_rv(i,k,jte) = a_rv(i,k,jte)-a_tendency(i,k,j_end)*rdy*field(i,k,j_end)
496 a_vb = a_vb-a_tendency(i,k,j_end)*rdy*(field_old(i,k,j_end)-field_old(i,k,j_end-1))
497 a_rv(i,k,jte-1) = a_rv(i,k,jte-1)+0.5*a_vb*(0.5+sign(0.5,0.5*(rv(i,k,jte-1)+rv(i,k,jte))-0.))
498 a_rv(i,k,jte) = a_rv(i,k,jte)+0.5*a_vb*(0.5+sign(0.5,0.5*(rv(i,k,jte-1)+rv(i,k,jte))-0.))
499 a_vb = 0.
500 end do
501 end do
502 endif
503 ! recdepend vars : its
504 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3621
505 ! recompute vars : i_start
506 i_start = its
507 ! recompute vars : i_start
508 ! recdepend vars : i_start,ide,ite
509 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3622
510 ! recompute vars : i_end
511 i_end = min(ite,ide-1)
512 ! recompute vars : i_end
513 if (config_flags%open_ys .and. jts .eq. jds) then
514 do i = i_start, i_end
515 a_vb = 0.
516 do k = kts, ktf
517 a_vb = 0.
518 vb = min(0.5*(rv(i,k,jts)+rv(i,k,jts+1)),0.)
519 ! recompute : vb
520 a_field(i,k,jts) = a_field(i,k,jts)-a_tendency(i,k,jts)*rdy*(rv(i,k,jts+1)-rv(i,k,jts))
521 a_field_old(i,k,jts+1) = a_field_old(i,k,jts+1)-a_tendency(i,k,jts)*rdy*vb
522 a_field_old(i,k,jts) = a_field_old(i,k,jts)+a_tendency(i,k,jts)*rdy*vb
523 a_rv(i,k,jts+1) = a_rv(i,k,jts+1)-a_tendency(i,k,jts)*rdy*field(i,k,jts)
524 a_rv(i,k,jts) = a_rv(i,k,jts)+a_tendency(i,k,jts)*rdy*field(i,k,jts)
525 a_vb = a_vb-a_tendency(i,k,jts)*rdy*(field_old(i,k,jts+1)-field_old(i,k,jts))
526 a_rv(i,k,jts+1) = a_rv(i,k,jts+1)+0.5*a_vb*(0.5+sign(0.5,0.-0.5*(rv(i,k,jts)+rv(i,k,jts+1))))
527 a_rv(i,k,jts) = a_rv(i,k,jts)+0.5*a_vb*(0.5+sign(0.5,0.-0.5*(rv(i,k,jts)+rv(i,k,jts+1))))
528 a_vb = 0.
529 end do
530 end do
531 endif
532 ! recdepend vars : ide,ite
533 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3622
534 ! recompute vars : i_end
535 i_end = min(ite,ide-1)
536 ! recompute vars : i_end
537 ! recdepend vars : i_end,jts
538 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3623
539 ! recompute vars : j_start
540 j_start = jts
541 ! recompute vars : j_start
542 ! recdepend vars : i_end,j_start,jde,jte
543 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3624
544 ! recompute vars : j_end
545 j_end = min(jte,jde-1)
546 ! recompute vars : j_end
547 if (config_flags%open_xe .and. ite .eq. ide) then
548 do j = j_start, j_end
549 a_ub = 0.
550 do k = kts, ktf
551 a_ub = 0.
552 ub = max(0.5*(ru(ite-1,k,j)+ru(ite,k,j)),0.)
553 ! recompute : ub
554 a_field(i_end,k,j) = a_field(i_end,k,j)-a_tendency(i_end,k,j)*rdx*(ru(ite,k,j)-ru(ite-1,k,j))
555 a_field_old(i_end-1,k,j) = a_field_old(i_end-1,k,j)+a_tendency(i_end,k,j)*rdx*ub
556 a_field_old(i_end,k,j) = a_field_old(i_end,k,j)-a_tendency(i_end,k,j)*rdx*ub
557 a_ru(ite-1,k,j) = a_ru(ite-1,k,j)+a_tendency(i_end,k,j)*rdx*field(i_end,k,j)
558 a_ru(ite,k,j) = a_ru(ite,k,j)-a_tendency(i_end,k,j)*rdx*field(i_end,k,j)
559 a_ub = a_ub-a_tendency(i_end,k,j)*rdx*(field_old(i_end,k,j)-field_old(i_end-1,k,j))
560 a_ru(ite-1,k,j) = a_ru(ite-1,k,j)+0.5*a_ub*(0.5+sign(0.5,0.5*(ru(ite-1,k,j)+ru(ite,k,j))-0.))
561 a_ru(ite,k,j) = a_ru(ite,k,j)+0.5*a_ub*(0.5+sign(0.5,0.5*(ru(ite-1,k,j)+ru(ite,k,j))-0.))
562 a_ub = 0.
563 end do
564 end do
565 endif
566 ! recdepend vars : jts
567 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3623
568 ! recompute vars : j_start
569 j_start = jts
570 ! recompute vars : j_start
571 ! recdepend vars : j_start,jde,jte
572 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3624
573 ! recompute vars : j_end
574 j_end = min(jte,jde-1)
575 ! recompute vars : j_end
576 if (config_flags%open_xs .and. its .eq. ids) then
577 do j = j_start, j_end
578 a_ub = 0.
579 do k = kts, ktf
580 a_ub = 0.
581 ub = min(0.5*(ru(its,k,j)+ru(its+1,k,j)),0.)
582 ! recompute : ub
583 a_field(its,k,j) = a_field(its,k,j)-a_tendency(its,k,j)*rdx*(ru(its+1,k,j)-ru(its,k,j))
584 a_field_old(its+1,k,j) = a_field_old(its+1,k,j)-a_tendency(its,k,j)*rdx*ub
585 a_field_old(its,k,j) = a_field_old(its,k,j)+a_tendency(its,k,j)*rdx*ub
586 a_ru(its+1,k,j) = a_ru(its+1,k,j)-a_tendency(its,k,j)*rdx*field(its,k,j)
587 a_ru(its,k,j) = a_ru(its,k,j)+a_tendency(its,k,j)*rdx*field(its,k,j)
588 a_ub = a_ub-a_tendency(its,k,j)*rdx*(field_old(its+1,k,j)-field_old(its,k,j))
589 a_ru(its+1,k,j) = a_ru(its+1,k,j)+0.5*a_ub*(0.5+sign(0.5,0.-0.5*(ru(its,k,j)+ru(its+1,k,j))))
590 a_ru(its,k,j) = a_ru(its,k,j)+0.5*a_ub*(0.5+sign(0.5,0.-0.5*(ru(its,k,j)+ru(its+1,k,j))))
591 a_ub = 0.
592 end do
593 end do
594 endif
595 ! recdepend vars : kde,kte
596 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2795
597 ! recompute vars : ktf
598 ktf = min(kte,kde-1)
599 ! recompute vars : ktf
600 a_horizontal_order_test: if (horz_order .eq. 6) then
601 degrade_xs = .true.
602 ! recompute : degrade_xs
603 degrade_xe = .true.
604 ! recompute : degrade_xe
605 degrade_ys = .true.
606 ! recompute : degrade_ys
607 degrade_ye = .true.
608 ! recompute : degrade_ye
609 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
610 degrade_xs = .false.
611 endif
612 ! recompute : degrade_xs
613 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-3) then
614 degrade_xe = .false.
615 endif
616 ! recompute : degrade_xe
617 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
618 degrade_ys = .false.
619 endif
620 ! recompute : degrade_ys
621 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-3) then
622 degrade_ye = .false.
623 endif
624 ! recompute : degrade_ye
625 ! recompute : ktf
626 j_start = jts
627 ! recompute : j_start
628 j_end = min(jte,jde-1)
629 ! recompute : j_end
630 j_start_f = j_start
631 ! recompute : j_start_f
632 j_end_f = j_end+1
633 ! recompute : j_end_f
634 if (degrade_ys) then
635 j_start_f = jds+3
636 endif
637 ! recompute : j_start_f
638 if (degrade_ye) then
639 j_end_f = jde-3
640 endif
641 ! recompute : j_end_f
642 i_start = its
643 ! recompute : i_start
644 i_end = min(ite,ide-1)
645 ! recompute : i_end
646 j_start = jts
647 ! recompute : j_start
648 j_end = min(jte,jde-1)
649 ! recompute : j_end
650 i_start_f = i_start
651 ! recompute : i_start_f
652 i_end_f = i_end+1
653 ! recompute : i_end_f
654 if (degrade_xs) then
655 i_start = max(ids+1,its)
656 i_start_f = i_start+2
657 endif
658 ! recompute : i_start,i_start_f
659 if (degrade_xe) then
660 i_end = min(ide-2,ite)
661 i_end_f = ide-3
662 endif
663 ! recompute : i_end,i_end_f
664 do j = j_end, j_start, -1
665 do k = kts, ktf
666 do i = i_start, i_end
667 mrdx = msft(i,j)*rdx
668 ! recompute : mrdx
669 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
670 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
671 end do
672 end do
673 if (degrade_xe) then
674 i = ide-2
675 ! recompute : i
676 do k = kts, ktf
677 a_vel = 0.
678 vel = ru(i,k,j)
679 ! recompute : vel
680 a_field(i-2,k,j) = a_field(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
681 a_field(i-1,k,j) = a_field(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
682 a_field(i+1,k,j) = a_field(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
683 a_field(i,k,j) = a_field(i,k,j)+0.58333333*a_fqx(i,k)*vel
684 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(field(i,k,j)+field(i-1,k,j))-0.083333333*(field(i+1,k,j)+field(i-2,k,j)))
685 a_fqx(i,k) = 0.
686 a_ru(i,k,j) = a_ru(i,k,j)+a_vel
687 a_vel = 0.
688 end do
689 if (i_end .eq. ide-2) then
690 i = ide-1
691 ! recompute : i
692 do k = kts, ktf
693 a_field(i-1,k,j) = a_field(i-1,k,j)+0.5*a_fqx(i,k)*ru(i,k,j)
694 a_field(i,k,j) = a_field(i,k,j)+0.5*a_fqx(i,k)*ru(i,k,j)
695 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_fqx(i,k)*(field(i,k,j)+field(i-1,k,j))
696 a_fqx(i,k) = 0.
697 end do
698 endif
699 endif
700 if (degrade_xs) then
701 i = ids+2
702 ! recompute : i
703 do k = kts, ktf
704 a_vel = 0.
705 vel = ru(i,k,j)
706 ! recompute : vel
707 a_field(i-2,k,j) = a_field(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
708 a_field(i-1,k,j) = a_field(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
709 a_field(i+1,k,j) = a_field(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
710 a_field(i,k,j) = a_field(i,k,j)+0.58333333*a_fqx(i,k)*vel
711 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(field(i,k,j)+field(i-1,k,j))-0.083333333*(field(i+1,k,j)+field(i-2,k,j)))
712 a_fqx(i,k) = 0.
713 a_ru(i,k,j) = a_ru(i,k,j)+a_vel
714 a_vel = 0.
715 end do
716 if (i_start .eq. ids+1) then
717 i = ids+1
718 ! recompute : i
719 do k = kts, ktf
720 a_field(i-1,k,j) = a_field(i-1,k,j)+0.5*a_fqx(i,k)*ru(i,k,j)
721 a_field(i,k,j) = a_field(i,k,j)+0.5*a_fqx(i,k)*ru(i,k,j)
722 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_fqx(i,k)*(field(i,k,j)+field(i-1,k,j))
723 a_fqx(i,k) = 0.
724 end do
725 endif
726 endif
727 do k = kts, ktf
728 a_vel = 0.
729 do i = i_start_f, i_end_f
730 a_vel = 0.
731 vel = ru(i,k,j)
732 ! recompute : vel
733 a_field(i-3,k,j) = a_field(i-3,k,j)+0.016666667*a_fqx(i,k)*vel
734 a_field(i-2,k,j) = a_field(i-2,k,j)-0.13333333*a_fqx(i,k)*vel
735 a_field(i-1,k,j) = a_field(i-1,k,j)+0.61666667*a_fqx(i,k)*vel
736 a_field(i+2,k,j) = a_field(i+2,k,j)+0.016666667*a_fqx(i,k)*vel
737 a_field(i+1,k,j) = a_field(i+1,k,j)-0.13333333*a_fqx(i,k)*vel
738 a_field(i,k,j) = a_field(i,k,j)+0.61666667*a_fqx(i,k)*vel
739 a_vel = a_vel+a_fqx(i,k)*(0.61666667*(field(i,k,j)+field(i-1,k,j))-0.13333333*(field(i+1,k,j)+field(i-2,k,j))+0.016666667*&
740 &(field(i+2,k,j)+field(i-3,k,j)))
741 a_fqx(i,k) = 0.
742 a_ru(i,k,j) = a_ru(i,k,j)+a_vel
743 a_vel = 0.
744 end do
745 end do
746 end do
747 ! recdepend vars : its
748 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2833
749 ! recompute vars : i_start
750 i_start = its
751 ! recompute vars : i_start
752 ! recdepend vars : i_start,ide,ite
753 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2834
754 ! recompute vars : i_end
755 i_end = min(ite,ide-1)
756 ! recompute vars : i_end
757 ! recdepend vars : i_end,i_start,jts
758 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2835
759 ! recompute vars : j_start
760 j_start = jts
761 ! recompute vars : j_start
762 ! recdepend vars : i_end,i_start,j_start,jde,jte
763 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2836
764 ! recompute vars : j_end
765 j_end = min(jte,jde-1)
766 ! recompute vars : j_end
767 ! recdepend vars : degrade_ys,i_end,i_start,j_end,j_start,jds,jts
768 ! recompute pos : IF_STMT module_advect_em.f90:2844
769 ! recompute vars : j_start
770 if (degrade_ys) then
771 j_start = max(jts,jds+1)
772 endif
773 ! recompute vars : j_start
774 ! recdepend vars : degrade_ye,i_end,i_start,j_end,j_start,jde,jte
775 ! recompute pos : IF_STMT module_advect_em.f90:2849
776 ! recompute vars : j_end
777 if (degrade_ye) then
778 j_end = min(jte,jde-2)
779 endif
780 ! recompute vars : j_end
781 a_j_loop_y_flux_6: do j = j_end+1, j_start, -1
782 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2856
783 ! recompute vars : jp1
784 jp1 = 2
785 ! recompute vars : jp1
786 ! recdepend vars : jp1
787 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2857
788 ! recompute vars : jp0
789 jp0 = 1
790 ! recompute vars : jp0
791 j_loop_y_flux_9c: do j4 = j_start, j-1
792 jtmp = jp1
793 jp1 = jp0
794 jp0 = jtmp
795 end do j_loop_y_flux_9c
796 if (j .gt. j_start) then
797 do k = kts, ktf
798 do i = i_start, i_end
799 mrdy = msft(i,j-1)*rdy
800 ! recompute : mrdy
801 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
802 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
803 end do
804 end do
805 endif
806 if (j .ge. j_start_f .and. j .le. j_end_f) then
807 do k = kts, ktf
808 a_vel = 0.
809 do i = i_start, i_end
810 a_vel = 0.
811 vel = rv(i,k,j)
812 ! recompute : vel
813 a_field(i,k,j-3) = a_field(i,k,j-3)+0.016666667*a_fqy(i,k,jp1)*vel
814 a_field(i,k,j-2) = a_field(i,k,j-2)-0.13333333*a_fqy(i,k,jp1)*vel
815 a_field(i,k,j-1) = a_field(i,k,j-1)+0.61666667*a_fqy(i,k,jp1)*vel
816 a_field(i,k,j+2) = a_field(i,k,j+2)+0.016666667*a_fqy(i,k,jp1)*vel
817 a_field(i,k,j+1) = a_field(i,k,j+1)-0.13333333*a_fqy(i,k,jp1)*vel
818 a_field(i,k,j) = a_field(i,k,j)+0.61666667*a_fqy(i,k,jp1)*vel
819 a_vel = a_vel+a_fqy(i,k,jp1)*(0.61666667*(field(i,k,j)+field(i,k,j-1))-0.13333333*(field(i,k,j+1)+field(i,k,j-2))+&
820 &0.016666667*(field(i,k,j+2)+field(i,k,j-3)))
821 a_fqy(i,k,jp1) = 0.
822 a_rv(i,k,j) = a_rv(i,k,j)+a_vel
823 a_vel = 0.
824 end do
825 end do
826 else if (j .eq. jds+1) then
827 do k = kts, ktf
828 do i = i_start, i_end
829 a_field(i,k,j-1) = a_field(i,k,j-1)+0.5*a_fqy(i,k,jp1)*rv(i,k,j)
830 a_field(i,k,j) = a_field(i,k,j)+0.5*a_fqy(i,k,jp1)*rv(i,k,j)
831 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_fqy(i,k,jp1)*(field(i,k,j)+field(i,k,j-1))
832 a_fqy(i,k,jp1) = 0.
833 end do
834 end do
835 else if (j .eq. jds+2) then
836 do k = kts, ktf
837 a_vel = 0.
838 do i = i_start, i_end
839 a_vel = 0.
840 vel = rv(i,k,j)
841 ! recompute : vel
842 a_field(i,k,j-2) = a_field(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
843 a_field(i,k,j-1) = a_field(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
844 a_field(i,k,j+1) = a_field(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
845 a_field(i,k,j) = a_field(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
846 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(field(i,k,j)+field(i,k,j-1))-0.083333333*(field(i,k,j+1)+field(i,k,j-2)))
847 a_fqy(i,k,jp1) = 0.
848 a_rv(i,k,j) = a_rv(i,k,j)+a_vel
849 a_vel = 0.
850 end do
851 end do
852 else if (j .eq. jde-1) then
853 do k = kts, ktf
854 do i = i_start, i_end
855 a_field(i,k,j-1) = a_field(i,k,j-1)+0.5*a_fqy(i,k,jp1)*rv(i,k,j)
856 a_field(i,k,j) = a_field(i,k,j)+0.5*a_fqy(i,k,jp1)*rv(i,k,j)
857 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_fqy(i,k,jp1)*(field(i,k,j)+field(i,k,j-1))
858 a_fqy(i,k,jp1) = 0.
859 end do
860 end do
861 else if (j .eq. jde-2) then
862 do k = kts, ktf
863 a_vel = 0.
864 do i = i_start, i_end
865 a_vel = 0.
866 vel = rv(i,k,j)
867 ! recompute : vel
868 a_field(i,k,j-2) = a_field(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
869 a_field(i,k,j-1) = a_field(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
870 a_field(i,k,j+1) = a_field(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
871 a_field(i,k,j) = a_field(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
872 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(field(i,k,j)+field(i,k,j-1))-0.083333333*(field(i,k,j+1)+field(i,k,j-2)))
873 a_fqy(i,k,jp1) = 0.
874 a_rv(i,k,j) = a_rv(i,k,j)+a_vel
875 a_vel = 0.
876 end do
877 end do
878 endif
879 end do a_j_loop_y_flux_6
880 else if (horz_order .eq. 5) then a_horizontal_order_test
881 degrade_xs = .true.
882 ! recompute : degrade_xs
883 degrade_xe = .true.
884 ! recompute : degrade_xe
885 degrade_ys = .true.
886 ! recompute : degrade_ys
887 degrade_ye = .true.
888 ! recompute : degrade_ye
889 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
890 degrade_xs = .false.
891 endif
892 ! recompute : degrade_xs
893 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-3) then
894 degrade_xe = .false.
895 endif
896 ! recompute : degrade_xe
897 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
898 degrade_ys = .false.
899 endif
900 ! recompute : degrade_ys
901 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-3) then
902 degrade_ye = .false.
903 endif
904 ! recompute : degrade_ye
905 ! recompute : ktf
906 j_start = jts
907 ! recompute : j_start
908 j_end = min(jte,jde-1)
909 ! recompute : j_end
910 j_start_f = j_start
911 ! recompute : j_start_f
912 j_end_f = j_end+1
913 ! recompute : j_end_f
914 if (degrade_ys) then
915 j_start_f = jds+3
916 endif
917 ! recompute : j_start_f
918 if (degrade_ye) then
919 j_end_f = jde-3
920 endif
921 ! recompute : j_end_f
922 i_start = its
923 ! recompute : i_start
924 i_end = min(ite,ide-1)
925 ! recompute : i_end
926 j_start = jts
927 ! recompute : j_start
928 j_end = min(jte,jde-1)
929 ! recompute : j_end
930 i_start_f = i_start
931 ! recompute : i_start_f
932 i_end_f = i_end+1
933 ! recompute : i_end_f
934 if (degrade_xs) then
935 i_start = max(ids+1,its)
936 i_start_f = i_start+2
937 endif
938 ! recompute : i_start,i_start_f
939 if (degrade_xe) then
940 i_end = min(ide-2,ite)
941 i_end_f = ide-3
942 endif
943 ! recompute : i_end,i_end_f
944 do j = j_end, j_start, -1
945 do k = kts, ktf
946 do i = i_start, i_end
947 mrdx = msft(i,j)*rdx
948 ! recompute : mrdx
949 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
950 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
951 end do
952 end do
953 if (degrade_xe) then
954 i = ide-2
955 ! recompute : i
956 do k = kts, ktf
957 a_vel = 0.
958 vel = ru(i,k,j)
959 ! recompute : vel
960 a_field(i-2,k,j) = a_field(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
961 a_field(i-1,k,j) = a_field(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
962 a_field(i+1,k,j) = a_field(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
963 a_field(i,k,j) = a_field(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
964 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(field(i,k,j)+field(i-1,k,j))-0.083333333*(field(i+1,k,j)+field(i-2,k,j))+0.083333333*&
965 &(field(i+1,k,j)-field(i-2,k,j)-3.*(field(i,k,j)-field(i-1,k,j)))*sign(1.,vel))
966 a_fqx(i,k) = 0.
967 a_ru(i,k,j) = a_ru(i,k,j)+a_vel
968 a_vel = 0.
969 end do
970 if (i_end .eq. ide-2) then
971 i = ide-1
972 ! recompute : i
973 do k = kts, ktf
974 a_field(i-1,k,j) = a_field(i-1,k,j)+0.5*a_fqx(i,k)*ru(i,k,j)
975 a_field(i,k,j) = a_field(i,k,j)+0.5*a_fqx(i,k)*ru(i,k,j)
976 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_fqx(i,k)*(field(i,k,j)+field(i-1,k,j))
977 a_fqx(i,k) = 0.
978 end do
979 endif
980 endif
981 if (degrade_xs) then
982 i = ids+2
983 ! recompute : i
984 do k = kts, ktf
985 a_vel = 0.
986 vel = ru(i,k,j)
987 ! recompute : vel
988 a_field(i-2,k,j) = a_field(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
989 a_field(i-1,k,j) = a_field(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
990 a_field(i+1,k,j) = a_field(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
991 a_field(i,k,j) = a_field(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
992 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(field(i,k,j)+field(i-1,k,j))-0.083333333*(field(i+1,k,j)+field(i-2,k,j))+0.083333333*&
993 &(field(i+1,k,j)-field(i-2,k,j)-3.*(field(i,k,j)-field(i-1,k,j)))*sign(1.,vel))
994 a_fqx(i,k) = 0.
995 a_ru(i,k,j) = a_ru(i,k,j)+a_vel
996 a_vel = 0.
997 end do
998 if (i_start .eq. ids+1) then
999 i = ids+1
1000 ! recompute : i
1001 do k = kts, ktf
1002 a_field(i-1,k,j) = a_field(i-1,k,j)+0.5*a_fqx(i,k)*ru(i,k,j)
1003 a_field(i,k,j) = a_field(i,k,j)+0.5*a_fqx(i,k)*ru(i,k,j)
1004 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_fqx(i,k)*(field(i,k,j)+field(i-1,k,j))
1005 a_fqx(i,k) = 0.
1006 end do
1007 endif
1008 endif
1009 do k = kts, ktf
1010 a_vel = 0.
1011 do i = i_start_f, i_end_f
1012 a_vel = 0.
1013 vel = ru(i,k,j)
1014 ! recompute : vel
1015 a_field(i-3,k,j) = a_field(i-3,k,j)+a_fqx(i,k)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))
1016 a_field(i-2,k,j) = a_field(i-2,k,j)+a_fqx(i,k)*vel*((-0.13333333)-0.083333333*sign(1.,vel))
1017 a_field(i-1,k,j) = a_field(i-1,k,j)+a_fqx(i,k)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))
1018 a_field(i+2,k,j) = a_field(i+2,k,j)+a_fqx(i,k)*vel*(0.016666667-0.016666667*sign(1.,vel))
1019 a_field(i+1,k,j) = a_field(i+1,k,j)+a_fqx(i,k)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))
1020 a_field(i,k,j) = a_field(i,k,j)+a_fqx(i,k)*vel*(0.61666667-0.16666667*sign(1.,vel))
1021 a_vel = a_vel+a_fqx(i,k)*(0.61666667*(field(i,k,j)+field(i-1,k,j))-0.13333333*(field(i+1,k,j)+field(i-2,k,j))+0.016666667*&
1022 &(field(i+2,k,j)+field(i-3,k,j))-0.016666667*(field(i+2,k,j)-field(i-3,k,j)-5.*(field(i+1,k,j)-field(i-2,k,j))+10.*&
1023 &(field(i,k,j)-field(i-1,k,j)))*sign(1.,vel))
1024 a_fqx(i,k) = 0.
1025 a_ru(i,k,j) = a_ru(i,k,j)+a_vel
1026 a_vel = 0.
1027 end do
1028 end do
1029 end do
1030 ! recdepend vars : its
1031 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3057
1032 ! recompute vars : i_start
1033 i_start = its
1034 ! recompute vars : i_start
1035 ! recdepend vars : i_start,ide,ite
1036 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3058
1037 ! recompute vars : i_end
1038 i_end = min(ite,ide-1)
1039 ! recompute vars : i_end
1040 ! recdepend vars : i_end,i_start,jts
1041 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3059
1042 ! recompute vars : j_start
1043 j_start = jts
1044 ! recompute vars : j_start
1045 ! recdepend vars : i_end,i_start,j_start,jde,jte
1046 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3060
1047 ! recompute vars : j_end
1048 j_end = min(jte,jde-1)
1049 ! recompute vars : j_end
1050 ! recdepend vars : degrade_ys,i_end,i_start,j_end,j_start,jds,jts
1051 ! recompute pos : IF_STMT module_advect_em.f90:3068
1052 ! recompute vars : j_start
1053 if (degrade_ys) then
1054 j_start = max(jts,jds+1)
1055 endif
1056 ! recompute vars : j_start
1057 ! recdepend vars : degrade_ye,i_end,i_start,j_end,j_start,jde,jte
1058 ! recompute pos : IF_STMT module_advect_em.f90:3073
1059 ! recompute vars : j_end
1060 if (degrade_ye) then
1061 j_end = min(jte,jde-2)
1062 endif
1063 ! recompute vars : j_end
1064 a_j_loop_y_flux_5: do j = j_end+1, j_start, -1
1065 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3080
1066 ! recompute vars : jp1
1067 jp1 = 2
1068 ! recompute vars : jp1
1069 ! recdepend vars : jp1
1070 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3081
1071 ! recompute vars : jp0
1072 jp0 = 1
1073 ! recompute vars : jp0
1074 j_loop_y_flux_9a: do j1 = j_start, j-1
1075 jtmp = jp1
1076 jp1 = jp0
1077 jp0 = jtmp
1078 end do j_loop_y_flux_9a
1079 if (j .gt. j_start) then
1080 do k = kts, ktf
1081 do i = i_start, i_end
1082 mrdy = msft(i,j-1)*rdy
1083 ! recompute : mrdy
1084 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
1085 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
1086 end do
1087 end do
1088 endif
1089 if (j .ge. j_start_f .and. j .le. j_end_f) then
1090 do k = kts, ktf
1091 a_vel = 0.
1092 do i = i_start, i_end
1093 a_vel = 0.
1094 vel = rv(i,k,j)
1095 ! recompute : vel
1096 a_field(i,k,j-3) = a_field(i,k,j-3)+a_fqy(i,k,jp1)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))
1097 a_field(i,k,j-2) = a_field(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.13333333)-0.083333333*sign(1.,vel))
1098 a_field(i,k,j-1) = a_field(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))
1099 a_field(i,k,j+2) = a_field(i,k,j+2)+a_fqy(i,k,jp1)*vel*(0.016666667-0.016666667*sign(1.,vel))
1100 a_field(i,k,j+1) = a_field(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))
1101 a_field(i,k,j) = a_field(i,k,j)+a_fqy(i,k,jp1)*vel*(0.61666667-0.16666667*sign(1.,vel))
1102 a_vel = a_vel+a_fqy(i,k,jp1)*(0.61666667*(field(i,k,j)+field(i,k,j-1))-0.13333333*(field(i,k,j+1)+field(i,k,j-2))+&
1103 &0.016666667*(field(i,k,j+2)+field(i,k,j-3))-0.016666667*(field(i,k,j+2)-field(i,k,j-3)-5.*(field(i,k,j+1)-field(i,k,j-2)&
1104 &)+10.*(field(i,k,j)-field(i,k,j-1)))*sign(1.,vel))
1105 a_fqy(i,k,jp1) = 0.
1106 a_rv(i,k,j) = a_rv(i,k,j)+a_vel
1107 a_vel = 0.
1108 end do
1109 end do
1110 else if (j .eq. jds+1) then
1111 do k = kts, ktf
1112 do i = i_start, i_end
1113 a_field(i,k,j-1) = a_field(i,k,j-1)+0.5*a_fqy(i,k,jp1)*rv(i,k,j)
1114 a_field(i,k,j) = a_field(i,k,j)+0.5*a_fqy(i,k,jp1)*rv(i,k,j)
1115 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_fqy(i,k,jp1)*(field(i,k,j)+field(i,k,j-1))
1116 a_fqy(i,k,jp1) = 0.
1117 end do
1118 end do
1119 else if (j .eq. jds+2) then
1120 do k = kts, ktf
1121 a_vel = 0.
1122 do i = i_start, i_end
1123 a_vel = 0.
1124 vel = rv(i,k,j)
1125 ! recompute : vel
1126 a_field(i,k,j-2) = a_field(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
1127 a_field(i,k,j-1) = a_field(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
1128 a_field(i,k,j+1) = a_field(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
1129 a_field(i,k,j) = a_field(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
1130 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(field(i,k,j)+field(i,k,j-1))-0.083333333*(field(i,k,j+1)+field(i,k,j-2))+&
1131 &0.083333333*(field(i,k,j+1)-field(i,k,j-2)-3.*(field(i,k,j)-field(i,k,j-1)))*sign(1.,vel))
1132 a_fqy(i,k,jp1) = 0.
1133 a_rv(i,k,j) = a_rv(i,k,j)+a_vel
1134 a_vel = 0.
1135 end do
1136 end do
1137 else if (j .eq. jde-1) then
1138 do k = kts, ktf
1139 do i = i_start, i_end
1140 a_field(i,k,j-1) = a_field(i,k,j-1)+0.5*a_fqy(i,k,jp1)*rv(i,k,j)
1141 a_field(i,k,j) = a_field(i,k,j)+0.5*a_fqy(i,k,jp1)*rv(i,k,j)
1142 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_fqy(i,k,jp1)*(field(i,k,j)+field(i,k,j-1))
1143 a_fqy(i,k,jp1) = 0.
1144 end do
1145 end do
1146 else if (j .eq. jde-2) then
1147 do k = kts, ktf
1148 a_vel = 0.
1149 do i = i_start, i_end
1150 a_vel = 0.
1151 vel = rv(i,k,j)
1152 ! recompute : vel
1153 a_field(i,k,j-2) = a_field(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
1154 a_field(i,k,j-1) = a_field(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
1155 a_field(i,k,j+1) = a_field(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
1156 a_field(i,k,j) = a_field(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
1157 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(field(i,k,j)+field(i,k,j-1))-0.083333333*(field(i,k,j+1)+field(i,k,j-2))+&
1158 &0.083333333*(field(i,k,j+1)-field(i,k,j-2)-3.*(field(i,k,j)-field(i,k,j-1)))*sign(1.,vel))
1159 a_fqy(i,k,jp1) = 0.
1160 a_rv(i,k,j) = a_rv(i,k,j)+a_vel
1161 a_vel = 0.
1162 end do
1163 end do
1164 endif
1165 end do a_j_loop_y_flux_5
1166 else if (horz_order .eq. 4) then a_horizontal_order_test
1167 degrade_xs = .true.
1168 ! recompute : degrade_xs
1169 degrade_xe = .true.
1170 ! recompute : degrade_xe
1171 degrade_ys = .true.
1172 ! recompute : degrade_ys
1173 degrade_ye = .true.
1174 ! recompute : degrade_ye
1175 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
1176 degrade_xs = .false.
1177 endif
1178 ! recompute : degrade_xs
1179 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
1180 degrade_xe = .false.
1181 endif
1182 ! recompute : degrade_xe
1183 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
1184 degrade_ys = .false.
1185 endif
1186 ! recompute : degrade_ys
1187 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
1188 degrade_ye = .false.
1189 endif
1190 ! recompute : degrade_ye
1191 ! recompute : ktf
1192 i_start = its
1193 ! recompute : i_start
1194 i_end = min(ite,ide-1)
1195 ! recompute : i_end
1196 i_start_f = i_start
1197 ! recompute : i_start_f
1198 i_end_f = i_end+1
1199 ! recompute : i_end_f
1200 if (degrade_xs) then
1201 i_start = ids+1
1202 i_start_f = i_start+1
1203 endif
1204 ! recompute : i_start_f
1205 if (degrade_xe) then
1206 i_end_f = ide-2
1207 endif
1208 ! recompute : i_end_f
1209 i_start = its
1210 ! recompute : i_start
1211 i_end = min(ite,ide-1)
1212 ! recompute : i_end
1213 j_start = jts
1214 ! recompute : j_start
1215 j_end = min(jte,jde-1)
1216 ! recompute : j_end
1217 j_start_f = j_start
1218 ! recompute : j_start_f
1219 j_end_f = j_end+1
1220 ! recompute : j_end_f
1221 if (degrade_ys) then
1222 j_start = jds+1
1223 j_start_f = j_start+1
1224 endif
1225 ! recompute : j_start,j_start_f
1226 if (degrade_ye) then
1227 j_end = jde-2
1228 j_end_f = jde-2
1229 endif
1230 ! recompute : j_end,j_end_f
1231 do j = j_end+1, j_start, -1
1232 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3365
1233 ! recompute vars : jp1
1234 jp1 = 2
1235 ! recompute vars : jp1
1236 ! recdepend vars : jp1
1237 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3366
1238 ! recompute vars : jp0
1239 jp0 = 1
1240 ! recompute vars : jp0
1241 do j2 = j_start, j-1
1242 jtmp = jp1
1243 jp1 = jp0
1244 jp0 = jtmp
1245 end do
1246 if (j .gt. j_start) then
1247 do k = kts, ktf
1248 do i = i_start, i_end
1249 mrdy = msft(i,j-1)*rdy
1250 ! recompute : mrdy
1251 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
1252 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
1253 end do
1254 end do
1255 endif
1256 if (j .lt. j_start_f .and. degrade_ys) then
1257 do k = kts, ktf
1258 do i = i_start, i_end
1259 a_field(i,k,j_start-1) = a_field(i,k,j_start-1)+0.5*a_fqy(i,k,jp1)*rv(i,k,j_start)
1260 a_field(i,k,j_start) = a_field(i,k,j_start)+0.5*a_fqy(i,k,jp1)*rv(i,k,j_start)
1261 a_rv(i,k,j_start) = a_rv(i,k,j_start)+0.5*a_fqy(i,k,jp1)*(field(i,k,j_start)+field(i,k,j_start-1))
1262 a_fqy(i,k,jp1) = 0.
1263 end do
1264 end do
1265 else if (j .gt. j_end_f .and. degrade_ye) then
1266 do k = kts, ktf
1267 do i = i_start, i_end
1268 a_field(i,k,j_end+1) = a_field(i,k,j_end+1)+0.5*a_fqy(i,k,jp1)*rv(i,k,j_end+1)
1269 a_field(i,k,j_end) = a_field(i,k,j_end)+0.5*a_fqy(i,k,jp1)*rv(i,k,j_end+1)
1270 a_rv(i,k,j_end+1) = a_rv(i,k,j_end+1)+0.5*a_fqy(i,k,jp1)*(field(i,k,j_end+1)+field(i,k,j_end))
1271 a_fqy(i,k,jp1) = 0.
1272 end do
1273 end do
1274 else
1275 do k = kts, ktf
1276 do i = i_start, i_end
1277 a_field(i,k,j-2) = a_field(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*rv(i,k,j)
1278 a_field(i,k,j-1) = a_field(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*rv(i,k,j)
1279 a_field(i,k,j+1) = a_field(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*rv(i,k,j)
1280 a_field(i,k,j) = a_field(i,k,j)+0.58333333*a_fqy(i,k,jp1)*rv(i,k,j)
1281 a_rv(i,k,j) = a_rv(i,k,j)+a_fqy(i,k,jp1)*(0.58333333*(field(i,k,j)+field(i,k,j-1))-0.083333333*(field(i,k,j+1)+field(i,k,&
1282 &j-2)))
1283 a_fqy(i,k,jp1) = 0.
1284 end do
1285 end do
1286 endif
1287 end do
1288 ! recdepend vars : its
1289 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3278
1290 ! recompute vars : i_start
1291 i_start = its
1292 ! recompute vars : i_start
1293 ! recdepend vars : i_start,ide,ite
1294 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3279
1295 ! recompute vars : i_end
1296 i_end = min(ite,ide-1)
1297 ! recompute vars : i_end
1298 ! recdepend vars : i_end,i_start,jts
1299 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3280
1300 ! recompute vars : j_start
1301 j_start = jts
1302 ! recompute vars : j_start
1303 ! recdepend vars : i_end,i_start,j_start,jde,jte
1304 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3281
1305 ! recompute vars : j_end
1306 j_end = min(jte,jde-1)
1307 ! recompute vars : j_end
1308 ! recdepend vars : degrade_xs,i_end,i_start,ids,j_end,j_start
1309 ! recompute pos : IF_STMT module_advect_em.f90:3289
1310 ! recompute vars : i_start
1311 if (degrade_xs) then
1312 i_start = ids+1
1313 endif
1314 ! recompute vars : i_start
1315 ! recdepend vars : degrade_xe,i_end,i_start,ide,j_end,j_start
1316 ! recompute pos : IF_STMT module_advect_em.f90:3294
1317 ! recompute vars : i_end
1318 if (degrade_xe) then
1319 i_end = ide-2
1320 endif
1321 ! recompute vars : i_end
1322 do j = j_start, j_end
1323 do k = kts, ktf
1324 do i = i_start, i_end
1325 mrdx = msft(i,j)*rdx
1326 ! recompute : mrdx
1327 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
1328 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
1329 end do
1330 end do
1331 if (degrade_xe) then
1332 do k = kts, ktf
1333 a_field(i_end+1,k,j) = a_field(i_end+1,k,j)+0.5*a_fqx(i_end+1,k)*ru(i_end+1,k,j)
1334 a_field(i_end,k,j) = a_field(i_end,k,j)+0.5*a_fqx(i_end+1,k)*ru(i_end+1,k,j)
1335 a_ru(i_end+1,k,j) = a_ru(i_end+1,k,j)+0.5*a_fqx(i_end+1,k)*(field(i_end+1,k,j)+field(i_end,k,j))
1336 a_fqx(i_end+1,k) = 0.
1337 end do
1338 endif
1339 if (degrade_xs) then
1340 do k = kts, ktf
1341 a_field(i_start-1,k,j) = a_field(i_start-1,k,j)+0.5*a_fqx(i_start,k)*ru(i_start,k,j)
1342 a_field(i_start,k,j) = a_field(i_start,k,j)+0.5*a_fqx(i_start,k)*ru(i_start,k,j)
1343 a_ru(i_start,k,j) = a_ru(i_start,k,j)+0.5*a_fqx(i_start,k)*(field(i_start,k,j)+field(i_start-1,k,j))
1344 a_fqx(i_start,k) = 0.
1345 end do
1346 endif
1347 do k = kts, ktf
1348 do i = i_start_f, i_end_f
1349 a_field(i-2,k,j) = a_field(i-2,k,j)-0.083333333*a_fqx(i,k)*ru(i,k,j)
1350 a_field(i-1,k,j) = a_field(i-1,k,j)+0.58333333*a_fqx(i,k)*ru(i,k,j)
1351 a_field(i+1,k,j) = a_field(i+1,k,j)-0.083333333*a_fqx(i,k)*ru(i,k,j)
1352 a_field(i,k,j) = a_field(i,k,j)+0.58333333*a_fqx(i,k)*ru(i,k,j)
1353 a_ru(i,k,j) = a_ru(i,k,j)+a_fqx(i,k)*(0.58333333*(field(i,k,j)+field(i-1,k,j))-0.083333333*(field(i+1,k,j)+field(i-2,k,j)))
1354 a_fqx(i,k) = 0.
1355 end do
1356 end do
1357 end do
1358 else if (horz_order .eq. 3) then a_horizontal_order_test
1359 degrade_xs = .true.
1360 ! recompute : degrade_xs
1361 degrade_xe = .true.
1362 ! recompute : degrade_xe
1363 degrade_ys = .true.
1364 ! recompute : degrade_ys
1365 degrade_ye = .true.
1366 ! recompute : degrade_ye
1367 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
1368 degrade_xs = .false.
1369 endif
1370 ! recompute : degrade_xs
1371 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
1372 degrade_xe = .false.
1373 endif
1374 ! recompute : degrade_xe
1375 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
1376 degrade_ys = .false.
1377 endif
1378 ! recompute : degrade_ys
1379 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
1380 degrade_ye = .false.
1381 endif
1382 ! recompute : degrade_ye
1383 ! recompute : ktf
1384 i_start = its
1385 ! recompute : i_start
1386 i_end = min(ite,ide-1)
1387 ! recompute : i_end
1388 i_start_f = i_start
1389 ! recompute : i_start_f
1390 i_end_f = i_end+1
1391 ! recompute : i_end_f
1392 if (degrade_xs) then
1393 i_start = ids+1
1394 i_start_f = i_start+1
1395 endif
1396 ! recompute : i_start_f
1397 if (degrade_xe) then
1398 i_end_f = ide-2
1399 endif
1400 ! recompute : i_end_f
1401 i_start = its
1402 ! recompute : i_start
1403 i_end = min(ite,ide-1)
1404 ! recompute : i_end
1405 j_start = jts
1406 ! recompute : j_start
1407 j_end = min(jte,jde-1)
1408 ! recompute : j_end
1409 j_start_f = j_start
1410 ! recompute : j_start_f
1411 j_end_f = j_end+1
1412 ! recompute : j_end_f
1413 if (degrade_ys) then
1414 j_start = jds+1
1415 j_start_f = j_start+1
1416 endif
1417 ! recompute : j_start,j_start_f
1418 if (degrade_ye) then
1419 j_end = jde-2
1420 j_end_f = jde-2
1421 endif
1422 ! recompute : j_end,j_end_f
1423 do j = j_end+1, j_start, -1
1424 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3525
1425 ! recompute vars : jp1
1426 jp1 = 2
1427 ! recompute vars : jp1
1428 ! recdepend vars : jp1
1429 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3526
1430 ! recompute vars : jp0
1431 jp0 = 1
1432 ! recompute vars : jp0
1433 do j3 = j_start, j-1
1434 jtmp = jp1
1435 jp1 = jp0
1436 jp0 = jtmp
1437 end do
1438 if (j .gt. j_start) then
1439 do k = kts, ktf
1440 do i = i_start, i_end
1441 mrdy = msft(i,j-1)*rdy
1442 ! recompute : mrdy
1443 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
1444 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
1445 end do
1446 end do
1447 endif
1448 if (j .lt. j_start_f .and. degrade_ys) then
1449 do k = kts, ktf
1450 do i = i_start, i_end
1451 a_field(i,k,j_start-1) = a_field(i,k,j_start-1)+0.5*a_fqy(i,k,jp1)*rv(i,k,j_start)
1452 a_field(i,k,j_start) = a_field(i,k,j_start)+0.5*a_fqy(i,k,jp1)*rv(i,k,j_start)
1453 a_rv(i,k,j_start) = a_rv(i,k,j_start)+0.5*a_fqy(i,k,jp1)*(field(i,k,j_start)+field(i,k,j_start-1))
1454 a_fqy(i,k,jp1) = 0.
1455 end do
1456 end do
1457 else if (j .gt. j_end_f .and. degrade_ye) then
1458 do k = kts, ktf
1459 do i = i_start, i_end
1460 a_field(i,k,j_end+1) = a_field(i,k,j_end+1)+0.5*a_fqy(i,k,jp1)*rv(i,k,j_end+1)
1461 a_field(i,k,j_end) = a_field(i,k,j_end)+0.5*a_fqy(i,k,jp1)*rv(i,k,j_end+1)
1462 a_rv(i,k,j_end+1) = a_rv(i,k,j_end+1)+0.5*a_fqy(i,k,jp1)*(field(i,k,j_end+1)+field(i,k,j_end))
1463 a_fqy(i,k,jp1) = 0.
1464 end do
1465 end do
1466 else
1467 do k = kts, ktf
1468 do i = i_start, i_end
1469 a_field(i,k,j-2) = a_field(i,k,j-2)+a_fqy(i,k,jp1)*rv(i,k,j)*((-0.083333333)+(-0.083333333)*sign(1.,rv(i,k,j)))
1470 a_field(i,k,j-1) = a_field(i,k,j-1)+a_fqy(i,k,jp1)*rv(i,k,j)*(0.58333333+0.25*sign(1.,rv(i,k,j)))
1471 a_field(i,k,j+1) = a_field(i,k,j+1)+a_fqy(i,k,jp1)*rv(i,k,j)*((-0.083333333)+0.083333333*sign(1.,rv(i,k,j)))
1472 a_field(i,k,j) = a_field(i,k,j)+a_fqy(i,k,jp1)*rv(i,k,j)*(0.58333333+(-0.25)*sign(1.,rv(i,k,j)))
1473 a_rv(i,k,j) = a_rv(i,k,j)+a_fqy(i,k,jp1)*(0.58333333*(field(i,k,j)+field(i,k,j-1))-0.083333333*(field(i,k,j+1)+field(i,k,&
1474 &j-2))+0.083333333*(field(i,k,j+1)-field(i,k,j-2)-3.*(field(i,k,j)-field(i,k,j-1)))*sign(1.,rv(i,k,j)))
1475 a_fqy(i,k,jp1) = 0.
1476 end do
1477 end do
1478 endif
1479 end do
1480 ! recdepend vars : its
1481 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3438
1482 ! recompute vars : i_start
1483 i_start = its
1484 ! recompute vars : i_start
1485 ! recdepend vars : i_start,ide,ite
1486 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3439
1487 ! recompute vars : i_end
1488 i_end = min(ite,ide-1)
1489 ! recompute vars : i_end
1490 ! recdepend vars : i_end,i_start,jts
1491 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3440
1492 ! recompute vars : j_start
1493 j_start = jts
1494 ! recompute vars : j_start
1495 ! recdepend vars : i_end,i_start,j_start,jde,jte
1496 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3441
1497 ! recompute vars : j_end
1498 j_end = min(jte,jde-1)
1499 ! recompute vars : j_end
1500 ! recdepend vars : degrade_xs,i_end,i_start,ids,j_end,j_start
1501 ! recompute pos : IF_STMT module_advect_em.f90:3449
1502 ! recompute vars : i_start
1503 if (degrade_xs) then
1504 i_start = ids+1
1505 endif
1506 ! recompute vars : i_start
1507 ! recdepend vars : degrade_xe,i_end,i_start,ide,j_end,j_start
1508 ! recompute pos : IF_STMT module_advect_em.f90:3454
1509 ! recompute vars : i_end
1510 if (degrade_xe) then
1511 i_end = ide-2
1512 endif
1513 ! recompute vars : i_end
1514 do j = j_start, j_end
1515 do k = kts, ktf
1516 do i = i_start, i_end
1517 mrdx = msft(i,j)*rdx
1518 ! recompute : mrdx
1519 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
1520 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
1521 end do
1522 end do
1523 if (degrade_xe) then
1524 do k = kts, ktf
1525 a_field(i_end+1,k,j) = a_field(i_end+1,k,j)+0.5*a_fqx(i_end+1,k)*ru(i_end+1,k,j)
1526 a_field(i_end,k,j) = a_field(i_end,k,j)+0.5*a_fqx(i_end+1,k)*ru(i_end+1,k,j)
1527 a_ru(i_end+1,k,j) = a_ru(i_end+1,k,j)+0.5*a_fqx(i_end+1,k)*(field(i_end+1,k,j)+field(i_end,k,j))
1528 a_fqx(i_end+1,k) = 0.
1529 end do
1530 endif
1531 if (degrade_xs) then
1532 do k = kts, ktf
1533 a_field(i_start-1,k,j) = a_field(i_start-1,k,j)+0.5*a_fqx(i_start,k)*ru(i_start,k,j)
1534 a_field(i_start,k,j) = a_field(i_start,k,j)+0.5*a_fqx(i_start,k)*ru(i_start,k,j)
1535 a_ru(i_start,k,j) = a_ru(i_start,k,j)+0.5*a_fqx(i_start,k)*(field(i_start,k,j)+field(i_start-1,k,j))
1536 a_fqx(i_start,k) = 0.
1537 end do
1538 endif
1539 do k = kts, ktf
1540 do i = i_start_f, i_end_f
1541 a_field(i-2,k,j) = a_field(i-2,k,j)+a_fqx(i,k)*ru(i,k,j)*((-0.083333333)+(-0.083333333)*sign(1.,ru(i,k,j)))
1542 a_field(i-1,k,j) = a_field(i-1,k,j)+a_fqx(i,k)*ru(i,k,j)*(0.58333333+0.25*sign(1.,ru(i,k,j)))
1543 a_field(i+1,k,j) = a_field(i+1,k,j)+a_fqx(i,k)*ru(i,k,j)*((-0.083333333)+0.083333333*sign(1.,ru(i,k,j)))
1544 a_field(i,k,j) = a_field(i,k,j)+a_fqx(i,k)*ru(i,k,j)*(0.58333333+(-0.25)*sign(1.,ru(i,k,j)))
1545 a_ru(i,k,j) = a_ru(i,k,j)+a_fqx(i,k)*(0.58333333*(field(i,k,j)+field(i-1,k,j))-0.083333333*(field(i+1,k,j)+field(i-2,k,j))+&
1546 &0.083333333*(field(i+1,k,j)-field(i-2,k,j)-3.*(field(i,k,j)-field(i-1,k,j)))*sign(1.,ru(i,k,j)))
1547 a_fqx(i,k) = 0.
1548 end do
1549 end do
1550 end do
1551 else if (horz_order .eq. 2) then a_horizontal_order_test
1552 j_start = jts
1553 ! recompute : j_start
1554 j_end = min(jte,jde-1)
1555 ! recompute : j_end
1556 i_start = its
1557 ! recompute : i_start
1558 i_end = min(ite,ide-1)
1559 ! recompute : i_end
1560 if (config_flags%open_ys .or. specified) then
1561 j_start = max(jds+1,jts)
1562 endif
1563 ! recompute : j_start
1564 if (config_flags%open_ye .or. specified) then
1565 j_end = min(jde-2,jte)
1566 endif
1567 ! recompute : j_end
1568 do j = j_start, j_end
1569 do k = kts, ktf
1570 do i = i_start, i_end
1571 mrdy = msft(i,j)*rdy
1572 ! recompute : mrdy
1573 a_field(i,k,j-1) = a_field(i,k,j-1)+0.5*a_tendency(i,k,j)*mrdy*rv(i,k,j)
1574 a_field(i,k,j+1) = a_field(i,k,j+1)-0.5*a_tendency(i,k,j)*mrdy*rv(i,k,j+1)
1575 a_field(i,k,j) = a_field(i,k,j)-0.5*a_tendency(i,k,j)*mrdy*(rv(i,k,j+1)-rv(i,k,j))
1576 a_rv(i,k,j+1) = a_rv(i,k,j+1)-0.5*a_tendency(i,k,j)*mrdy*(field(i,k,j+1)+field(i,k,j))
1577 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_tendency(i,k,j)*mrdy*(field(i,k,j)+field(i,k,j-1))
1578 end do
1579 end do
1580 end do
1581 ! recdepend vars : its
1582 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3574
1583 ! recompute vars : i_start
1584 i_start = its
1585 ! recompute vars : i_start
1586 ! recdepend vars : i_start,ide,ite
1587 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3575
1588 ! recompute vars : i_end
1589 i_end = min(ite,ide-1)
1590 ! recompute vars : i_end
1591 ! recdepend vars : i_end,i_start,jts
1592 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3576
1593 ! recompute vars : j_start
1594 j_start = jts
1595 ! recompute vars : j_start
1596 ! recdepend vars : i_end,i_start,j_start,jde,jte
1597 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3577
1598 ! recompute vars : j_end
1599 j_end = min(jte,jde-1)
1600 ! recompute vars : j_end
1601 ! recdepend vars : config_flags,i_end,i_start,ids,its,j_end,j_start,spe
1602 ! cified
1603 ! recompute pos : IF_STMT module_advect_em.f90:3579
1604 ! recompute vars : i_start
1605 if (config_flags%open_xs .or. specified) then
1606 i_start = max(ids+1,its)
1607 endif
1608 ! recompute vars : i_start
1609 ! recdepend vars : config_flags,i_end,i_start,ide,ite,j_end,j_start,spe
1610 ! cified
1611 ! recompute pos : IF_STMT module_advect_em.f90:3580
1612 ! recompute vars : i_end
1613 if (config_flags%open_xe .or. specified) then
1614 i_end = min(ide-2,ite)
1615 endif
1616 ! recompute vars : i_end
1617 do j = j_start, j_end
1618 do k = kts, ktf
1619 do i = i_start, i_end
1620 mrdx = msft(i,j)*rdx
1621 ! recompute : mrdx
1622 a_field(i-1,k,j) = a_field(i-1,k,j)+0.5*a_tendency(i,k,j)*mrdx*ru(i,k,j)
1623 a_field(i+1,k,j) = a_field(i+1,k,j)-0.5*a_tendency(i,k,j)*mrdx*ru(i+1,k,j)
1624 a_field(i,k,j) = a_field(i,k,j)-0.5*a_tendency(i,k,j)*mrdx*(ru(i+1,k,j)-ru(i,k,j))
1625 a_ru(i+1,k,j) = a_ru(i+1,k,j)-0.5*a_tendency(i,k,j)*mrdx*(field(i+1,k,j)+field(i,k,j))
1626 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_tendency(i,k,j)*mrdx*(field(i,k,j)+field(i-1,k,j))
1627 end do
1628 end do
1629 end do
1630 endif a_horizontal_order_test
1631
1632 end subroutine a_advect_scalar
1633
1634
1635 subroutine a_advect_u( u, a_u, u_old, a_u_old, a_tendency, ru, a_ru, rv, a_rv, rom, a_rom, mut, a_mut, config_flags, msfu, fzm, &
1636 &fzp, rdx, rdy, rdzw, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1637 !******************************************************************
1638 !******************************************************************
1639 !** This routine was generated by Automatic differentiation. **
1640 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1641 !******************************************************************
1642 !******************************************************************
1643 !==============================================
1644 ! all entries are defined explicitly
1645 !==============================================
1646 implicit none
1647
1648 !==============================================
1649 ! declare arguments
1650 !==============================================
1651 integer, intent(in) :: ime
1652 integer, intent(in) :: ims
1653 integer, intent(in) :: jme
1654 integer, intent(in) :: jms
1655 real, intent(inout) :: a_mut(ims:ime,jms:jme)
1656 integer, intent(in) :: kme
1657 integer, intent(in) :: kms
1658 real, intent(inout) :: a_rom(ims:ime,kms:kme,jms:jme)
1659 real, intent(inout) :: a_ru(ims:ime,kms:kme,jms:jme)
1660 real, intent(inout) :: a_rv(ims:ime,kms:kme,jms:jme)
1661 real, intent(inout) :: a_tendency(ims:ime,kms:kme,jms:jme)
1662 real, intent(inout) :: a_u(ims:ime,kms:kme,jms:jme)
1663 real, intent(inout) :: a_u_old(ims:ime,kms:kme,jms:jme)
1664 type (grid_config_rec_type), intent(in) :: config_flags
1665 real, intent(in) :: fzm(kms:kme)
1666 real, intent(in) :: fzp(kms:kme)
1667 integer, intent(in) :: ide
1668 integer, intent(in) :: ids
1669 integer, intent(in) :: ite
1670 integer, intent(in) :: its
1671 integer, intent(in) :: jde
1672 integer, intent(in) :: jds
1673 integer, intent(in) :: jte
1674 integer, intent(in) :: jts
1675 integer, intent(in) :: kde
1676 integer, intent(in) :: kte
1677 integer, intent(in) :: kts
1678 real, intent(in) :: msfu(ims:ime,jms:jme)
1679 real, intent(in) :: mut(ims:ime,jms:jme)
1680 real, intent(in) :: rdx
1681 real, intent(in) :: rdy
1682 real, intent(in) :: rdzw(kms:kme)
1683 real, intent(in) :: rom(ims:ime,kms:kme,jms:jme)
1684 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
1685 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
1686 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
1687 real, intent(in) :: u_old(ims:ime,kms:kme,jms:jme)
1688
1689 !==============================================
1690 ! declare local variables
1691 !==============================================
1692 real a_dvm
1693 real a_dvp
1694 real a_fqx(its-1:ite+1,kts:kte)
1695 real a_fqy(its:ite,kts:kte,2)
1696 real a_ub
1697 real a_vb
1698 real a_vel
1699 real a_vflux(its:ite,kts:kte)
1700 real a_vw
1701 logical degrade_xe
1702 logical degrade_xs
1703 logical degrade_ye
1704 logical degrade_ys
1705 real dvm
1706 real dvp
1707 integer horz_order
1708 integer i
1709 integer i_end
1710 integer i_end_f
1711 integer i_start
1712 integer i_start_f
1713 integer im
1714 integer imax
1715 integer imin
1716 integer ip
1717 integer j
1718 integer j1
1719 integer j2
1720 integer j3
1721 integer j4
1722 integer j_end
1723 integer j_end_f
1724 integer j_start
1725 integer j_start_f
1726 integer jp0
1727 integer jp1
1728 integer jtmp
1729 integer k
1730 integer ktf
1731 real mrdx
1732 real mrdy
1733 logical specified
1734 real ub
1735 real vb
1736 real vel
1737 integer vert_order
1738 real vw
1739
1740 !----------------------------------------------
1741 ! RESET LOCAL ADJOINT VARIABLES
1742 !----------------------------------------------
1743 a_dvm = 0.
1744 a_dvp = 0.
1745 a_fqx(:,:) = 0.
1746 a_fqy(:,:,:) = 0.
1747 a_ub = 0.
1748 a_vb = 0.
1749 a_vel = 0.
1750 a_vflux(:,:) = 0.
1751 a_vw = 0.
1752
1753 !----------------------------------------------
1754 ! ROUTINE BODY
1755 !----------------------------------------------
1756 specified = .false.
1757 ! recompute : specified
1758 if (config_flags%specified .or. config_flags%nested) then
1759 specified = .true.
1760 endif
1761 ! recompute : specified
1762 horz_order = config_flags%h_mom_adv_order
1763 ! recompute : horz_order
1764 vert_order = config_flags%v_mom_adv_order
1765 ! recompute : vert_order
1766 ktf = min(kte,kde-1)
1767 ! recompute : ktf
1768 imin = ids
1769 ! recompute : imin
1770 imax = ide-1
1771 ! recompute : imax
1772 if (config_flags%open_xs) then
1773 imin = ids
1774 endif
1775 ! recompute : imin
1776 if (config_flags%open_xe) then
1777 imax = ide-1
1778 endif
1779 ! recompute : imax
1780 i_start = its
1781 ! recompute : i_start
1782 i_end = ite
1783 ! recompute : i_end
1784 j_start = jts
1785 ! recompute : j_start
1786 j_end = min(jte,jde-1)
1787 ! recompute : j_end
1788 if (config_flags%open_ys .or. specified) then
1789 i_start = max(ids+1,its)
1790 endif
1791 ! recompute : i_start
1792 if (config_flags%open_ye .or. specified) then
1793 i_end = min(ide-1,ite)
1794 endif
1795 ! recompute : i_end
1796 a_vert_order_test: if (vert_order .eq. 6) then
1797 do j = j_end, j_start, -1
1798 do k = kts, ktf
1799 do i = i_start, i_end
1800 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
1801 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
1802 end do
1803 end do
1804 do i = i_start, i_end
1805 a_vel = 0.
1806 k = ktf-1
1807 ! recompute : k
1808 vel = 0.5*(rom(i,k,j)+rom(i-1,k,j))
1809 ! recompute : vel
1810 k = ktf
1811 ! recompute : k
1812 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
1813 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
1814 a_u(i,k-1,j) = a_u(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)
1815 a_u(i,k,j) = a_u(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
1816 a_vflux(i,k) = 0.
1817 ! recdepend vars : ktf
1818 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1251
1819 ! recompute vars : k
1820 k = ktf-1
1821 ! recompute vars : k
1822 a_u(i,k-2,j) = a_u(i,k-2,j)-0.083333333*a_vflux(i,k)*vel
1823 a_u(i,k-1,j) = a_u(i,k-1,j)+0.58333333*a_vflux(i,k)*vel
1824 a_u(i,k+1,j) = a_u(i,k+1,j)-0.083333333*a_vflux(i,k)*vel
1825 a_u(i,k,j) = a_u(i,k,j)+0.58333333*a_vflux(i,k)*vel
1826 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(u(i,k,j)+u(i,k-1,j))-0.083333333*(u(i,k+1,j)+u(i,k-2,j)))
1827 a_vflux(i,k) = 0.
1828 ! recdepend vars : ktf
1829 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1251
1830 ! recompute vars : k
1831 k = ktf-1
1832 ! recompute vars : k
1833 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vel
1834 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
1835 a_vel = 0.
1836 ! recdepend vars : kts
1837 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1246
1838 ! recompute vars : k
1839 k = kts+2
1840 ! recompute vars : k
1841 ! recdepend vars : i,j,k,rom
1842 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1247
1843 ! recompute vars : vel
1844 vel = 0.5*(rom(i,k,j)+rom(i-1,k,j))
1845 ! recompute vars : vel
1846 a_u(i,k-2,j) = a_u(i,k-2,j)-0.083333333*a_vflux(i,k)*vel
1847 a_u(i,k-1,j) = a_u(i,k-1,j)+0.58333333*a_vflux(i,k)*vel
1848 a_u(i,k+1,j) = a_u(i,k+1,j)-0.083333333*a_vflux(i,k)*vel
1849 a_u(i,k,j) = a_u(i,k,j)+0.58333333*a_vflux(i,k)*vel
1850 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(u(i,k,j)+u(i,k-1,j))-0.083333333*(u(i,k+1,j)+u(i,k-2,j)))
1851 a_vflux(i,k) = 0.
1852 ! recdepend vars : kts
1853 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1246
1854 ! recompute vars : k
1855 k = kts+2
1856 ! recompute vars : k
1857 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vel
1858 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
1859 a_vel = 0.
1860 ! recdepend vars : kts
1861 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1243
1862 ! recompute vars : k
1863 k = kts+1
1864 ! recompute vars : k
1865 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
1866 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
1867 a_u(i,k-1,j) = a_u(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)
1868 a_u(i,k,j) = a_u(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
1869 a_vflux(i,k) = 0.
1870 end do
1871 do k = kts+3, ktf-2
1872 a_vel = 0.
1873 do i = i_start, i_end
1874 a_vel = 0.
1875 vel = 0.5*(rom(i-1,k,j)+rom(i,k,j))
1876 ! recompute : vel
1877 a_u(i,k-3,j) = a_u(i,k-3,j)+0.016666667*a_vflux(i,k)*vel
1878 a_u(i,k-2,j) = a_u(i,k-2,j)-0.13333333*a_vflux(i,k)*vel
1879 a_u(i,k-1,j) = a_u(i,k-1,j)+0.61666667*a_vflux(i,k)*vel
1880 a_u(i,k+2,j) = a_u(i,k+2,j)+0.016666667*a_vflux(i,k)*vel
1881 a_u(i,k+1,j) = a_u(i,k+1,j)-0.13333333*a_vflux(i,k)*vel
1882 a_u(i,k,j) = a_u(i,k,j)+0.61666667*a_vflux(i,k)*vel
1883 a_vel = a_vel+a_vflux(i,k)*(0.61666667*(u(i,k,j)+u(i,k-1,j))-0.13333333*(u(i,k+1,j)+u(i,k-2,j))+0.016666667*(u(i,k+2,j)+&
1884 &u(i,k-3,j)))
1885 a_vflux(i,k) = 0.
1886 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vel
1887 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
1888 a_vel = 0.
1889 end do
1890 end do
1891 end do
1892 else if (vert_order .eq. 5) then a_vert_order_test
1893 do j = j_end, j_start, -1
1894 do k = kts, ktf
1895 do i = i_start, i_end
1896 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
1897 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
1898 end do
1899 end do
1900 do i = i_start, i_end
1901 a_vel = 0.
1902 k = ktf-1
1903 ! recompute : k
1904 vel = 0.5*(rom(i,k,j)+rom(i-1,k,j))
1905 ! recompute : vel
1906 k = ktf
1907 ! recompute : k
1908 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
1909 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
1910 a_u(i,k-1,j) = a_u(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)
1911 a_u(i,k,j) = a_u(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
1912 a_vflux(i,k) = 0.
1913 ! recdepend vars : ktf
1914 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1291
1915 ! recompute vars : k
1916 k = ktf-1
1917 ! recompute vars : k
1918 a_u(i,k-2,j) = a_u(i,k-2,j)+a_vflux(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))
1919 a_u(i,k-1,j) = a_u(i,k-1,j)+a_vflux(i,k)*vel*(0.58333333+0.25*sign(1.,-vel))
1920 a_u(i,k+1,j) = a_u(i,k+1,j)+a_vflux(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))
1921 a_u(i,k,j) = a_u(i,k,j)+a_vflux(i,k)*vel*(0.58333333+(-0.25)*sign(1.,-vel))
1922 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(u(i,k,j)+u(i,k-1,j))-0.083333333*(u(i,k+1,j)+u(i,k-2,j))+0.083333333*(u(i,k+1,j)-u(i,&
1923 &k-2,j)-3.*(u(i,k,j)-u(i,k-1,j)))*sign(1.,-vel))
1924 a_vflux(i,k) = 0.
1925 ! recdepend vars : ktf
1926 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1291
1927 ! recompute vars : k
1928 k = ktf-1
1929 ! recompute vars : k
1930 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vel
1931 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
1932 a_vel = 0.
1933 ! recdepend vars : kts
1934 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1286
1935 ! recompute vars : k
1936 k = kts+2
1937 ! recompute vars : k
1938 ! recdepend vars : i,j,k,rom
1939 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1287
1940 ! recompute vars : vel
1941 vel = 0.5*(rom(i,k,j)+rom(i-1,k,j))
1942 ! recompute vars : vel
1943 a_u(i,k-2,j) = a_u(i,k-2,j)+a_vflux(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))
1944 a_u(i,k-1,j) = a_u(i,k-1,j)+a_vflux(i,k)*vel*(0.58333333+0.25*sign(1.,-vel))
1945 a_u(i,k+1,j) = a_u(i,k+1,j)+a_vflux(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))
1946 a_u(i,k,j) = a_u(i,k,j)+a_vflux(i,k)*vel*(0.58333333+(-0.25)*sign(1.,-vel))
1947 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(u(i,k,j)+u(i,k-1,j))-0.083333333*(u(i,k+1,j)+u(i,k-2,j))+0.083333333*(u(i,k+1,j)-u(i,&
1948 &k-2,j)-3.*(u(i,k,j)-u(i,k-1,j)))*sign(1.,-vel))
1949 a_vflux(i,k) = 0.
1950 ! recdepend vars : kts
1951 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1286
1952 ! recompute vars : k
1953 k = kts+2
1954 ! recompute vars : k
1955 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vel
1956 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
1957 a_vel = 0.
1958 ! recdepend vars : kts
1959 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1283
1960 ! recompute vars : k
1961 k = kts+1
1962 ! recompute vars : k
1963 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
1964 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
1965 a_u(i,k-1,j) = a_u(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)
1966 a_u(i,k,j) = a_u(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
1967 a_vflux(i,k) = 0.
1968 end do
1969 do k = kts+3, ktf-2
1970 a_vel = 0.
1971 do i = i_start, i_end
1972 a_vel = 0.
1973 vel = 0.5*(rom(i-1,k,j)+rom(i,k,j))
1974 ! recompute : vel
1975 a_u(i,k-3,j) = a_u(i,k-3,j)+a_vflux(i,k)*vel*(0.016666667-(-0.016666667)*sign(1.,-vel))
1976 a_u(i,k-2,j) = a_u(i,k-2,j)+a_vflux(i,k)*vel*((-0.13333333)-0.083333333*sign(1.,-vel))
1977 a_u(i,k-1,j) = a_u(i,k-1,j)+a_vflux(i,k)*vel*(0.61666667-(-0.16666667)*sign(1.,-vel))
1978 a_u(i,k+2,j) = a_u(i,k+2,j)+a_vflux(i,k)*vel*(0.016666667-0.016666667*sign(1.,-vel))
1979 a_u(i,k+1,j) = a_u(i,k+1,j)+a_vflux(i,k)*vel*((-0.13333333)-(-0.083333333)*sign(1.,-vel))
1980 a_u(i,k,j) = a_u(i,k,j)+a_vflux(i,k)*vel*(0.61666667-0.16666667*sign(1.,-vel))
1981 a_vel = a_vel+a_vflux(i,k)*(0.61666667*(u(i,k,j)+u(i,k-1,j))-0.13333333*(u(i,k+1,j)+u(i,k-2,j))+0.016666667*(u(i,k+2,j)+&
1982 &u(i,k-3,j))-0.016666667*(u(i,k+2,j)-u(i,k-3,j)-5.*(u(i,k+1,j)-u(i,k-2,j))+10.*(u(i,k,j)-u(i,k-1,j)))*sign(1.,-vel))
1983 a_vflux(i,k) = 0.
1984 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vel
1985 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
1986 a_vel = 0.
1987 end do
1988 end do
1989 end do
1990 else if (vert_order .eq. 4) then a_vert_order_test
1991 do j = j_end, j_start, -1
1992 do k = kts, ktf
1993 do i = i_start, i_end
1994 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
1995 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
1996 end do
1997 end do
1998 do i = i_start, i_end
1999 k = ktf
2000 ! recompute : k
2001 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2002 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2003 a_u(i,k-1,j) = a_u(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)
2004 a_u(i,k,j) = a_u(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2005 a_vflux(i,k) = 0.
2006 ! recdepend vars : kts
2007 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1323
2008 ! recompute vars : k
2009 k = kts+1
2010 ! recompute vars : k
2011 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2012 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2013 a_u(i,k-1,j) = a_u(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)
2014 a_u(i,k,j) = a_u(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2015 a_vflux(i,k) = 0.
2016 end do
2017 do k = kts+2, ktf-1
2018 a_vel = 0.
2019 do i = i_start, i_end
2020 a_vel = 0.
2021 vel = 0.5*(rom(i-1,k,j)+rom(i,k,j))
2022 ! recompute : vel
2023 a_u(i,k-2,j) = a_u(i,k-2,j)-0.083333333*a_vflux(i,k)*vel
2024 a_u(i,k-1,j) = a_u(i,k-1,j)+0.58333333*a_vflux(i,k)*vel
2025 a_u(i,k+1,j) = a_u(i,k+1,j)-0.083333333*a_vflux(i,k)*vel
2026 a_u(i,k,j) = a_u(i,k,j)+0.58333333*a_vflux(i,k)*vel
2027 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(u(i,k,j)+u(i,k-1,j))-0.083333333*(u(i,k+1,j)+u(i,k-2,j)))
2028 a_vflux(i,k) = 0.
2029 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vel
2030 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
2031 a_vel = 0.
2032 end do
2033 end do
2034 end do
2035 else if (vert_order .eq. 3) then a_vert_order_test
2036 do j = j_end, j_start, -1
2037 do k = kts, ktf
2038 do i = i_start, i_end
2039 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
2040 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
2041 end do
2042 end do
2043 do i = i_start, i_end
2044 k = ktf
2045 ! recompute : k
2046 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2047 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2048 a_u(i,k-1,j) = a_u(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)
2049 a_u(i,k,j) = a_u(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2050 a_vflux(i,k) = 0.
2051 ! recdepend vars : kts
2052 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1353
2053 ! recompute vars : k
2054 k = kts+1
2055 ! recompute vars : k
2056 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2057 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2058 a_u(i,k-1,j) = a_u(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)
2059 a_u(i,k,j) = a_u(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2060 a_vflux(i,k) = 0.
2061 end do
2062 do k = kts+2, ktf-1
2063 a_vel = 0.
2064 do i = i_start, i_end
2065 a_vel = 0.
2066 vel = 0.5*(rom(i-1,k,j)+rom(i,k,j))
2067 ! recompute : vel
2068 a_u(i,k-2,j) = a_u(i,k-2,j)+a_vflux(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))
2069 a_u(i,k-1,j) = a_u(i,k-1,j)+a_vflux(i,k)*vel*(0.58333333+0.25*sign(1.,-vel))
2070 a_u(i,k+1,j) = a_u(i,k+1,j)+a_vflux(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))
2071 a_u(i,k,j) = a_u(i,k,j)+a_vflux(i,k)*vel*(0.58333333+(-0.25)*sign(1.,-vel))
2072 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(u(i,k,j)+u(i,k-1,j))-0.083333333*(u(i,k+1,j)+u(i,k-2,j))+0.083333333*(u(i,k+1,j)-&
2073 &u(i,k-2,j)-3.*(u(i,k,j)-u(i,k-1,j)))*sign(1.,-vel))
2074 a_vflux(i,k) = 0.
2075 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vel
2076 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
2077 a_vel = 0.
2078 end do
2079 end do
2080 end do
2081 else if (vert_order .eq. 2) then a_vert_order_test
2082 do j = j_start, j_end
2083 do k = kts, ktf
2084 do i = i_start, i_end
2085 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
2086 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
2087 end do
2088 end do
2089 do k = kts+1, ktf
2090 do i = i_start, i_end
2091 a_rom(i-1,k,j) = a_rom(i-1,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2092 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2093 a_u(i,k-1,j) = a_u(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)
2094 a_u(i,k,j) = a_u(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2095 a_vflux(i,k) = 0.
2096 end do
2097 end do
2098 end do
2099 endif a_vert_order_test
2100 ! recdepend vars : its
2101 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1152
2102 ! recompute vars : i_start
2103 i_start = its
2104 ! recompute vars : i_start
2105 ! recdepend vars : i_start,ide,ite
2106 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1153
2107 ! recompute vars : i_end
2108 i_end = min(ite,ide)
2109 ! recompute vars : i_end
2110 ! recdepend vars : config_flags,i_end,i_start,ids,its
2111 ! recompute pos : IF_STMT module_advect_em.f90:1157
2112 ! recompute vars : i_start
2113 if (config_flags%open_xs) then
2114 i_start = max(ids+1,its)
2115 endif
2116 ! recompute vars : i_start
2117 ! recdepend vars : config_flags,i_end,i_start,ide,ite
2118 ! recompute pos : IF_STMT module_advect_em.f90:1161
2119 ! recompute vars : i_end
2120 if (config_flags%open_xe) then
2121 i_end = min(ite,ide-1)
2122 endif
2123 ! recompute vars : i_end
2124 if (config_flags%open_ye .and. jte .eq. jde) then
2125 do i = i_start, i_end
2126 a_dvm = 0.
2127 a_dvp = 0.
2128 a_vb = 0.
2129 a_vw = 0.
2130 mrdy = msfu(i,jte-1)*rdy
2131 ! recompute : mrdy
2132 ip = min(imax,i)
2133 ! recompute : ip
2134 im = max(imin,i-1)
2135 ! recompute : im
2136 do k = kts, ktf
2137 a_dvm = 0.
2138 a_dvp = 0.
2139 a_vb = 0.
2140 a_vw = 0.
2141 vw = 0.5*(rv(ip,k,jte)+rv(im,k,jte))
2142 ! recompute : vw
2143 vb = max(vw,0.)
2144 ! recompute : vb
2145 dvm = rv(ip,k,jte)-rv(ip,k,jte-1)
2146 ! recompute : dvm
2147 dvp = rv(im,k,jte)-rv(im,k,jte-1)
2148 ! recompute : dvp
2149 a_dvm = a_dvm-0.5*a_tendency(i,k,jte-1)*mrdy*u(i,k,jte-1)
2150 a_dvp = a_dvp-0.5*a_tendency(i,k,jte-1)*mrdy*u(i,k,jte-1)
2151 a_u(i,k,jte-1) = a_u(i,k,jte-1)-0.5*a_tendency(i,k,jte-1)*mrdy*(dvm+dvp)
2152 a_u_old(i,k,jte-2) = a_u_old(i,k,jte-2)+a_tendency(i,k,jte-1)*mrdy*vb
2153 a_u_old(i,k,jte-1) = a_u_old(i,k,jte-1)-a_tendency(i,k,jte-1)*mrdy*vb
2154 a_vb = a_vb-a_tendency(i,k,jte-1)*mrdy*(u_old(i,k,jte-1)-u_old(i,k,jte-2))
2155 a_rv(im,k,jte-1) = a_rv(im,k,jte-1)-a_dvp
2156 a_rv(im,k,jte) = a_rv(im,k,jte)+a_dvp
2157 a_dvp = 0.
2158 a_rv(ip,k,jte-1) = a_rv(ip,k,jte-1)-a_dvm
2159 a_rv(ip,k,jte) = a_rv(ip,k,jte)+a_dvm
2160 a_dvm = 0.
2161 a_vw = a_vw+a_vb*(0.5+sign(0.5,vw-0.))
2162 a_vb = 0.
2163 a_rv(im,k,jte) = a_rv(im,k,jte)+0.5*a_vw
2164 a_rv(ip,k,jte) = a_rv(ip,k,jte)+0.5*a_vw
2165 a_vw = 0.
2166 end do
2167 end do
2168 endif
2169 ! recdepend vars : its
2170 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1152
2171 ! recompute vars : i_start
2172 i_start = its
2173 ! recompute vars : i_start
2174 ! recdepend vars : i_start,ide,ite
2175 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1153
2176 ! recompute vars : i_end
2177 i_end = min(ite,ide)
2178 ! recompute vars : i_end
2179 ! recdepend vars : config_flags,i_end,i_start,ids,its
2180 ! recompute pos : IF_STMT module_advect_em.f90:1157
2181 ! recompute vars : i_start
2182 if (config_flags%open_xs) then
2183 i_start = max(ids+1,its)
2184 endif
2185 ! recompute vars : i_start
2186 ! recdepend vars : config_flags,i_end,i_start,ide,ite
2187 ! recompute pos : IF_STMT module_advect_em.f90:1161
2188 ! recompute vars : i_end
2189 if (config_flags%open_xe) then
2190 i_end = min(ite,ide-1)
2191 endif
2192 ! recompute vars : i_end
2193 if (config_flags%open_ys .and. jts .eq. jds) then
2194 do i = i_start, i_end
2195 a_dvm = 0.
2196 a_dvp = 0.
2197 a_vb = 0.
2198 a_vw = 0.
2199 mrdy = msfu(i,jts)*rdy
2200 ! recompute : mrdy
2201 ip = min(imax,i)
2202 ! recompute : ip
2203 im = max(imin,i-1)
2204 ! recompute : im
2205 do k = kts, ktf
2206 a_dvm = 0.
2207 a_dvp = 0.
2208 a_vb = 0.
2209 a_vw = 0.
2210 vw = 0.5*(rv(ip,k,jts)+rv(im,k,jts))
2211 ! recompute : vw
2212 vb = min(vw,0.)
2213 ! recompute : vb
2214 dvm = rv(ip,k,jts+1)-rv(ip,k,jts)
2215 ! recompute : dvm
2216 dvp = rv(im,k,jts+1)-rv(im,k,jts)
2217 ! recompute : dvp
2218 a_dvm = a_dvm-0.5*a_tendency(i,k,jts)*mrdy*u(i,k,jts)
2219 a_dvp = a_dvp-0.5*a_tendency(i,k,jts)*mrdy*u(i,k,jts)
2220 a_u(i,k,jts) = a_u(i,k,jts)-0.5*a_tendency(i,k,jts)*mrdy*(dvm+dvp)
2221 a_u_old(i,k,jts+1) = a_u_old(i,k,jts+1)-a_tendency(i,k,jts)*mrdy*vb
2222 a_u_old(i,k,jts) = a_u_old(i,k,jts)+a_tendency(i,k,jts)*mrdy*vb
2223 a_vb = a_vb-a_tendency(i,k,jts)*mrdy*(u_old(i,k,jts+1)-u_old(i,k,jts))
2224 a_rv(im,k,jts+1) = a_rv(im,k,jts+1)+a_dvp
2225 a_rv(im,k,jts) = a_rv(im,k,jts)-a_dvp
2226 a_dvp = 0.
2227 a_rv(ip,k,jts+1) = a_rv(ip,k,jts+1)+a_dvm
2228 a_rv(ip,k,jts) = a_rv(ip,k,jts)-a_dvm
2229 a_dvm = 0.
2230 a_vw = a_vw+a_vb*(0.5+sign(0.5,0.-vw))
2231 a_vb = 0.
2232 a_rv(im,k,jts) = a_rv(im,k,jts)+0.5*a_vw
2233 a_rv(ip,k,jts) = a_rv(ip,k,jts)+0.5*a_vw
2234 a_vw = 0.
2235 end do
2236 end do
2237 endif
2238 if (config_flags%open_xe .and. ite .eq. ide) then
2239 j_start = jts
2240 ! recompute : j_start
2241 j_end = min(jte,jde-1)
2242 ! recompute : j_end
2243 do j = j_start, j_end
2244 a_ub = 0.
2245 do k = kts, ktf
2246 a_ub = 0.
2247 ub = max(ru(ite,k,j)+cb*mut(ite-1,j),0.)
2248 ! recompute : ub
2249 a_u_old(ite-1,k,j) = a_u_old(ite-1,k,j)+a_tendency(ite,k,j)*rdx*ub
2250 a_u_old(ite,k,j) = a_u_old(ite,k,j)-a_tendency(ite,k,j)*rdx*ub
2251 a_ub = a_ub-a_tendency(ite,k,j)*rdx*(u_old(ite,k,j)-u_old(ite-1,k,j))
2252 a_mut(ite-1,j) = a_mut(ite-1,j)+a_ub*(0.5+sign(0.5,ru(ite,k,j)+cb*mut(ite-1,j)-0.))*cb
2253 a_ru(ite,k,j) = a_ru(ite,k,j)+a_ub*(0.5+sign(0.5,ru(ite,k,j)+cb*mut(ite-1,j)-0.))
2254 a_ub = 0.
2255 end do
2256 end do
2257 endif
2258 if (config_flags%open_xs .and. its .eq. ids) then
2259 j_start = jts
2260 ! recompute : j_start
2261 j_end = min(jte,jde-1)
2262 ! recompute : j_end
2263 do j = j_start, j_end
2264 a_ub = 0.
2265 do k = kts, ktf
2266 a_ub = 0.
2267 ub = min(ru(its,k,j)-cb*mut(its,j),0.)
2268 ! recompute : ub
2269 a_u_old(its+1,k,j) = a_u_old(its+1,k,j)-a_tendency(its,k,j)*rdx*ub
2270 a_u_old(its,k,j) = a_u_old(its,k,j)+a_tendency(its,k,j)*rdx*ub
2271 a_ub = a_ub-a_tendency(its,k,j)*rdx*(u_old(its+1,k,j)-u_old(its,k,j))
2272 a_mut(its,j) = a_mut(its,j)-a_ub*(0.5+sign(0.5,0.-(ru(its,k,j)-cb*mut(its,j))))*cb
2273 a_ru(its,k,j) = a_ru(its,k,j)+a_ub*(0.5+sign(0.5,0.-(ru(its,k,j)-cb*mut(its,j))))
2274 a_ub = 0.
2275 end do
2276 end do
2277 endif
2278 a_horizontal_order_test: if (horz_order .eq. 6) then
2279 degrade_xs = .true.
2280 ! recompute : degrade_xs
2281 degrade_xe = .true.
2282 ! recompute : degrade_xe
2283 degrade_ys = .true.
2284 ! recompute : degrade_ys
2285 degrade_ye = .true.
2286 ! recompute : degrade_ye
2287 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
2288 degrade_xs = .false.
2289 endif
2290 ! recompute : degrade_xs
2291 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
2292 degrade_xe = .false.
2293 endif
2294 ! recompute : degrade_xe
2295 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
2296 degrade_ys = .false.
2297 endif
2298 ! recompute : degrade_ys
2299 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-3) then
2300 degrade_ye = .false.
2301 endif
2302 ! recompute : degrade_ye
2303 j_start = jts
2304 ! recompute : j_start
2305 j_end = min(jte,jde-1)
2306 ! recompute : j_end
2307 j_start_f = j_start
2308 ! recompute : j_start_f
2309 j_end_f = j_end+1
2310 ! recompute : j_end_f
2311 if (degrade_ys) then
2312 j_start_f = jds+3
2313 endif
2314 ! recompute : j_start_f
2315 if (degrade_ye) then
2316 j_end_f = jde-3
2317 endif
2318 ! recompute : j_end_f
2319 i_start = its
2320 ! recompute : i_start
2321 i_end = ite
2322 ! recompute : i_end
2323 j_start = jts
2324 ! recompute : j_start
2325 j_end = min(jte,jde-1)
2326 ! recompute : j_end
2327 i_start_f = i_start
2328 ! recompute : i_start_f
2329 i_end_f = i_end+1
2330 ! recompute : i_end_f
2331 if (degrade_xs) then
2332 i_start = max(ids+1,its)
2333 i_start_f = ids+3
2334 endif
2335 ! recompute : i_start,i_start_f
2336 if (degrade_xe) then
2337 i_end = min(ide-1,ite)
2338 i_end_f = ide-2
2339 endif
2340 ! recompute : i_end,i_end_f
2341 do j = j_end, j_start, -1
2342 do k = kts, ktf
2343 do i = i_start, i_end
2344 mrdx = msfu(i,j)*rdx
2345 ! recompute : mrdx
2346 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
2347 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
2348 end do
2349 end do
2350 if (degrade_xe) then
2351 do k = kts, ktf
2352 a_vel = 0.
2353 i = ide-1
2354 ! recompute : i
2355 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
2356 ! recompute : vel
2357 a_u(i-2,k,j) = a_u(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
2358 a_u(i-1,k,j) = a_u(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
2359 a_u(i+1,k,j) = a_u(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
2360 a_u(i,k,j) = a_u(i,k,j)+0.58333333*a_fqx(i,k)*vel
2361 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(u(i,k,j)+u(i-1,k,j))-0.083333333*(u(i+1,k,j)+u(i-2,k,j)))
2362 a_fqx(i,k) = 0.
2363 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.5*a_vel
2364 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
2365 a_vel = 0.
2366 end do
2367 if (i_end .eq. ide-1) then
2368 i = ide
2369 ! recompute : i
2370 do k = kts, ktf
2371 a_ub = 0.
2372 ub = u(i,k,j)
2373 ! recompute : ub
2374 if (specified .and. u(i-1,k,j) .gt. 0.) then
2375 ub = u(i-1,k,j)
2376 endif
2377 ! recompute : ub
2378 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.25*a_fqx(i,k)*(u(i-1,k,j)+ub)
2379 a_ru(i,k,j) = a_ru(i,k,j)+0.25*a_fqx(i,k)*(u(i-1,k,j)+ub)
2380 a_u(i-1,k,j) = a_u(i-1,k,j)+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
2381 a_ub = a_ub+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
2382 a_fqx(i,k) = 0.
2383 if (specified .and. u(i-1,k,j) .gt. 0.) then
2384 a_u(i-1,k,j) = a_u(i-1,k,j)+a_ub
2385 a_ub = 0.
2386 endif
2387 a_u(i,k,j) = a_u(i,k,j)+a_ub
2388 a_ub = 0.
2389 end do
2390 endif
2391 endif
2392 if (degrade_xs) then
2393 i = ids+2
2394 ! recompute : i
2395 do k = kts, ktf
2396 a_vel = 0.
2397 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
2398 ! recompute : vel
2399 a_u(i-2,k,j) = a_u(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
2400 a_u(i-1,k,j) = a_u(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
2401 a_u(i+1,k,j) = a_u(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
2402 a_u(i,k,j) = a_u(i,k,j)+0.58333333*a_fqx(i,k)*vel
2403 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(u(i,k,j)+u(i-1,k,j))-0.083333333*(u(i+1,k,j)+u(i-2,k,j)))
2404 a_fqx(i,k) = 0.
2405 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.5*a_vel
2406 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
2407 a_vel = 0.
2408 end do
2409 if (i_start .eq. ids+1) then
2410 i = ids+1
2411 ! recompute : i
2412 do k = kts, ktf
2413 a_ub = 0.
2414 ub = u(i-1,k,j)
2415 ! recompute : ub
2416 if (specified .and. u(i,k,j) .lt. 0.) then
2417 ub = u(i,k,j)
2418 endif
2419 ! recompute : ub
2420 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.25*a_fqx(i,k)*(u(i,k,j)+ub)
2421 a_ru(i,k,j) = a_ru(i,k,j)+0.25*a_fqx(i,k)*(u(i,k,j)+ub)
2422 a_u(i,k,j) = a_u(i,k,j)+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
2423 a_ub = a_ub+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
2424 a_fqx(i,k) = 0.
2425 if (specified .and. u(i,k,j) .lt. 0.) then
2426 a_u(i,k,j) = a_u(i,k,j)+a_ub
2427 a_ub = 0.
2428 endif
2429 a_u(i-1,k,j) = a_u(i-1,k,j)+a_ub
2430 a_ub = 0.
2431 end do
2432 endif
2433 endif
2434 do k = kts, ktf
2435 a_vel = 0.
2436 do i = i_start_f, i_end_f
2437 a_vel = 0.
2438 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
2439 ! recompute : vel
2440 a_u(i-3,k,j) = a_u(i-3,k,j)+0.016666667*a_fqx(i,k)*vel
2441 a_u(i-2,k,j) = a_u(i-2,k,j)-0.13333333*a_fqx(i,k)*vel
2442 a_u(i-1,k,j) = a_u(i-1,k,j)+0.61666667*a_fqx(i,k)*vel
2443 a_u(i+2,k,j) = a_u(i+2,k,j)+0.016666667*a_fqx(i,k)*vel
2444 a_u(i+1,k,j) = a_u(i+1,k,j)-0.13333333*a_fqx(i,k)*vel
2445 a_u(i,k,j) = a_u(i,k,j)+0.61666667*a_fqx(i,k)*vel
2446 a_vel = a_vel+a_fqx(i,k)*(0.61666667*(u(i,k,j)+u(i-1,k,j))-0.13333333*(u(i+1,k,j)+u(i-2,k,j))+0.016666667*(u(i+2,k,j)+u(i-&
2447 &3,k,j)))
2448 a_fqx(i,k) = 0.
2449 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.5*a_vel
2450 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
2451 a_vel = 0.
2452 end do
2453 end do
2454 end do
2455 ! recdepend vars : its
2456 ! recompute pos : ASSIGN_STMT module_advect_em.f90:249
2457 ! recompute vars : i_start
2458 i_start = its
2459 ! recompute vars : i_start
2460 ! recdepend vars : i_start,ite
2461 ! recompute pos : ASSIGN_STMT module_advect_em.f90:250
2462 ! recompute vars : i_end
2463 i_end = ite
2464 ! recompute vars : i_end
2465 ! recdepend vars : config_flags,i_end,i_start,ids,its,specified
2466 ! recompute pos : IF_STMT module_advect_em.f90:251
2467 ! recompute vars : i_start
2468 if (config_flags%open_xs .or. specified) then
2469 i_start = max(ids+1,its)
2470 endif
2471 ! recompute vars : i_start
2472 ! recdepend vars : config_flags,i_end,i_start,ide,ite,specified
2473 ! recompute pos : IF_STMT module_advect_em.f90:252
2474 ! recompute vars : i_end
2475 if (config_flags%open_xe .or. specified) then
2476 i_end = min(ide-1,ite)
2477 endif
2478 ! recompute vars : i_end
2479 ! recdepend vars : i_end,i_start,jts
2480 ! recompute pos : ASSIGN_STMT module_advect_em.f90:254
2481 ! recompute vars : j_start
2482 j_start = jts
2483 ! recompute vars : j_start
2484 ! recdepend vars : i_end,i_start,j_start,jde,jte
2485 ! recompute pos : ASSIGN_STMT module_advect_em.f90:255
2486 ! recompute vars : j_end
2487 j_end = min(jte,jde-1)
2488 ! recompute vars : j_end
2489 ! recdepend vars : degrade_ys,i_end,i_start,j_end,j_start,jds,jts
2490 ! recompute pos : IF_STMT module_advect_em.f90:263
2491 ! recompute vars : j_start
2492 if (degrade_ys) then
2493 j_start = max(jts,jds+1)
2494 endif
2495 ! recompute vars : j_start
2496 ! recdepend vars : degrade_ye,i_end,i_start,j_end,j_start,jde,jte
2497 ! recompute pos : IF_STMT module_advect_em.f90:268
2498 ! recompute vars : j_end
2499 if (degrade_ye) then
2500 j_end = min(jte,jde-2)
2501 endif
2502 ! recompute vars : j_end
2503 a_j_loop_y_flux_6: do j = j_end+1, j_start, -1
2504 ! recompute pos : ASSIGN_STMT module_advect_em.f90:275
2505 ! recompute vars : jp1
2506 jp1 = 2
2507 ! recompute vars : jp1
2508 ! recdepend vars : jp1
2509 ! recompute pos : ASSIGN_STMT module_advect_em.f90:276
2510 ! recompute vars : jp0
2511 jp0 = 1
2512 ! recompute vars : jp0
2513 j_loop_y_flux_9c: do j4 = j_start, j-1
2514 jtmp = jp1
2515 jp1 = jp0
2516 jp0 = jtmp
2517 end do j_loop_y_flux_9c
2518 if (j .gt. j_start) then
2519 do k = kts, ktf
2520 do i = i_start, i_end
2521 mrdy = msfu(i,j-1)*rdy
2522 ! recompute : mrdy
2523 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
2524 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
2525 end do
2526 end do
2527 endif
2528 if (j .ge. j_start_f .and. j .le. j_end_f) then
2529 do k = kts, ktf
2530 a_vel = 0.
2531 do i = i_start, i_end
2532 a_vel = 0.
2533 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
2534 ! recompute : vel
2535 a_u(i,k,j-3) = a_u(i,k,j-3)+0.016666667*a_fqy(i,k,jp1)*vel
2536 a_u(i,k,j-2) = a_u(i,k,j-2)-0.13333333*a_fqy(i,k,jp1)*vel
2537 a_u(i,k,j-1) = a_u(i,k,j-1)+0.61666667*a_fqy(i,k,jp1)*vel
2538 a_u(i,k,j+2) = a_u(i,k,j+2)+0.016666667*a_fqy(i,k,jp1)*vel
2539 a_u(i,k,j+1) = a_u(i,k,j+1)-0.13333333*a_fqy(i,k,jp1)*vel
2540 a_u(i,k,j) = a_u(i,k,j)+0.61666667*a_fqy(i,k,jp1)*vel
2541 a_vel = a_vel+a_fqy(i,k,jp1)*(0.61666667*(u(i,k,j)+u(i,k,j-1))-0.13333333*(u(i,k,j+1)+u(i,k,j-2))+0.016666667*(u(i,k,j+2)&
2542 &+u(i,k,j-3)))
2543 a_fqy(i,k,jp1) = 0.
2544 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.5*a_vel
2545 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
2546 a_vel = 0.
2547 end do
2548 end do
2549 else if (j .eq. jds+1) then
2550 do k = kts, ktf
2551 do i = i_start, i_end
2552 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.25*a_fqy(i,k,jp1)*(u(i,k,j)+u(i,k,j-1))
2553 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_fqy(i,k,jp1)*(u(i,k,j)+u(i,k,j-1))
2554 a_u(i,k,j-1) = a_u(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i-1,k,j))
2555 a_u(i,k,j) = a_u(i,k,j)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i-1,k,j))
2556 a_fqy(i,k,jp1) = 0.
2557 end do
2558 end do
2559 else if (j .eq. jds+2) then
2560 do k = kts, ktf
2561 a_vel = 0.
2562 do i = i_start, i_end
2563 a_vel = 0.
2564 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
2565 ! recompute : vel
2566 a_u(i,k,j-2) = a_u(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
2567 a_u(i,k,j-1) = a_u(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
2568 a_u(i,k,j+1) = a_u(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
2569 a_u(i,k,j) = a_u(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
2570 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(u(i,k,j)+u(i,k,j-1))-0.083333333*(u(i,k,j+1)+u(i,k,j-2)))
2571 a_fqy(i,k,jp1) = 0.
2572 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.5*a_vel
2573 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
2574 a_vel = 0.
2575 end do
2576 end do
2577 else if (j .eq. jde-1) then
2578 do k = kts, ktf
2579 do i = i_start, i_end
2580 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.25*a_fqy(i,k,jp1)*(u(i,k,j)+u(i,k,j-1))
2581 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_fqy(i,k,jp1)*(u(i,k,j)+u(i,k,j-1))
2582 a_u(i,k,j-1) = a_u(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i-1,k,j))
2583 a_u(i,k,j) = a_u(i,k,j)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i-1,k,j))
2584 a_fqy(i,k,jp1) = 0.
2585 end do
2586 end do
2587 else if (j .eq. jde-2) then
2588 do k = kts, ktf
2589 a_vel = 0.
2590 do i = i_start, i_end
2591 a_vel = 0.
2592 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
2593 ! recompute : vel
2594 a_u(i,k,j-2) = a_u(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
2595 a_u(i,k,j-1) = a_u(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
2596 a_u(i,k,j+1) = a_u(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
2597 a_u(i,k,j) = a_u(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
2598 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(u(i,k,j)+u(i,k,j-1))-0.083333333*(u(i,k,j+1)+u(i,k,j-2)))
2599 a_fqy(i,k,jp1) = 0.
2600 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.5*a_vel
2601 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
2602 a_vel = 0.
2603 end do
2604 end do
2605 endif
2606 end do a_j_loop_y_flux_6
2607 else if (horz_order .eq. 5) then a_horizontal_order_test
2608 degrade_xs = .true.
2609 ! recompute : degrade_xs
2610 degrade_xe = .true.
2611 ! recompute : degrade_xe
2612 degrade_ys = .true.
2613 ! recompute : degrade_ys
2614 degrade_ye = .true.
2615 ! recompute : degrade_ye
2616 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
2617 degrade_xs = .false.
2618 endif
2619 ! recompute : degrade_xs
2620 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
2621 degrade_xe = .false.
2622 endif
2623 ! recompute : degrade_xe
2624 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
2625 degrade_ys = .false.
2626 endif
2627 ! recompute : degrade_ys
2628 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-3) then
2629 degrade_ye = .false.
2630 endif
2631 ! recompute : degrade_ye
2632 j_start = jts
2633 ! recompute : j_start
2634 j_end = min(jte,jde-1)
2635 ! recompute : j_end
2636 j_start_f = j_start
2637 ! recompute : j_start_f
2638 j_end_f = j_end+1
2639 ! recompute : j_end_f
2640 if (degrade_ys) then
2641 j_start_f = jds+3
2642 endif
2643 ! recompute : j_start_f
2644 if (degrade_ye) then
2645 j_end_f = jde-3
2646 endif
2647 ! recompute : j_end_f
2648 i_start = its
2649 ! recompute : i_start
2650 i_end = ite
2651 ! recompute : i_end
2652 j_start = jts
2653 ! recompute : j_start
2654 j_end = min(jte,jde-1)
2655 ! recompute : j_end
2656 i_start_f = i_start
2657 ! recompute : i_start_f
2658 i_end_f = i_end+1
2659 ! recompute : i_end_f
2660 if (degrade_xs) then
2661 i_start = max(ids+1,its)
2662 i_start_f = ids+3
2663 endif
2664 ! recompute : i_start,i_start_f
2665 if (degrade_xe) then
2666 i_end = min(ide-1,ite)
2667 i_end_f = ide-2
2668 endif
2669 ! recompute : i_end,i_end_f
2670 do j = j_end, j_start, -1
2671 do k = kts, ktf
2672 do i = i_start, i_end
2673 mrdx = msfu(i,j)*rdx
2674 ! recompute : mrdx
2675 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
2676 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
2677 end do
2678 end do
2679 if (degrade_xe) then
2680 do k = kts, ktf
2681 a_vel = 0.
2682 i = ide-1
2683 ! recompute : i
2684 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
2685 ! recompute : vel
2686 a_u(i-2,k,j) = a_u(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
2687 a_u(i-1,k,j) = a_u(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
2688 a_u(i+1,k,j) = a_u(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
2689 a_u(i,k,j) = a_u(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
2690 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(u(i,k,j)+u(i-1,k,j))-0.083333333*(u(i+1,k,j)+u(i-2,k,j))+0.083333333*(u(i+1,k,j)-u(i-&
2691 &2,k,j)-3.*(u(i,k,j)-u(i-1,k,j)))*sign(1.,vel))
2692 a_fqx(i,k) = 0.
2693 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.5*a_vel
2694 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
2695 a_vel = 0.
2696 end do
2697 if (i_end .eq. ide-1) then
2698 i = ide
2699 ! recompute : i
2700 do k = kts, ktf
2701 a_ub = 0.
2702 ub = u(i,k,j)
2703 ! recompute : ub
2704 if (specified .and. u(i-1,k,j) .gt. 0.) then
2705 ub = u(i-1,k,j)
2706 endif
2707 ! recompute : ub
2708 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.25*a_fqx(i,k)*(u(i-1,k,j)+ub)
2709 a_ru(i,k,j) = a_ru(i,k,j)+0.25*a_fqx(i,k)*(u(i-1,k,j)+ub)
2710 a_u(i-1,k,j) = a_u(i-1,k,j)+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
2711 a_ub = a_ub+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
2712 a_fqx(i,k) = 0.
2713 if (specified .and. u(i-1,k,j) .gt. 0.) then
2714 a_u(i-1,k,j) = a_u(i-1,k,j)+a_ub
2715 a_ub = 0.
2716 endif
2717 a_u(i,k,j) = a_u(i,k,j)+a_ub
2718 a_ub = 0.
2719 end do
2720 endif
2721 endif
2722 if (degrade_xs) then
2723 i = ids+2
2724 ! recompute : i
2725 do k = kts, ktf
2726 a_vel = 0.
2727 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
2728 ! recompute : vel
2729 a_u(i-2,k,j) = a_u(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
2730 a_u(i-1,k,j) = a_u(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
2731 a_u(i+1,k,j) = a_u(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
2732 a_u(i,k,j) = a_u(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
2733 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(u(i,k,j)+u(i-1,k,j))-0.083333333*(u(i+1,k,j)+u(i-2,k,j))+0.083333333*(u(i+1,k,j)-u(i-&
2734 &2,k,j)-3.*(u(i,k,j)-u(i-1,k,j)))*sign(1.,vel))
2735 a_fqx(i,k) = 0.
2736 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.5*a_vel
2737 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
2738 a_vel = 0.
2739 end do
2740 if (i_start .eq. ids+1) then
2741 i = ids+1
2742 ! recompute : i
2743 do k = kts, ktf
2744 a_ub = 0.
2745 ub = u(i-1,k,j)
2746 ! recompute : ub
2747 if (specified .and. u(i,k,j) .lt. 0.) then
2748 ub = u(i,k,j)
2749 endif
2750 ! recompute : ub
2751 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.25*a_fqx(i,k)*(u(i,k,j)+ub)
2752 a_ru(i,k,j) = a_ru(i,k,j)+0.25*a_fqx(i,k)*(u(i,k,j)+ub)
2753 a_u(i,k,j) = a_u(i,k,j)+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
2754 a_ub = a_ub+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
2755 a_fqx(i,k) = 0.
2756 if (specified .and. u(i,k,j) .lt. 0.) then
2757 a_u(i,k,j) = a_u(i,k,j)+a_ub
2758 a_ub = 0.
2759 endif
2760 a_u(i-1,k,j) = a_u(i-1,k,j)+a_ub
2761 a_ub = 0.
2762 end do
2763 endif
2764 endif
2765 do k = kts, ktf
2766 a_vel = 0.
2767 do i = i_start_f, i_end_f
2768 a_vel = 0.
2769 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
2770 ! recompute : vel
2771 a_u(i-3,k,j) = a_u(i-3,k,j)+a_fqx(i,k)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))
2772 a_u(i-2,k,j) = a_u(i-2,k,j)+a_fqx(i,k)*vel*((-0.13333333)-0.083333333*sign(1.,vel))
2773 a_u(i-1,k,j) = a_u(i-1,k,j)+a_fqx(i,k)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))
2774 a_u(i+2,k,j) = a_u(i+2,k,j)+a_fqx(i,k)*vel*(0.016666667-0.016666667*sign(1.,vel))
2775 a_u(i+1,k,j) = a_u(i+1,k,j)+a_fqx(i,k)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))
2776 a_u(i,k,j) = a_u(i,k,j)+a_fqx(i,k)*vel*(0.61666667-0.16666667*sign(1.,vel))
2777 a_vel = a_vel+a_fqx(i,k)*(0.61666667*(u(i,k,j)+u(i-1,k,j))-0.13333333*(u(i+1,k,j)+u(i-2,k,j))+0.016666667*(u(i+2,k,j)+u(i-&
2778 &3,k,j))-0.016666667*(u(i+2,k,j)-u(i-3,k,j)-5.*(u(i+1,k,j)-u(i-2,k,j))+10.*(u(i,k,j)-u(i-1,k,j)))*sign(1.,vel))
2779 a_fqx(i,k) = 0.
2780 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.5*a_vel
2781 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
2782 a_vel = 0.
2783 end do
2784 end do
2785 end do
2786 ! recdepend vars : its
2787 ! recompute pos : ASSIGN_STMT module_advect_em.f90:488
2788 ! recompute vars : i_start
2789 i_start = its
2790 ! recompute vars : i_start
2791 ! recdepend vars : i_start,ite
2792 ! recompute pos : ASSIGN_STMT module_advect_em.f90:489
2793 ! recompute vars : i_end
2794 i_end = ite
2795 ! recompute vars : i_end
2796 ! recdepend vars : config_flags,i_end,i_start,ids,its,specified
2797 ! recompute pos : IF_STMT module_advect_em.f90:490
2798 ! recompute vars : i_start
2799 if (config_flags%open_xs .or. specified) then
2800 i_start = max(ids+1,its)
2801 endif
2802 ! recompute vars : i_start
2803 ! recdepend vars : config_flags,i_end,i_start,ide,ite,specified
2804 ! recompute pos : IF_STMT module_advect_em.f90:491
2805 ! recompute vars : i_end
2806 if (config_flags%open_xe .or. specified) then
2807 i_end = min(ide-1,ite)
2808 endif
2809 ! recompute vars : i_end
2810 ! recdepend vars : i_end,i_start,jts
2811 ! recompute pos : ASSIGN_STMT module_advect_em.f90:493
2812 ! recompute vars : j_start
2813 j_start = jts
2814 ! recompute vars : j_start
2815 ! recdepend vars : i_end,i_start,j_start,jde,jte
2816 ! recompute pos : ASSIGN_STMT module_advect_em.f90:494
2817 ! recompute vars : j_end
2818 j_end = min(jte,jde-1)
2819 ! recompute vars : j_end
2820 ! recdepend vars : degrade_ys,i_end,i_start,j_end,j_start,jds,jts
2821 ! recompute pos : IF_STMT module_advect_em.f90:502
2822 ! recompute vars : j_start
2823 if (degrade_ys) then
2824 j_start = max(jts,jds+1)
2825 endif
2826 ! recompute vars : j_start
2827 ! recdepend vars : degrade_ye,i_end,i_start,j_end,j_start,jde,jte
2828 ! recompute pos : IF_STMT module_advect_em.f90:507
2829 ! recompute vars : j_end
2830 if (degrade_ye) then
2831 j_end = min(jte,jde-2)
2832 endif
2833 ! recompute vars : j_end
2834 a_j_loop_y_flux_5: do j = j_end+1, j_start, -1
2835 ! recompute pos : ASSIGN_STMT module_advect_em.f90:514
2836 ! recompute vars : jp1
2837 jp1 = 2
2838 ! recompute vars : jp1
2839 ! recdepend vars : jp1
2840 ! recompute pos : ASSIGN_STMT module_advect_em.f90:515
2841 ! recompute vars : jp0
2842 jp0 = 1
2843 ! recompute vars : jp0
2844 j_loop_y_flux_9a: do j1 = j_start, j-1
2845 jtmp = jp1
2846 jp1 = jp0
2847 jp0 = jtmp
2848 end do j_loop_y_flux_9a
2849 if (j .gt. j_start) then
2850 do k = kts, ktf
2851 do i = i_start, i_end
2852 mrdy = msfu(i,j-1)*rdy
2853 ! recompute : mrdy
2854 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
2855 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
2856 end do
2857 end do
2858 endif
2859 if (j .ge. j_start_f .and. j .le. j_end_f) then
2860 do k = kts, ktf
2861 a_vel = 0.
2862 do i = i_start, i_end
2863 a_vel = 0.
2864 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
2865 ! recompute : vel
2866 a_u(i,k,j-3) = a_u(i,k,j-3)+a_fqy(i,k,jp1)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))
2867 a_u(i,k,j-2) = a_u(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.13333333)-0.083333333*sign(1.,vel))
2868 a_u(i,k,j-1) = a_u(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))
2869 a_u(i,k,j+2) = a_u(i,k,j+2)+a_fqy(i,k,jp1)*vel*(0.016666667-0.016666667*sign(1.,vel))
2870 a_u(i,k,j+1) = a_u(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))
2871 a_u(i,k,j) = a_u(i,k,j)+a_fqy(i,k,jp1)*vel*(0.61666667-0.16666667*sign(1.,vel))
2872 a_vel = a_vel+a_fqy(i,k,jp1)*(0.61666667*(u(i,k,j)+u(i,k,j-1))-0.13333333*(u(i,k,j+1)+u(i,k,j-2))+0.016666667*(u(i,k,j+2)&
2873 &+u(i,k,j-3))-0.016666667*(u(i,k,j+2)-u(i,k,j-3)-5.*(u(i,k,j+1)-u(i,k,j-2))+10.*(u(i,k,j)-u(i,k,j-1)))*sign(1.,vel))
2874 a_fqy(i,k,jp1) = 0.
2875 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.5*a_vel
2876 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
2877 a_vel = 0.
2878 end do
2879 end do
2880 else if (j .eq. jds+1) then
2881 do k = kts, ktf
2882 do i = i_start, i_end
2883 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.25*a_fqy(i,k,jp1)*(u(i,k,j)+u(i,k,j-1))
2884 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_fqy(i,k,jp1)*(u(i,k,j)+u(i,k,j-1))
2885 a_u(i,k,j-1) = a_u(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i-1,k,j))
2886 a_u(i,k,j) = a_u(i,k,j)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i-1,k,j))
2887 a_fqy(i,k,jp1) = 0.
2888 end do
2889 end do
2890 else if (j .eq. jds+2) then
2891 do k = kts, ktf
2892 a_vel = 0.
2893 do i = i_start, i_end
2894 a_vel = 0.
2895 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
2896 ! recompute : vel
2897 a_u(i,k,j-2) = a_u(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
2898 a_u(i,k,j-1) = a_u(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
2899 a_u(i,k,j+1) = a_u(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
2900 a_u(i,k,j) = a_u(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
2901 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(u(i,k,j)+u(i,k,j-1))-0.083333333*(u(i,k,j+1)+u(i,k,j-2))+0.083333333*(u(i,k,j+&
2902 &1)-u(i,k,j-2)-3.*(u(i,k,j)-u(i,k,j-1)))*sign(1.,vel))
2903 a_fqy(i,k,jp1) = 0.
2904 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.5*a_vel
2905 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
2906 a_vel = 0.
2907 end do
2908 end do
2909 else if (j .eq. jde-1) then
2910 do k = kts, ktf
2911 do i = i_start, i_end
2912 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.25*a_fqy(i,k,jp1)*(u(i,k,j)+u(i,k,j-1))
2913 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_fqy(i,k,jp1)*(u(i,k,j)+u(i,k,j-1))
2914 a_u(i,k,j-1) = a_u(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i-1,k,j))
2915 a_u(i,k,j) = a_u(i,k,j)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i-1,k,j))
2916 a_fqy(i,k,jp1) = 0.
2917 end do
2918 end do
2919 else if (j .eq. jde-2) then
2920 do k = kts, ktf
2921 a_vel = 0.
2922 do i = i_start, i_end
2923 a_vel = 0.
2924 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
2925 ! recompute : vel
2926 a_u(i,k,j-2) = a_u(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
2927 a_u(i,k,j-1) = a_u(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
2928 a_u(i,k,j+1) = a_u(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
2929 a_u(i,k,j) = a_u(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
2930 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(u(i,k,j)+u(i,k,j-1))-0.083333333*(u(i,k,j+1)+u(i,k,j-2))+0.083333333*(u(i,k,j+&
2931 &1)-u(i,k,j-2)-3.*(u(i,k,j)-u(i,k,j-1)))*sign(1.,vel))
2932 a_fqy(i,k,jp1) = 0.
2933 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.5*a_vel
2934 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
2935 a_vel = 0.
2936 end do
2937 end do
2938 endif
2939 end do a_j_loop_y_flux_5
2940 else if (horz_order .eq. 4) then a_horizontal_order_test
2941 degrade_xs = .true.
2942 ! recompute : degrade_xs
2943 degrade_xe = .true.
2944 ! recompute : degrade_xe
2945 degrade_ys = .true.
2946 ! recompute : degrade_ys
2947 degrade_ye = .true.
2948 ! recompute : degrade_ye
2949 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
2950 degrade_xs = .false.
2951 endif
2952 ! recompute : degrade_xs
2953 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-1) then
2954 degrade_xe = .false.
2955 endif
2956 ! recompute : degrade_xe
2957 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
2958 degrade_ys = .false.
2959 endif
2960 ! recompute : degrade_ys
2961 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
2962 degrade_ye = .false.
2963 endif
2964 ! recompute : degrade_ye
2965 i_start = its
2966 ! recompute : i_start
2967 i_end = ite
2968 ! recompute : i_end
2969 i_start_f = i_start
2970 ! recompute : i_start_f
2971 i_end_f = i_end+1
2972 ! recompute : i_end_f
2973 if (degrade_xs) then
2974 i_start = ids+1
2975 i_start_f = i_start+1
2976 endif
2977 ! recompute : i_start_f
2978 if (degrade_xe) then
2979 i_end_f = ide-1
2980 endif
2981 ! recompute : i_end_f
2982 i_start = its
2983 ! recompute : i_start
2984 i_end = ite
2985 ! recompute : i_end
2986 if (config_flags%open_xs .or. specified) then
2987 i_start = max(ids+1,its)
2988 endif
2989 ! recompute : i_start
2990 if (config_flags%open_xe .or. specified) then
2991 i_end = min(ide-1,ite)
2992 endif
2993 ! recompute : i_end
2994 j_start = jts
2995 ! recompute : j_start
2996 j_end = min(jte,jde-1)
2997 ! recompute : j_end
2998 j_start_f = j_start
2999 ! recompute : j_start_f
3000 j_end_f = j_end+1
3001 ! recompute : j_end_f
3002 if (degrade_ys) then
3003 j_start = jds+1
3004 j_start_f = j_start+1
3005 endif
3006 ! recompute : j_start,j_start_f
3007 if (degrade_ye) then
3008 j_end = jde-2
3009 j_end_f = jde-2
3010 endif
3011 ! recompute : j_end,j_end_f
3012 do j = j_end+1, j_start, -1
3013 ! recompute pos : ASSIGN_STMT module_advect_em.f90:816
3014 ! recompute vars : jp1
3015 jp1 = 2
3016 ! recompute vars : jp1
3017 ! recdepend vars : jp1
3018 ! recompute pos : ASSIGN_STMT module_advect_em.f90:817
3019 ! recompute vars : jp0
3020 jp0 = 1
3021 ! recompute vars : jp0
3022 do j2 = j_start, j-1
3023 jtmp = jp1
3024 jp1 = jp0
3025 jp0 = jtmp
3026 end do
3027 if (j .gt. j_start) then
3028 do k = kts, ktf
3029 do i = i_start, i_end
3030 mrdy = msfu(i,j-1)*rdy
3031 ! recompute : mrdy
3032 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
3033 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
3034 end do
3035 end do
3036 endif
3037 if (j .lt. j_start_f .and. degrade_ys) then
3038 do k = kts, ktf
3039 do i = i_start, i_end
3040 a_rv(i-1,k,j_start) = a_rv(i-1,k,j_start)+0.25*a_fqy(i,k,jp1)*(u(i,k,j_start)+u(i,k,j_start-1))
3041 a_rv(i,k,j_start) = a_rv(i,k,j_start)+0.25*a_fqy(i,k,jp1)*(u(i,k,j_start)+u(i,k,j_start-1))
3042 a_u(i,k,j_start-1) = a_u(i,k,j_start-1)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j_start)+rv(i-1,k,j_start))
3043 a_u(i,k,j_start) = a_u(i,k,j_start)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j_start)+rv(i-1,k,j_start))
3044 a_fqy(i,k,jp1) = 0.
3045 end do
3046 end do
3047 else if (j .gt. j_end_f .and. degrade_ye) then
3048 do k = kts, ktf
3049 do i = i_start, i_end
3050 a_rv(i-1,k,j_end+1) = a_rv(i-1,k,j_end+1)+0.25*a_fqy(i,k,jp1)*(u(i,k,j_end+1)+u(i,k,j_end))
3051 a_rv(i,k,j_end+1) = a_rv(i,k,j_end+1)+0.25*a_fqy(i,k,jp1)*(u(i,k,j_end+1)+u(i,k,j_end))
3052 a_u(i,k,j_end+1) = a_u(i,k,j_end+1)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))
3053 a_u(i,k,j_end) = a_u(i,k,j_end)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))
3054 a_fqy(i,k,jp1) = 0.
3055 end do
3056 end do
3057 else
3058 do k = kts, ktf
3059 a_vel = 0.
3060 do i = i_start, i_end
3061 a_vel = 0.
3062 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
3063 ! recompute : vel
3064 a_u(i,k,j-2) = a_u(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
3065 a_u(i,k,j-1) = a_u(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
3066 a_u(i,k,j+1) = a_u(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
3067 a_u(i,k,j) = a_u(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
3068 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(u(i,k,j)+u(i,k,j-1))-0.083333333*(u(i,k,j+1)+u(i,k,j-2)))
3069 a_fqy(i,k,jp1) = 0.
3070 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.5*a_vel
3071 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
3072 a_vel = 0.
3073 end do
3074 end do
3075 endif
3076 end do
3077 ! recdepend vars : its
3078 ! recompute pos : ASSIGN_STMT module_advect_em.f90:720
3079 ! recompute vars : i_start
3080 i_start = its
3081 ! recompute vars : i_start
3082 ! recdepend vars : i_start,ite
3083 ! recompute pos : ASSIGN_STMT module_advect_em.f90:721
3084 ! recompute vars : i_end
3085 i_end = ite
3086 ! recompute vars : i_end
3087 ! recdepend vars : i_end,i_start,jts
3088 ! recompute pos : ASSIGN_STMT module_advect_em.f90:722
3089 ! recompute vars : j_start
3090 j_start = jts
3091 ! recompute vars : j_start
3092 ! recdepend vars : i_end,i_start,j_start,jde,jte
3093 ! recompute pos : ASSIGN_STMT module_advect_em.f90:723
3094 ! recompute vars : j_end
3095 j_end = min(jte,jde-1)
3096 ! recompute vars : j_end
3097 ! recdepend vars : degrade_xs,i_end,i_start,ids,j_end,j_start
3098 ! recompute pos : IF_STMT module_advect_em.f90:731
3099 ! recompute vars : i_start
3100 if (degrade_xs) then
3101 i_start = ids+1
3102 endif
3103 ! recompute vars : i_start
3104 ! recdepend vars : degrade_xe,i_end,i_start,ide,j_end,j_start
3105 ! recompute pos : IF_STMT module_advect_em.f90:736
3106 ! recompute vars : i_end
3107 if (degrade_xe) then
3108 i_end = ide-1
3109 endif
3110 ! recompute vars : i_end
3111 do j = j_end, j_start, -1
3112 do k = kts, ktf
3113 do i = i_start, i_end
3114 mrdx = msfu(i,j)*rdx
3115 ! recompute : mrdx
3116 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
3117 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
3118 end do
3119 end do
3120 if (degrade_xe) then
3121 i = i_end+1
3122 ! recompute : i
3123 do k = kts, ktf
3124 a_ub = 0.
3125 ub = u(i,k,j)
3126 ! recompute : ub
3127 if (specified .and. u(i-1,k,j) .gt. 0.) then
3128 ub = u(i-1,k,j)
3129 endif
3130 ! recompute : ub
3131 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.25*a_fqx(i,k)*(u(i-1,k,j)+ub)
3132 a_ru(i,k,j) = a_ru(i,k,j)+0.25*a_fqx(i,k)*(u(i-1,k,j)+ub)
3133 a_u(i-1,k,j) = a_u(i-1,k,j)+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
3134 a_ub = a_ub+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
3135 a_fqx(i,k) = 0.
3136 if (specified .and. u(i-1,k,j) .gt. 0.) then
3137 a_u(i-1,k,j) = a_u(i-1,k,j)+a_ub
3138 a_ub = 0.
3139 endif
3140 a_u(i,k,j) = a_u(i,k,j)+a_ub
3141 a_ub = 0.
3142 end do
3143 endif
3144 if (degrade_xs) then
3145 i = i_start
3146 ! recompute : i
3147 do k = kts, ktf
3148 a_ub = 0.
3149 ub = u(i-1,k,j)
3150 ! recompute : ub
3151 if (specified .and. u(i,k,j) .lt. 0.) then
3152 ub = u(i,k,j)
3153 endif
3154 ! recompute : ub
3155 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.25*a_fqx(i,k)*(u(i,k,j)+ub)
3156 a_ru(i,k,j) = a_ru(i,k,j)+0.25*a_fqx(i,k)*(u(i,k,j)+ub)
3157 a_u(i,k,j) = a_u(i,k,j)+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
3158 a_ub = a_ub+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
3159 a_fqx(i,k) = 0.
3160 if (specified .and. u(i,k,j) .lt. 0.) then
3161 a_u(i,k,j) = a_u(i,k,j)+a_ub
3162 a_ub = 0.
3163 endif
3164 a_u(i-1,k,j) = a_u(i-1,k,j)+a_ub
3165 a_ub = 0.
3166 end do
3167 endif
3168 do k = kts, ktf
3169 a_vel = 0.
3170 do i = i_start_f, i_end_f
3171 a_vel = 0.
3172 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
3173 ! recompute : vel
3174 a_u(i-2,k,j) = a_u(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
3175 a_u(i-1,k,j) = a_u(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
3176 a_u(i+1,k,j) = a_u(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
3177 a_u(i,k,j) = a_u(i,k,j)+0.58333333*a_fqx(i,k)*vel
3178 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(u(i,k,j)+u(i-1,k,j))-0.083333333*(u(i+1,k,j)+u(i-2,k,j)))
3179 a_fqx(i,k) = 0.
3180 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.5*a_vel
3181 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
3182 a_vel = 0.
3183 end do
3184 end do
3185 end do
3186 else if (horz_order .eq. 3) then a_horizontal_order_test
3187 degrade_xs = .true.
3188 ! recompute : degrade_xs
3189 degrade_xe = .true.
3190 ! recompute : degrade_xe
3191 degrade_ys = .true.
3192 ! recompute : degrade_ys
3193 degrade_ye = .true.
3194 ! recompute : degrade_ye
3195 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
3196 degrade_xs = .false.
3197 endif
3198 ! recompute : degrade_xs
3199 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-1) then
3200 degrade_xe = .false.
3201 endif
3202 ! recompute : degrade_xe
3203 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
3204 degrade_ys = .false.
3205 endif
3206 ! recompute : degrade_ys
3207 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
3208 degrade_ye = .false.
3209 endif
3210 ! recompute : degrade_ye
3211 i_start = its
3212 ! recompute : i_start
3213 i_end = ite
3214 ! recompute : i_end
3215 i_start_f = i_start
3216 ! recompute : i_start_f
3217 i_end_f = i_end+1
3218 ! recompute : i_end_f
3219 if (degrade_xs) then
3220 i_start = ids+1
3221 i_start_f = i_start+1
3222 endif
3223 ! recompute : i_start_f
3224 if (degrade_xe) then
3225 i_end_f = ide-1
3226 endif
3227 ! recompute : i_end_f
3228 i_start = its
3229 ! recompute : i_start
3230 i_end = ite
3231 ! recompute : i_end
3232 if (config_flags%open_xs .or. specified) then
3233 i_start = max(ids+1,its)
3234 endif
3235 ! recompute : i_start
3236 if (config_flags%open_xe .or. specified) then
3237 i_end = min(ide-1,ite)
3238 endif
3239 ! recompute : i_end
3240 j_start = jts
3241 ! recompute : j_start
3242 j_end = min(jte,jde-1)
3243 ! recompute : j_end
3244 j_start_f = j_start
3245 ! recompute : j_start_f
3246 j_end_f = j_end+1
3247 ! recompute : j_end_f
3248 if (degrade_ys) then
3249 j_start = jds+1
3250 j_start_f = j_start+1
3251 endif
3252 ! recompute : j_start,j_start_f
3253 if (degrade_ye) then
3254 j_end = jde-2
3255 j_end_f = jde-2
3256 endif
3257 ! recompute : j_end,j_end_f
3258 do j = j_end+1, j_start, -1
3259 ! recompute pos : ASSIGN_STMT module_advect_em.f90:994
3260 ! recompute vars : jp1
3261 jp1 = 2
3262 ! recompute vars : jp1
3263 ! recdepend vars : jp1
3264 ! recompute pos : ASSIGN_STMT module_advect_em.f90:995
3265 ! recompute vars : jp0
3266 jp0 = 1
3267 ! recompute vars : jp0
3268 do j3 = j_start, j-1
3269 jtmp = jp1
3270 jp1 = jp0
3271 jp0 = jtmp
3272 end do
3273 if (j .gt. j_start) then
3274 do k = kts, ktf
3275 do i = i_start, i_end
3276 mrdy = msfu(i,j-1)*rdy
3277 ! recompute : mrdy
3278 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
3279 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
3280 end do
3281 end do
3282 endif
3283 if (j .lt. j_start_f .and. degrade_ys) then
3284 do k = kts, ktf
3285 do i = i_start, i_end
3286 a_rv(i-1,k,j_start) = a_rv(i-1,k,j_start)+0.25*a_fqy(i,k,jp1)*(u(i,k,j_start)+u(i,k,j_start-1))
3287 a_rv(i,k,j_start) = a_rv(i,k,j_start)+0.25*a_fqy(i,k,jp1)*(u(i,k,j_start)+u(i,k,j_start-1))
3288 a_u(i,k,j_start-1) = a_u(i,k,j_start-1)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j_start)+rv(i-1,k,j_start))
3289 a_u(i,k,j_start) = a_u(i,k,j_start)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j_start)+rv(i-1,k,j_start))
3290 a_fqy(i,k,jp1) = 0.
3291 end do
3292 end do
3293 else if (j .gt. j_end_f .and. degrade_ye) then
3294 do k = kts, ktf
3295 do i = i_start, i_end
3296 a_rv(i-1,k,j_end+1) = a_rv(i-1,k,j_end+1)+0.25*a_fqy(i,k,jp1)*(u(i,k,j_end+1)+u(i,k,j_end))
3297 a_rv(i,k,j_end+1) = a_rv(i,k,j_end+1)+0.25*a_fqy(i,k,jp1)*(u(i,k,j_end+1)+u(i,k,j_end))
3298 a_u(i,k,j_end+1) = a_u(i,k,j_end+1)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))
3299 a_u(i,k,j_end) = a_u(i,k,j_end)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))
3300 a_fqy(i,k,jp1) = 0.
3301 end do
3302 end do
3303 else
3304 do k = kts, ktf
3305 a_vel = 0.
3306 do i = i_start, i_end
3307 a_vel = 0.
3308 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
3309 ! recompute : vel
3310 a_u(i,k,j-2) = a_u(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
3311 a_u(i,k,j-1) = a_u(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
3312 a_u(i,k,j+1) = a_u(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
3313 a_u(i,k,j) = a_u(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
3314 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(u(i,k,j)+u(i,k,j-1))-0.083333333*(u(i,k,j+1)+u(i,k,j-2))+0.083333333*(u(i,k,j+&
3315 &1)-u(i,k,j-2)-3.*(u(i,k,j)-u(i,k,j-1)))*sign(1.,vel))
3316 a_fqy(i,k,jp1) = 0.
3317 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.5*a_vel
3318 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
3319 a_vel = 0.
3320 end do
3321 end do
3322 endif
3323 end do
3324 ! recdepend vars : its
3325 ! recompute pos : ASSIGN_STMT module_advect_em.f90:899
3326 ! recompute vars : i_start
3327 i_start = its
3328 ! recompute vars : i_start
3329 ! recdepend vars : i_start,ite
3330 ! recompute pos : ASSIGN_STMT module_advect_em.f90:900
3331 ! recompute vars : i_end
3332 i_end = ite
3333 ! recompute vars : i_end
3334 ! recdepend vars : i_end,i_start,jts
3335 ! recompute pos : ASSIGN_STMT module_advect_em.f90:901
3336 ! recompute vars : j_start
3337 j_start = jts
3338 ! recompute vars : j_start
3339 ! recdepend vars : i_end,i_start,j_start,jde,jte
3340 ! recompute pos : ASSIGN_STMT module_advect_em.f90:902
3341 ! recompute vars : j_end
3342 j_end = min(jte,jde-1)
3343 ! recompute vars : j_end
3344 ! recdepend vars : degrade_xs,i_end,i_start,ids,j_end,j_start
3345 ! recompute pos : IF_STMT module_advect_em.f90:910
3346 ! recompute vars : i_start
3347 if (degrade_xs) then
3348 i_start = ids+1
3349 endif
3350 ! recompute vars : i_start
3351 ! recdepend vars : degrade_xe,i_end,i_start,ide,j_end,j_start
3352 ! recompute pos : IF_STMT module_advect_em.f90:915
3353 ! recompute vars : i_end
3354 if (degrade_xe) then
3355 i_end = ide-1
3356 endif
3357 ! recompute vars : i_end
3358 do j = j_end, j_start, -1
3359 do k = kts, ktf
3360 do i = i_start, i_end
3361 mrdx = msfu(i,j)*rdx
3362 ! recompute : mrdx
3363 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
3364 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
3365 end do
3366 end do
3367 if (degrade_xe) then
3368 i = i_end+1
3369 ! recompute : i
3370 do k = kts, ktf
3371 a_ub = 0.
3372 ub = u(i,k,j)
3373 ! recompute : ub
3374 if (specified .and. u(i-1,k,j) .gt. 0.) then
3375 ub = u(i-1,k,j)
3376 endif
3377 ! recompute : ub
3378 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.25*a_fqx(i,k)*(u(i-1,k,j)+ub)
3379 a_ru(i,k,j) = a_ru(i,k,j)+0.25*a_fqx(i,k)*(u(i-1,k,j)+ub)
3380 a_u(i-1,k,j) = a_u(i-1,k,j)+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
3381 a_ub = a_ub+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
3382 a_fqx(i,k) = 0.
3383 if (specified .and. u(i-1,k,j) .gt. 0.) then
3384 a_u(i-1,k,j) = a_u(i-1,k,j)+a_ub
3385 a_ub = 0.
3386 endif
3387 a_u(i,k,j) = a_u(i,k,j)+a_ub
3388 a_ub = 0.
3389 end do
3390 endif
3391 if (degrade_xs) then
3392 i = i_start
3393 ! recompute : i
3394 do k = kts, ktf
3395 a_ub = 0.
3396 ub = u(i-1,k,j)
3397 ! recompute : ub
3398 if (specified .and. u(i,k,j) .lt. 0.) then
3399 ub = u(i,k,j)
3400 endif
3401 ! recompute : ub
3402 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.25*a_fqx(i,k)*(u(i,k,j)+ub)
3403 a_ru(i,k,j) = a_ru(i,k,j)+0.25*a_fqx(i,k)*(u(i,k,j)+ub)
3404 a_u(i,k,j) = a_u(i,k,j)+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
3405 a_ub = a_ub+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i-1,k,j))
3406 a_fqx(i,k) = 0.
3407 if (specified .and. u(i,k,j) .lt. 0.) then
3408 a_u(i,k,j) = a_u(i,k,j)+a_ub
3409 a_ub = 0.
3410 endif
3411 a_u(i-1,k,j) = a_u(i-1,k,j)+a_ub
3412 a_ub = 0.
3413 end do
3414 endif
3415 do k = kts, ktf
3416 a_vel = 0.
3417 do i = i_start_f, i_end_f
3418 a_vel = 0.
3419 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
3420 ! recompute : vel
3421 a_u(i-2,k,j) = a_u(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
3422 a_u(i-1,k,j) = a_u(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
3423 a_u(i+1,k,j) = a_u(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
3424 a_u(i,k,j) = a_u(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
3425 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(u(i,k,j)+u(i-1,k,j))-0.083333333*(u(i+1,k,j)+u(i-2,k,j))+0.083333333*(u(i+1,k,j)-u(i-&
3426 &2,k,j)-3.*(u(i,k,j)-u(i-1,k,j)))*sign(1.,vel))
3427 a_fqx(i,k) = 0.
3428 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.5*a_vel
3429 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
3430 a_vel = 0.
3431 end do
3432 end do
3433 end do
3434 else if (horz_order .eq. 2) then a_horizontal_order_test
3435 i_start = its
3436 ! recompute : i_start
3437 i_end = ite
3438 ! recompute : i_end
3439 j_start = jts
3440 ! recompute : j_start
3441 j_end = min(jte,jde-1)
3442 ! recompute : j_end
3443 if (config_flags%open_xs) then
3444 i_start = max(ids+1,its)
3445 endif
3446 ! recompute : i_start
3447 if (config_flags%open_xe) then
3448 i_end = min(ide-1,ite)
3449 endif
3450 ! recompute : i_end
3451 if (specified) then
3452 i_start = max(ids+2,its)
3453 endif
3454 ! recompute : i_start
3455 if (specified) then
3456 i_end = min(ide-2,ite)
3457 endif
3458 ! recompute : i_end
3459 if (config_flags%open_ys .or. specified) then
3460 j_start = max(jds+1,jts)
3461 endif
3462 ! recompute : j_start
3463 if (config_flags%open_ye .or. specified) then
3464 j_end = min(jde-2,jte)
3465 endif
3466 ! recompute : j_end
3467 do j = j_start, j_end
3468 do k = kts, ktf
3469 do i = i_start, i_end
3470 mrdy = msfu(i,j)*rdy
3471 ! recompute : mrdy
3472 a_rv(i-1,k,j+1) = a_rv(i-1,k,j+1)-0.25*a_tendency(i,k,j)*mrdy*(u(i,k,j+1)+u(i,k,j))
3473 a_rv(i,k,j+1) = a_rv(i,k,j+1)-0.25*a_tendency(i,k,j)*mrdy*(u(i,k,j+1)+u(i,k,j))
3474 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.25*a_tendency(i,k,j)*mrdy*(u(i,k,j)+u(i,k,j-1))
3475 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_tendency(i,k,j)*mrdy*(u(i,k,j)+u(i,k,j-1))
3476 a_u(i,k,j-1) = a_u(i,k,j-1)+0.25*a_tendency(i,k,j)*mrdy*(rv(i,k,j)+rv(i-1,k,j))
3477 a_u(i,k,j+1) = a_u(i,k,j+1)-0.25*a_tendency(i,k,j)*mrdy*(rv(i,k,j+1)+rv(i-1,k,j+1))
3478 a_u(i,k,j) = a_u(i,k,j)-0.25*a_tendency(i,k,j)*mrdy*(rv(i,k,j+1)+rv(i-1,k,j+1)-(rv(i,k,j)+rv(i-1,k,j)))
3479 end do
3480 end do
3481 end do
3482 ! recdepend vars : jts
3483 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1049
3484 ! recompute vars : j_start
3485 j_start = jts
3486 ! recompute vars : j_start
3487 ! recdepend vars : j_start,jde,jte
3488 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1050
3489 ! recompute vars : j_end
3490 j_end = min(jte,jde-1)
3491 ! recompute vars : j_end
3492 if (specified .and. ite .ge. ide-1) then
3493 do j = j_start, j_end
3494 a_ub = 0.
3495 do k = kts, ktf
3496 a_ub = 0.
3497 i = ide-1
3498 ! recompute : i
3499 mrdx = msfu(i,j)*rdx
3500 ! recompute : mrdx
3501 ub = u(i+1,k,j)
3502 ! recompute : ub
3503 if (u(i,k,j) .gt. 0.) then
3504 ub = u(i,k,j)
3505 endif
3506 ! recompute : ub
3507 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.25*a_tendency(i,k,j)*mrdx*(u(i,k,j)+u(i-1,k,j))
3508 a_ru(i+1,k,j) = a_ru(i+1,k,j)-0.25*a_tendency(i,k,j)*mrdx*(ub+u(i,k,j))
3509 a_ru(i,k,j) = a_ru(i,k,j)-0.25*a_tendency(i,k,j)*mrdx*(ub+u(i,k,j)-(u(i,k,j)+u(i-1,k,j)))
3510 a_u(i-1,k,j) = a_u(i-1,k,j)+0.25*a_tendency(i,k,j)*mrdx*(ru(i,k,j)+ru(i-1,k,j))
3511 a_u(i,k,j) = a_u(i,k,j)-0.25*a_tendency(i,k,j)*mrdx*(ru(i+1,k,j)+ru(i,k,j)-(ru(i,k,j)+ru(i-1,k,j)))
3512 a_ub = a_ub-0.25*a_tendency(i,k,j)*mrdx*(ru(i+1,k,j)+ru(i,k,j))
3513 if (u(i,k,j) .gt. 0.) then
3514 a_u(i,k,j) = a_u(i,k,j)+a_ub
3515 a_ub = 0.
3516 endif
3517 a_u(i+1,k,j) = a_u(i+1,k,j)+a_ub
3518 a_ub = 0.
3519 end do
3520 end do
3521 endif
3522 ! recdepend vars : jts
3523 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1049
3524 ! recompute vars : j_start
3525 j_start = jts
3526 ! recompute vars : j_start
3527 ! recdepend vars : j_start,jde,jte
3528 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1050
3529 ! recompute vars : j_end
3530 j_end = min(jte,jde-1)
3531 ! recompute vars : j_end
3532 if (specified .and. its .le. ids+1) then
3533 do j = j_start, j_end
3534 a_ub = 0.
3535 do k = kts, ktf
3536 a_ub = 0.
3537 i = ids+1
3538 ! recompute : i
3539 mrdx = msfu(i,j)*rdx
3540 ! recompute : mrdx
3541 ub = u(i-1,k,j)
3542 ! recompute : ub
3543 if (u(i,k,j) .lt. 0.) then
3544 ub = u(i,k,j)
3545 endif
3546 ! recompute : ub
3547 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.25*a_tendency(i,k,j)*mrdx*(u(i,k,j)+ub)
3548 a_ru(i+1,k,j) = a_ru(i+1,k,j)-0.25*a_tendency(i,k,j)*mrdx*(u(i+1,k,j)+u(i,k,j))
3549 a_ru(i,k,j) = a_ru(i,k,j)-0.25*a_tendency(i,k,j)*mrdx*(u(i+1,k,j)+u(i,k,j)-(u(i,k,j)+ub))
3550 a_u(i+1,k,j) = a_u(i+1,k,j)-0.25*a_tendency(i,k,j)*mrdx*(ru(i+1,k,j)+ru(i,k,j))
3551 a_u(i,k,j) = a_u(i,k,j)-0.25*a_tendency(i,k,j)*mrdx*(ru(i+1,k,j)+ru(i,k,j)-(ru(i,k,j)+ru(i-1,k,j)))
3552 a_ub = a_ub+0.25*a_tendency(i,k,j)*mrdx*(ru(i,k,j)+ru(i-1,k,j))
3553 if (u(i,k,j) .lt. 0.) then
3554 a_u(i,k,j) = a_u(i,k,j)+a_ub
3555 a_ub = 0.
3556 endif
3557 a_u(i-1,k,j) = a_u(i-1,k,j)+a_ub
3558 a_ub = 0.
3559 end do
3560 end do
3561 endif
3562 ! recdepend vars : jts
3563 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1049
3564 ! recompute vars : j_start
3565 j_start = jts
3566 ! recompute vars : j_start
3567 ! recdepend vars : j_start,jde,jte
3568 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1050
3569 ! recompute vars : j_end
3570 j_end = min(jte,jde-1)
3571 ! recompute vars : j_end
3572 do j = j_start, j_end
3573 do k = kts, ktf
3574 do i = i_start, i_end
3575 mrdx = msfu(i,j)*rdx
3576 ! recompute : mrdx
3577 a_ru(i-1,k,j) = a_ru(i-1,k,j)+0.25*a_tendency(i,k,j)*mrdx*(u(i,k,j)+u(i-1,k,j))
3578 a_ru(i+1,k,j) = a_ru(i+1,k,j)-0.25*a_tendency(i,k,j)*mrdx*(u(i+1,k,j)+u(i,k,j))
3579 a_ru(i,k,j) = a_ru(i,k,j)-0.25*a_tendency(i,k,j)*mrdx*(u(i+1,k,j)+u(i,k,j)-(u(i,k,j)+u(i-1,k,j)))
3580 a_u(i-1,k,j) = a_u(i-1,k,j)+0.25*a_tendency(i,k,j)*mrdx*(ru(i,k,j)+ru(i-1,k,j))
3581 a_u(i+1,k,j) = a_u(i+1,k,j)-0.25*a_tendency(i,k,j)*mrdx*(ru(i+1,k,j)+ru(i,k,j))
3582 a_u(i,k,j) = a_u(i,k,j)-0.25*a_tendency(i,k,j)*mrdx*(ru(i+1,k,j)+ru(i,k,j)-(ru(i,k,j)+ru(i-1,k,j)))
3583 end do
3584 end do
3585 end do
3586 endif a_horizontal_order_test
3587
3588 end subroutine a_advect_u
3589
3590
3591 subroutine a_advect_v( v, a_v, v_old, a_v_old, a_tendency, ru, a_ru, rv, a_rv, rom, a_rom, mut, a_mut, config_flags, msfv, fzm, &
3592 &fzp, rdx, rdy, rdzw, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
3593 !******************************************************************
3594 !******************************************************************
3595 !** This routine was generated by Automatic differentiation. **
3596 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
3597 !******************************************************************
3598 !******************************************************************
3599 !==============================================
3600 ! all entries are defined explicitly
3601 !==============================================
3602 implicit none
3603
3604 !==============================================
3605 ! declare arguments
3606 !==============================================
3607 integer, intent(in) :: ime
3608 integer, intent(in) :: ims
3609 integer, intent(in) :: jme
3610 integer, intent(in) :: jms
3611 real, intent(inout) :: a_mut(ims:ime,jms:jme)
3612 integer, intent(in) :: kme
3613 integer, intent(in) :: kms
3614 real, intent(inout) :: a_rom(ims:ime,kms:kme,jms:jme)
3615 real, intent(inout) :: a_ru(ims:ime,kms:kme,jms:jme)
3616 real, intent(inout) :: a_rv(ims:ime,kms:kme,jms:jme)
3617 real, intent(inout) :: a_tendency(ims:ime,kms:kme,jms:jme)
3618 real, intent(inout) :: a_v(ims:ime,kms:kme,jms:jme)
3619 real, intent(inout) :: a_v_old(ims:ime,kms:kme,jms:jme)
3620 type (grid_config_rec_type), intent(in) :: config_flags
3621 real, intent(in) :: fzm(kms:kme)
3622 real, intent(in) :: fzp(kms:kme)
3623 integer, intent(in) :: ide
3624 integer, intent(in) :: ids
3625 integer, intent(in) :: ite
3626 integer, intent(in) :: its
3627 integer, intent(in) :: jde
3628 integer, intent(in) :: jds
3629 integer, intent(in) :: jte
3630 integer, intent(in) :: jts
3631 integer, intent(in) :: kde
3632 integer, intent(in) :: kte
3633 integer, intent(in) :: kts
3634 real, intent(in) :: msfv(ims:ime,jms:jme)
3635 real, intent(in) :: mut(ims:ime,jms:jme)
3636 real, intent(in) :: rdx
3637 real, intent(in) :: rdy
3638 real, intent(in) :: rdzw(kms:kme)
3639 real, intent(in) :: rom(ims:ime,kms:kme,jms:jme)
3640 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
3641 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
3642 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
3643 real, intent(in) :: v_old(ims:ime,kms:kme,jms:jme)
3644
3645 !==============================================
3646 ! declare local variables
3647 !==============================================
3648 real a_dum
3649 real a_dup
3650 real a_fqx(its:ite+1,kts:kte)
3651 real a_fqy(its:ite,kts:kte,2)
3652 real a_ub
3653 real a_uw
3654 real a_vb
3655 real a_vel
3656 real a_vflux(its:ite,kts:kte)
3657 logical degrade_xe
3658 logical degrade_xs
3659 logical degrade_ye
3660 logical degrade_ys
3661 real dum
3662 real dup
3663 integer horz_order
3664 integer i
3665 integer i_end
3666 integer i_end_f
3667 integer i_start
3668 integer i_start_f
3669 integer j
3670 integer j1
3671 integer j2
3672 integer j3
3673 integer j4
3674 integer j_end
3675 integer j_end_f
3676 integer j_start
3677 integer j_start_f
3678 integer jm
3679 integer jmax
3680 integer jmin
3681 integer jp
3682 integer jp0
3683 integer jp1
3684 integer jtmp
3685 integer k
3686 integer ktf
3687 real mrdx
3688 real mrdy
3689 logical specified
3690 real ub
3691 real uw
3692 real vb
3693 real vel
3694 integer vert_order
3695
3696 !----------------------------------------------
3697 ! RESET LOCAL ADJOINT VARIABLES
3698 !----------------------------------------------
3699 a_dum = 0.
3700 a_dup = 0.
3701 a_fqx(:,:) = 0.
3702 a_fqy(:,:,:) = 0.
3703 a_ub = 0.
3704 a_uw = 0.
3705 a_vb = 0.
3706 a_vel = 0.
3707 a_vflux(:,:) = 0.
3708
3709 !----------------------------------------------
3710 ! ROUTINE BODY
3711 !----------------------------------------------
3712 specified = .false.
3713 ! recompute : specified
3714 if (config_flags%specified .or. config_flags%nested) then
3715 specified = .true.
3716 endif
3717 ! recompute : specified
3718 ktf = min(kte,kde-1)
3719 ! recompute : ktf
3720 horz_order = config_flags%h_mom_adv_order
3721 ! recompute : horz_order
3722 vert_order = config_flags%v_mom_adv_order
3723 ! recompute : vert_order
3724 horizontal_order_tesu: if (horz_order .eq. 6) then
3725 ktf = min(kte,kde-1)
3726 else if (horz_order .eq. 4) then horizontal_order_tesu
3727 ktf = min(kte,kde-1)
3728 else if (horz_order .eq. 3) then horizontal_order_tesu
3729 ktf = min(kte,kde-1)
3730 endif horizontal_order_tesu
3731 ! recompute : ktf
3732 jmin = jds
3733 ! recompute : jmin
3734 jmax = jde-1
3735 ! recompute : jmax
3736 if (config_flags%open_ys) then
3737 jmin = jds
3738 endif
3739 ! recompute : jmin
3740 if (config_flags%open_ye) then
3741 jmax = jde-1
3742 endif
3743 ! recompute : jmax
3744 i_start = its
3745 ! recompute : i_start
3746 i_end = min(ite,ide-1)
3747 ! recompute : i_end
3748 j_start = jts
3749 ! recompute : j_start
3750 j_end = jte
3751 ! recompute : j_end
3752 if (config_flags%open_ys .or. specified) then
3753 j_start = max(jds+1,jts)
3754 endif
3755 ! recompute : j_start
3756 if (config_flags%open_ye .or. specified) then
3757 j_end = min(jde-1,jte)
3758 endif
3759 ! recompute : j_end
3760 a_vert_order_test: if (vert_order .eq. 6) then
3761 do j = j_end, j_start, -1
3762 do k = kts, ktf
3763 do i = i_start, i_end
3764 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
3765 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
3766 end do
3767 end do
3768 do i = i_start, i_end
3769 a_vel = 0.
3770 k = ktf-1
3771 ! recompute : k
3772 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3773 ! recompute : vel
3774 k = ktf
3775 ! recompute : k
3776 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3777 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3778 a_v(i,k-1,j) = a_v(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)
3779 a_v(i,k,j) = a_v(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3780 a_vflux(i,k) = 0.
3781 ! recdepend vars : ktf
3782 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2544
3783 ! recompute vars : k
3784 k = ktf-1
3785 ! recompute vars : k
3786 a_v(i,k-2,j) = a_v(i,k-2,j)-0.083333333*a_vflux(i,k)*vel
3787 a_v(i,k-1,j) = a_v(i,k-1,j)+0.58333333*a_vflux(i,k)*vel
3788 a_v(i,k+1,j) = a_v(i,k+1,j)-0.083333333*a_vflux(i,k)*vel
3789 a_v(i,k,j) = a_v(i,k,j)+0.58333333*a_vflux(i,k)*vel
3790 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(v(i,k,j)+v(i,k-1,j))-0.083333333*(v(i,k+1,j)+v(i,k-2,j)))
3791 a_vflux(i,k) = 0.
3792 ! recdepend vars : ktf
3793 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2544
3794 ! recompute vars : k
3795 k = ktf-1
3796 ! recompute vars : k
3797 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vel
3798 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
3799 a_vel = 0.
3800 ! recdepend vars : kts
3801 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2539
3802 ! recompute vars : k
3803 k = kts+2
3804 ! recompute vars : k
3805 ! recdepend vars : i,j,k,rom
3806 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2540
3807 ! recompute vars : vel
3808 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3809 ! recompute vars : vel
3810 a_v(i,k-2,j) = a_v(i,k-2,j)-0.083333333*a_vflux(i,k)*vel
3811 a_v(i,k-1,j) = a_v(i,k-1,j)+0.58333333*a_vflux(i,k)*vel
3812 a_v(i,k+1,j) = a_v(i,k+1,j)-0.083333333*a_vflux(i,k)*vel
3813 a_v(i,k,j) = a_v(i,k,j)+0.58333333*a_vflux(i,k)*vel
3814 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(v(i,k,j)+v(i,k-1,j))-0.083333333*(v(i,k+1,j)+v(i,k-2,j)))
3815 a_vflux(i,k) = 0.
3816 ! recdepend vars : kts
3817 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2539
3818 ! recompute vars : k
3819 k = kts+2
3820 ! recompute vars : k
3821 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vel
3822 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
3823 a_vel = 0.
3824 ! recdepend vars : kts
3825 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2536
3826 ! recompute vars : k
3827 k = kts+1
3828 ! recompute vars : k
3829 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3830 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3831 a_v(i,k-1,j) = a_v(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)
3832 a_v(i,k,j) = a_v(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3833 a_vflux(i,k) = 0.
3834 end do
3835 do k = kts+3, ktf-2
3836 a_vel = 0.
3837 do i = i_start, i_end
3838 a_vel = 0.
3839 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3840 ! recompute : vel
3841 a_v(i,k-3,j) = a_v(i,k-3,j)+0.016666667*a_vflux(i,k)*vel
3842 a_v(i,k-2,j) = a_v(i,k-2,j)-0.13333333*a_vflux(i,k)*vel
3843 a_v(i,k-1,j) = a_v(i,k-1,j)+0.61666667*a_vflux(i,k)*vel
3844 a_v(i,k+2,j) = a_v(i,k+2,j)+0.016666667*a_vflux(i,k)*vel
3845 a_v(i,k+1,j) = a_v(i,k+1,j)-0.13333333*a_vflux(i,k)*vel
3846 a_v(i,k,j) = a_v(i,k,j)+0.61666667*a_vflux(i,k)*vel
3847 a_vel = a_vel+a_vflux(i,k)*(0.61666667*(v(i,k,j)+v(i,k-1,j))-0.13333333*(v(i,k+1,j)+v(i,k-2,j))+0.016666667*(v(i,k+2,j)+&
3848 &v(i,k-3,j)))
3849 a_vflux(i,k) = 0.
3850 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vel
3851 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
3852 a_vel = 0.
3853 end do
3854 end do
3855 end do
3856 else if (vert_order .eq. 5) then a_vert_order_test
3857 do j = j_end, j_start, -1
3858 do k = kts, ktf
3859 do i = i_start, i_end
3860 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
3861 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
3862 end do
3863 end do
3864 do i = i_start, i_end
3865 a_vel = 0.
3866 k = ktf-1
3867 ! recompute : k
3868 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3869 ! recompute : vel
3870 k = ktf
3871 ! recompute : k
3872 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3873 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3874 a_v(i,k-1,j) = a_v(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)
3875 a_v(i,k,j) = a_v(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3876 a_vflux(i,k) = 0.
3877 ! recdepend vars : ktf
3878 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2587
3879 ! recompute vars : k
3880 k = ktf-1
3881 ! recompute vars : k
3882 a_v(i,k-2,j) = a_v(i,k-2,j)+a_vflux(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))
3883 a_v(i,k-1,j) = a_v(i,k-1,j)+a_vflux(i,k)*vel*(0.58333333+0.25*sign(1.,-vel))
3884 a_v(i,k+1,j) = a_v(i,k+1,j)+a_vflux(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))
3885 a_v(i,k,j) = a_v(i,k,j)+a_vflux(i,k)*vel*(0.58333333+(-0.25)*sign(1.,-vel))
3886 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(v(i,k,j)+v(i,k-1,j))-0.083333333*(v(i,k+1,j)+v(i,k-2,j))+0.083333333*(v(i,k+1,j)-v(i,&
3887 &k-2,j)-3.*(v(i,k,j)-v(i,k-1,j)))*sign(1.,-vel))
3888 a_vflux(i,k) = 0.
3889 ! recdepend vars : ktf
3890 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2587
3891 ! recompute vars : k
3892 k = ktf-1
3893 ! recompute vars : k
3894 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vel
3895 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
3896 a_vel = 0.
3897 ! recdepend vars : kts
3898 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2582
3899 ! recompute vars : k
3900 k = kts+2
3901 ! recompute vars : k
3902 ! recdepend vars : i,j,k,rom
3903 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2583
3904 ! recompute vars : vel
3905 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3906 ! recompute vars : vel
3907 a_v(i,k-2,j) = a_v(i,k-2,j)+a_vflux(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))
3908 a_v(i,k-1,j) = a_v(i,k-1,j)+a_vflux(i,k)*vel*(0.58333333+0.25*sign(1.,-vel))
3909 a_v(i,k+1,j) = a_v(i,k+1,j)+a_vflux(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))
3910 a_v(i,k,j) = a_v(i,k,j)+a_vflux(i,k)*vel*(0.58333333+(-0.25)*sign(1.,-vel))
3911 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(v(i,k,j)+v(i,k-1,j))-0.083333333*(v(i,k+1,j)+v(i,k-2,j))+0.083333333*(v(i,k+1,j)-v(i,&
3912 &k-2,j)-3.*(v(i,k,j)-v(i,k-1,j)))*sign(1.,-vel))
3913 a_vflux(i,k) = 0.
3914 ! recdepend vars : kts
3915 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2582
3916 ! recompute vars : k
3917 k = kts+2
3918 ! recompute vars : k
3919 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vel
3920 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
3921 a_vel = 0.
3922 ! recdepend vars : kts
3923 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2579
3924 ! recompute vars : k
3925 k = kts+1
3926 ! recompute vars : k
3927 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3928 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3929 a_v(i,k-1,j) = a_v(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)
3930 a_v(i,k,j) = a_v(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3931 a_vflux(i,k) = 0.
3932 end do
3933 do k = kts+3, ktf-2
3934 a_vel = 0.
3935 do i = i_start, i_end
3936 a_vel = 0.
3937 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3938 ! recompute : vel
3939 a_v(i,k-3,j) = a_v(i,k-3,j)+a_vflux(i,k)*vel*(0.016666667-(-0.016666667)*sign(1.,-vel))
3940 a_v(i,k-2,j) = a_v(i,k-2,j)+a_vflux(i,k)*vel*((-0.13333333)-0.083333333*sign(1.,-vel))
3941 a_v(i,k-1,j) = a_v(i,k-1,j)+a_vflux(i,k)*vel*(0.61666667-(-0.16666667)*sign(1.,-vel))
3942 a_v(i,k+2,j) = a_v(i,k+2,j)+a_vflux(i,k)*vel*(0.016666667-0.016666667*sign(1.,-vel))
3943 a_v(i,k+1,j) = a_v(i,k+1,j)+a_vflux(i,k)*vel*((-0.13333333)-(-0.083333333)*sign(1.,-vel))
3944 a_v(i,k,j) = a_v(i,k,j)+a_vflux(i,k)*vel*(0.61666667-0.16666667*sign(1.,-vel))
3945 a_vel = a_vel+a_vflux(i,k)*(0.61666667*(v(i,k,j)+v(i,k-1,j))-0.13333333*(v(i,k+1,j)+v(i,k-2,j))+0.016666667*(v(i,k+2,j)+&
3946 &v(i,k-3,j))-0.016666667*(v(i,k+2,j)-v(i,k-3,j)-5.*(v(i,k+1,j)-v(i,k-2,j))+10.*(v(i,k,j)-v(i,k-1,j)))*sign(1.,-vel))
3947 a_vflux(i,k) = 0.
3948 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vel
3949 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
3950 a_vel = 0.
3951 end do
3952 end do
3953 end do
3954 else if (vert_order .eq. 4) then a_vert_order_test
3955 do j = j_end, j_start, -1
3956 do k = kts, ktf
3957 do i = i_start, i_end
3958 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
3959 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
3960 end do
3961 end do
3962 do i = i_start, i_end
3963 k = ktf
3964 ! recompute : k
3965 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3966 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3967 a_v(i,k-1,j) = a_v(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)
3968 a_v(i,k,j) = a_v(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3969 a_vflux(i,k) = 0.
3970 ! recdepend vars : kts
3971 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2622
3972 ! recompute vars : k
3973 k = kts+1
3974 ! recompute vars : k
3975 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3976 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3977 a_v(i,k-1,j) = a_v(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)
3978 a_v(i,k,j) = a_v(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3979 a_vflux(i,k) = 0.
3980 end do
3981 do k = kts+2, ktf-1
3982 a_vel = 0.
3983 do i = i_start, i_end
3984 a_vel = 0.
3985 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3986 ! recompute : vel
3987 a_v(i,k-2,j) = a_v(i,k-2,j)-0.083333333*a_vflux(i,k)*vel
3988 a_v(i,k-1,j) = a_v(i,k-1,j)+0.58333333*a_vflux(i,k)*vel
3989 a_v(i,k+1,j) = a_v(i,k+1,j)-0.083333333*a_vflux(i,k)*vel
3990 a_v(i,k,j) = a_v(i,k,j)+0.58333333*a_vflux(i,k)*vel
3991 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(v(i,k,j)+v(i,k-1,j))-0.083333333*(v(i,k+1,j)+v(i,k-2,j)))
3992 a_vflux(i,k) = 0.
3993 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vel
3994 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
3995 a_vel = 0.
3996 end do
3997 end do
3998 end do
3999 else if (vert_order .eq. 3) then a_vert_order_test
4000 do j = j_end, j_start, -1
4001 do k = kts, ktf
4002 do i = i_start, i_end
4003 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
4004 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
4005 end do
4006 end do
4007 do i = i_start, i_end
4008 k = ktf
4009 ! recompute : k
4010 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
4011 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
4012 a_v(i,k-1,j) = a_v(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)
4013 a_v(i,k,j) = a_v(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
4014 a_vflux(i,k) = 0.
4015 ! recdepend vars : kts
4016 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2655
4017 ! recompute vars : k
4018 k = kts+1
4019 ! recompute vars : k
4020 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
4021 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
4022 a_v(i,k-1,j) = a_v(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)
4023 a_v(i,k,j) = a_v(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
4024 a_vflux(i,k) = 0.
4025 end do
4026 do k = kts+2, ktf-1
4027 a_vel = 0.
4028 do i = i_start, i_end
4029 a_vel = 0.
4030 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
4031 ! recompute : vel
4032 a_v(i,k-2,j) = a_v(i,k-2,j)+a_vflux(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))
4033 a_v(i,k-1,j) = a_v(i,k-1,j)+a_vflux(i,k)*vel*(0.58333333+0.25*sign(1.,-vel))
4034 a_v(i,k+1,j) = a_v(i,k+1,j)+a_vflux(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))
4035 a_v(i,k,j) = a_v(i,k,j)+a_vflux(i,k)*vel*(0.58333333+(-0.25)*sign(1.,-vel))
4036 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(v(i,k,j)+v(i,k-1,j))-0.083333333*(v(i,k+1,j)+v(i,k-2,j))+0.083333333*(v(i,k+1,j)-&
4037 &v(i,k-2,j)-3.*(v(i,k,j)-v(i,k-1,j)))*sign(1.,-vel))
4038 a_vflux(i,k) = 0.
4039 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vel
4040 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
4041 a_vel = 0.
4042 end do
4043 end do
4044 end do
4045 else if (vert_order .eq. 2) then a_vert_order_test
4046 do j = j_start, j_end
4047 do k = kts, ktf
4048 do i = i_start, i_end
4049 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzw(k)
4050 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzw(k)
4051 end do
4052 end do
4053 do k = kts+1, ktf
4054 do i = i_start, i_end
4055 a_rom(i,k,j-1) = a_rom(i,k,j-1)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
4056 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vflux(i,k)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
4057 a_v(i,k-1,j) = a_v(i,k-1,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)
4058 a_v(i,k,j) = a_v(i,k,j)+0.5*a_vflux(i,k)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
4059 a_vflux(i,k) = 0.
4060 end do
4061 end do
4062 end do
4063 endif a_vert_order_test
4064 ! recdepend vars : jts
4065 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2438
4066 ! recompute vars : j_start
4067 j_start = jts
4068 ! recompute vars : j_start
4069 ! recdepend vars : j_start,jde,jte
4070 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2439
4071 ! recompute vars : j_end
4072 j_end = min(jte,jde)
4073 ! recompute vars : j_end
4074 ! recdepend vars : config_flags,j_end,j_start,jds,jts
4075 ! recompute pos : IF_STMT module_advect_em.f90:2444
4076 ! recompute vars : j_start
4077 if (config_flags%open_ys) then
4078 j_start = max(jds+1,jts)
4079 endif
4080 ! recompute vars : j_start
4081 ! recdepend vars : config_flags,j_end,j_start,jde,jte
4082 ! recompute pos : IF_STMT module_advect_em.f90:2448
4083 ! recompute vars : j_end
4084 if (config_flags%open_ye) then
4085 j_end = min(jte,jde-1)
4086 endif
4087 ! recompute vars : j_end
4088 if (config_flags%open_xe .and. ite .eq. ide) then
4089 do j = j_start, j_end
4090 a_dum = 0.
4091 a_dup = 0.
4092 a_ub = 0.
4093 a_uw = 0.
4094 mrdx = msfv(ite-1,j)*rdx
4095 ! recompute : mrdx
4096 jp = min(jmax,j)
4097 ! recompute : jp
4098 jm = max(jmin,j-1)
4099 ! recompute : jm
4100 do k = kts, ktf
4101 a_dum = 0.
4102 a_dup = 0.
4103 a_ub = 0.
4104 a_uw = 0.
4105 uw = 0.5*(ru(ite,k,jp)+ru(ite,k,jm))
4106 ! recompute : uw
4107 ub = max(uw,0.)
4108 ! recompute : ub
4109 dup = ru(ite,k,jp)-ru(ite-1,k,jp)
4110 ! recompute : dup
4111 dum = ru(ite,k,jm)-ru(ite-1,k,jm)
4112 ! recompute : dum
4113 a_dum = a_dum-0.5*a_tendency(ite-1,k,j)*mrdx*v(ite-1,k,j)
4114 a_dup = a_dup-0.5*a_tendency(ite-1,k,j)*mrdx*v(ite-1,k,j)
4115 a_ub = a_ub-a_tendency(ite-1,k,j)*mrdx*(v_old(ite-1,k,j)-v_old(ite-2,k,j))
4116 a_v(ite-1,k,j) = a_v(ite-1,k,j)-0.5*a_tendency(ite-1,k,j)*mrdx*(dup+dum)
4117 a_v_old(ite-2,k,j) = a_v_old(ite-2,k,j)+a_tendency(ite-1,k,j)*mrdx*ub
4118 a_v_old(ite-1,k,j) = a_v_old(ite-1,k,j)-a_tendency(ite-1,k,j)*mrdx*ub
4119 a_ru(ite-1,k,jm) = a_ru(ite-1,k,jm)-a_dum
4120 a_ru(ite,k,jm) = a_ru(ite,k,jm)+a_dum
4121 a_dum = 0.
4122 a_ru(ite-1,k,jp) = a_ru(ite-1,k,jp)-a_dup
4123 a_ru(ite,k,jp) = a_ru(ite,k,jp)+a_dup
4124 a_dup = 0.
4125 a_uw = a_uw+a_ub*(0.5+sign(0.5,uw-0.))
4126 a_ub = 0.
4127 a_ru(ite,k,jm) = a_ru(ite,k,jm)+0.5*a_uw
4128 a_ru(ite,k,jp) = a_ru(ite,k,jp)+0.5*a_uw
4129 a_uw = 0.
4130 end do
4131 end do
4132 endif
4133 ! recdepend vars : jts
4134 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2438
4135 ! recompute vars : j_start
4136 j_start = jts
4137 ! recompute vars : j_start
4138 ! recdepend vars : j_start,jde,jte
4139 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2439
4140 ! recompute vars : j_end
4141 j_end = min(jte,jde)
4142 ! recompute vars : j_end
4143 ! recdepend vars : config_flags,j_end,j_start,jds,jts
4144 ! recompute pos : IF_STMT module_advect_em.f90:2444
4145 ! recompute vars : j_start
4146 if (config_flags%open_ys) then
4147 j_start = max(jds+1,jts)
4148 endif
4149 ! recompute vars : j_start
4150 ! recdepend vars : config_flags,j_end,j_start,jde,jte
4151 ! recompute pos : IF_STMT module_advect_em.f90:2448
4152 ! recompute vars : j_end
4153 if (config_flags%open_ye) then
4154 j_end = min(jte,jde-1)
4155 endif
4156 ! recompute vars : j_end
4157 if (config_flags%open_xs .and. its .eq. ids) then
4158 do j = j_start, j_end
4159 a_dum = 0.
4160 a_dup = 0.
4161 a_ub = 0.
4162 a_uw = 0.
4163 mrdx = msfv(its,j)*rdx
4164 ! recompute : mrdx
4165 jp = min(jmax,j)
4166 ! recompute : jp
4167 jm = max(jmin,j-1)
4168 ! recompute : jm
4169 do k = kts, ktf
4170 a_dum = 0.
4171 a_dup = 0.
4172 a_ub = 0.
4173 a_uw = 0.
4174 uw = 0.5*(ru(its,k,jp)+ru(its,k,jm))
4175 ! recompute : uw
4176 ub = min(uw,0.)
4177 ! recompute : ub
4178 dup = ru(its+1,k,jp)-ru(its,k,jp)
4179 ! recompute : dup
4180 dum = ru(its+1,k,jm)-ru(its,k,jm)
4181 ! recompute : dum
4182 a_dum = a_dum-0.5*a_tendency(its,k,j)*mrdx*v(its,k,j)
4183 a_dup = a_dup-0.5*a_tendency(its,k,j)*mrdx*v(its,k,j)
4184 a_ub = a_ub-a_tendency(its,k,j)*mrdx*(v_old(its+1,k,j)-v_old(its,k,j))
4185 a_v(its,k,j) = a_v(its,k,j)-0.5*a_tendency(its,k,j)*mrdx*(dup+dum)
4186 a_v_old(its+1,k,j) = a_v_old(its+1,k,j)-a_tendency(its,k,j)*mrdx*ub
4187 a_v_old(its,k,j) = a_v_old(its,k,j)+a_tendency(its,k,j)*mrdx*ub
4188 a_ru(its+1,k,jm) = a_ru(its+1,k,jm)+a_dum
4189 a_ru(its,k,jm) = a_ru(its,k,jm)-a_dum
4190 a_dum = 0.
4191 a_ru(its+1,k,jp) = a_ru(its+1,k,jp)+a_dup
4192 a_ru(its,k,jp) = a_ru(its,k,jp)-a_dup
4193 a_dup = 0.
4194 a_uw = a_uw+a_ub*(0.5+sign(0.5,0.-uw))
4195 a_ub = 0.
4196 a_ru(its,k,jm) = a_ru(its,k,jm)+0.5*a_uw
4197 a_ru(its,k,jp) = a_ru(its,k,jp)+0.5*a_uw
4198 a_uw = 0.
4199 end do
4200 end do
4201 endif
4202 if (config_flags%open_ye .and. jte .eq. jde) then
4203 i_start = its
4204 ! recompute : i_start
4205 i_end = min(ite,ide-1)
4206 ! recompute : i_end
4207 do i = i_start, i_end
4208 a_vb = 0.
4209 do k = kts, ktf
4210 a_vb = 0.
4211 vb = max(rv(i,k,jte)+cb*mut(i,jte-1),0.)
4212 ! recompute : vb
4213 a_v_old(i,k,jte-1) = a_v_old(i,k,jte-1)+a_tendency(i,k,jte)*rdy*vb
4214 a_v_old(i,k,jte) = a_v_old(i,k,jte)-a_tendency(i,k,jte)*rdy*vb
4215 a_vb = a_vb-a_tendency(i,k,jte)*rdy*(v_old(i,k,jte)-v_old(i,k,jte-1))
4216 a_mut(i,jte-1) = a_mut(i,jte-1)+a_vb*(0.5+sign(0.5,rv(i,k,jte)+cb*mut(i,jte-1)-0.))*cb
4217 a_rv(i,k,jte) = a_rv(i,k,jte)+a_vb*(0.5+sign(0.5,rv(i,k,jte)+cb*mut(i,jte-1)-0.))
4218 a_vb = 0.
4219 end do
4220 end do
4221 endif
4222 if (config_flags%open_ys .and. jts .eq. jds) then
4223 i_start = its
4224 ! recompute : i_start
4225 i_end = min(ite,ide-1)
4226 ! recompute : i_end
4227 do i = i_start, i_end
4228 a_vb = 0.
4229 do k = kts, ktf
4230 a_vb = 0.
4231 vb = min(rv(i,k,jts)-cb*mut(i,jts),0.)
4232 ! recompute : vb
4233 a_v_old(i,k,jts+1) = a_v_old(i,k,jts+1)-a_tendency(i,k,jts)*rdy*vb
4234 a_v_old(i,k,jts) = a_v_old(i,k,jts)+a_tendency(i,k,jts)*rdy*vb
4235 a_vb = a_vb-a_tendency(i,k,jts)*rdy*(v_old(i,k,jts+1)-v_old(i,k,jts))
4236 a_mut(i,jts) = a_mut(i,jts)-a_vb*(0.5+sign(0.5,0.-(rv(i,k,jts)-cb*mut(i,jts))))*cb
4237 a_rv(i,k,jts) = a_rv(i,k,jts)+a_vb*(0.5+sign(0.5,0.-(rv(i,k,jts)-cb*mut(i,jts))))
4238 a_vb = 0.
4239 end do
4240 end do
4241 endif
4242 ! recdepend vars : kde,kte
4243 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1491
4244 ! recompute vars : ktf
4245 ktf = min(kte,kde-1)
4246 ! recompute vars : ktf
4247 a_horizontal_order_test: if (horz_order .eq. 6) then
4248 degrade_xs = .true.
4249 ! recompute : degrade_xs
4250 degrade_xe = .true.
4251 ! recompute : degrade_xe
4252 degrade_ys = .true.
4253 ! recompute : degrade_ys
4254 degrade_ye = .true.
4255 ! recompute : degrade_ye
4256 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
4257 degrade_xs = .false.
4258 endif
4259 ! recompute : degrade_xs
4260 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-3) then
4261 degrade_xe = .false.
4262 endif
4263 ! recompute : degrade_xe
4264 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
4265 degrade_ys = .false.
4266 endif
4267 ! recompute : degrade_ys
4268 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
4269 degrade_ye = .false.
4270 endif
4271 ! recompute : degrade_ye
4272 ! recompute : ktf
4273 j_start = jts
4274 ! recompute : j_start
4275 j_end = jte
4276 ! recompute : j_end
4277 j_start_f = j_start
4278 ! recompute : j_start_f
4279 j_end_f = j_end+1
4280 ! recompute : j_end_f
4281 if (degrade_ys) then
4282 j_start_f = jds+3
4283 endif
4284 ! recompute : j_start_f
4285 if (degrade_ye) then
4286 j_end_f = jde-2
4287 endif
4288 ! recompute : j_end_f
4289 i_start = its
4290 ! recompute : i_start
4291 i_end = min(ite,ide-1)
4292 ! recompute : i_end
4293 j_start = jts
4294 ! recompute : j_start
4295 j_end = jte
4296 ! recompute : j_end
4297 if (config_flags%open_ys .or. specified) then
4298 j_start = max(jds+1,jts)
4299 endif
4300 ! recompute : j_start
4301 if (config_flags%open_ye .or. specified) then
4302 j_end = min(jde-1,jte)
4303 endif
4304 ! recompute : j_end
4305 i_start_f = i_start
4306 ! recompute : i_start_f
4307 i_end_f = i_end+1
4308 ! recompute : i_end_f
4309 if (degrade_xs) then
4310 i_start = max(ids+1,its)
4311 i_start_f = i_start+2
4312 endif
4313 ! recompute : i_start,i_start_f
4314 if (degrade_xe) then
4315 i_end = min(ide-2,ite)
4316 i_end_f = ide-3
4317 endif
4318 ! recompute : i_end,i_end_f
4319 do j = j_end, j_start, -1
4320 do k = kts, ktf
4321 do i = i_start, i_end
4322 mrdx = msfv(i,j)*rdx
4323 ! recompute : mrdx
4324 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
4325 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
4326 end do
4327 end do
4328 if (degrade_xe) then
4329 i = ide-2
4330 ! recompute : i
4331 do k = kts, ktf
4332 a_vel = 0.
4333 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
4334 ! recompute : vel
4335 a_v(i-2,k,j) = a_v(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
4336 a_v(i-1,k,j) = a_v(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
4337 a_v(i+1,k,j) = a_v(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
4338 a_v(i,k,j) = a_v(i,k,j)+0.58333333*a_fqx(i,k)*vel
4339 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(v(i,k,j)+v(i-1,k,j))-0.083333333*(v(i+1,k,j)+v(i-2,k,j)))
4340 a_fqx(i,k) = 0.
4341 a_ru(i,k,j-1) = a_ru(i,k,j-1)+0.5*a_vel
4342 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
4343 a_vel = 0.
4344 end do
4345 if (i_end .eq. ide-2) then
4346 i = ide-1
4347 ! recompute : i
4348 do k = kts, ktf
4349 a_ru(i_end+1,k,j-1) = a_ru(i_end+1,k,j-1)+0.25*a_fqx(i,k)*(v(i_end+1,k,j)+v(i_end,k,j))
4350 a_ru(i_end+1,k,j) = a_ru(i_end+1,k,j)+0.25*a_fqx(i,k)*(v(i_end+1,k,j)+v(i_end,k,j))
4351 a_v(i_end+1,k,j) = a_v(i_end+1,k,j)+0.25*a_fqx(i,k)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))
4352 a_v(i_end,k,j) = a_v(i_end,k,j)+0.25*a_fqx(i,k)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))
4353 a_fqx(i,k) = 0.
4354 end do
4355 endif
4356 endif
4357 if (degrade_xs) then
4358 i = ids+2
4359 ! recompute : i
4360 do k = kts, ktf
4361 a_vel = 0.
4362 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
4363 ! recompute : vel
4364 a_v(i-2,k,j) = a_v(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
4365 a_v(i-1,k,j) = a_v(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
4366 a_v(i+1,k,j) = a_v(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
4367 a_v(i,k,j) = a_v(i,k,j)+0.58333333*a_fqx(i,k)*vel
4368 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(v(i,k,j)+v(i-1,k,j))-0.083333333*(v(i+1,k,j)+v(i-2,k,j)))
4369 a_fqx(i,k) = 0.
4370 a_ru(i,k,j-1) = a_ru(i,k,j-1)+0.5*a_vel
4371 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
4372 a_vel = 0.
4373 end do
4374 if (i_start .eq. ids+1) then
4375 i = ids+1
4376 ! recompute : i
4377 do k = kts, ktf
4378 a_ru(i,k,j-1) = a_ru(i,k,j-1)+0.25*a_fqx(i,k)*(v(i,k,j)+v(i-1,k,j))
4379 a_ru(i,k,j) = a_ru(i,k,j)+0.25*a_fqx(i,k)*(v(i,k,j)+v(i-1,k,j))
4380 a_v(i-1,k,j) = a_v(i-1,k,j)+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i,k,j-1))
4381 a_v(i,k,j) = a_v(i,k,j)+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i,k,j-1))
4382 a_fqx(i,k) = 0.
4383 end do
4384 endif
4385 endif
4386 do k = kts, ktf
4387 a_vel = 0.
4388 do i = i_start_f, i_end_f
4389 a_vel = 0.
4390 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
4391 ! recompute : vel
4392 a_v(i-3,k,j) = a_v(i-3,k,j)+0.016666667*a_fqx(i,k)*vel
4393 a_v(i-2,k,j) = a_v(i-2,k,j)-0.13333333*a_fqx(i,k)*vel
4394 a_v(i-1,k,j) = a_v(i-1,k,j)+0.61666667*a_fqx(i,k)*vel
4395 a_v(i+2,k,j) = a_v(i+2,k,j)+0.016666667*a_fqx(i,k)*vel
4396 a_v(i+1,k,j) = a_v(i+1,k,j)-0.13333333*a_fqx(i,k)*vel
4397 a_v(i,k,j) = a_v(i,k,j)+0.61666667*a_fqx(i,k)*vel
4398 a_vel = a_vel+a_fqx(i,k)*(0.61666667*(v(i,k,j)+v(i-1,k,j))-0.13333333*(v(i+1,k,j)+v(i-2,k,j))+0.016666667*(v(i+2,k,j)+v(i-&
4399 &3,k,j)))
4400 a_fqx(i,k) = 0.
4401 a_ru(i,k,j-1) = a_ru(i,k,j-1)+0.5*a_vel
4402 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
4403 a_vel = 0.
4404 end do
4405 end do
4406 end do
4407 ! recdepend vars : its
4408 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1530
4409 ! recompute vars : i_start
4410 i_start = its
4411 ! recompute vars : i_start
4412 ! recdepend vars : i_start,ide,ite
4413 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1531
4414 ! recompute vars : i_end
4415 i_end = min(ite,ide-1)
4416 ! recompute vars : i_end
4417 ! recdepend vars : i_end,i_start,jts
4418 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1532
4419 ! recompute vars : j_start
4420 j_start = jts
4421 ! recompute vars : j_start
4422 ! recdepend vars : i_end,i_start,j_start,jte
4423 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1533
4424 ! recompute vars : j_end
4425 j_end = jte
4426 ! recompute vars : j_end
4427 ! recdepend vars : degrade_ys,i_end,i_start,j_end,j_start,jds,jts
4428 ! recompute pos : IF_STMT module_advect_em.f90:1541
4429 ! recompute vars : j_start
4430 if (degrade_ys) then
4431 j_start = max(jts,jds+1)
4432 endif
4433 ! recompute vars : j_start
4434 ! recdepend vars : degrade_ye,i_end,i_start,j_end,j_start,jde,jte
4435 ! recompute pos : IF_STMT module_advect_em.f90:1546
4436 ! recompute vars : j_end
4437 if (degrade_ye) then
4438 j_end = min(jte,jde-1)
4439 endif
4440 ! recompute vars : j_end
4441 a_j_loop_y_flux_6: do j = j_end+1, j_start, -1
4442 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1553
4443 ! recompute vars : jp1
4444 jp1 = 2
4445 ! recompute vars : jp1
4446 ! recdepend vars : jp1
4447 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1554
4448 ! recompute vars : jp0
4449 jp0 = 1
4450 ! recompute vars : jp0
4451 j_loop_y_flux_9c: do j4 = j_start, j-1
4452 jtmp = jp1
4453 jp1 = jp0
4454 jp0 = jtmp
4455 end do j_loop_y_flux_9c
4456 if (j .gt. j_start) then
4457 do k = kts, ktf
4458 do i = i_start, i_end
4459 mrdy = msfv(i,j-1)*rdy
4460 ! recompute : mrdy
4461 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
4462 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
4463 end do
4464 end do
4465 endif
4466 if (j .ge. j_start_f .and. j .le. j_end_f) then
4467 do k = kts, ktf
4468 a_vel = 0.
4469 do i = i_start, i_end
4470 a_vel = 0.
4471 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
4472 ! recompute : vel
4473 a_v(i,k,j-3) = a_v(i,k,j-3)+0.016666667*a_fqy(i,k,jp1)*vel
4474 a_v(i,k,j-2) = a_v(i,k,j-2)-0.13333333*a_fqy(i,k,jp1)*vel
4475 a_v(i,k,j-1) = a_v(i,k,j-1)+0.61666667*a_fqy(i,k,jp1)*vel
4476 a_v(i,k,j+2) = a_v(i,k,j+2)+0.016666667*a_fqy(i,k,jp1)*vel
4477 a_v(i,k,j+1) = a_v(i,k,j+1)-0.13333333*a_fqy(i,k,jp1)*vel
4478 a_v(i,k,j) = a_v(i,k,j)+0.61666667*a_fqy(i,k,jp1)*vel
4479 a_vel = a_vel+a_fqy(i,k,jp1)*(0.61666667*(v(i,k,j)+v(i,k,j-1))-0.13333333*(v(i,k,j+1)+v(i,k,j-2))+0.016666667*(v(i,k,j+2)&
4480 &+v(i,k,j-3)))
4481 a_fqy(i,k,jp1) = 0.
4482 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.5*a_vel
4483 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
4484 a_vel = 0.
4485 end do
4486 end do
4487 else if (j .eq. jds+1) then
4488 do k = kts, ktf
4489 a_vb = 0.
4490 do i = i_start, i_end
4491 a_vb = 0.
4492 vb = v(i,k,j-1)
4493 ! recompute : vb
4494 if (specified .and. v(i,k,j) .lt. 0.) then
4495 vb = v(i,k,j)
4496 endif
4497 ! recompute : vb
4498 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(v(i,k,j)+vb)
4499 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_fqy(i,k,jp1)*(v(i,k,j)+vb)
4500 a_v(i,k,j) = a_v(i,k,j)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
4501 a_vb = a_vb+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
4502 a_fqy(i,k,jp1) = 0.
4503 if (specified .and. v(i,k,j) .lt. 0.) then
4504 a_v(i,k,j) = a_v(i,k,j)+a_vb
4505 a_vb = 0.
4506 endif
4507 a_v(i,k,j-1) = a_v(i,k,j-1)+a_vb
4508 a_vb = 0.
4509 end do
4510 end do
4511 else if (j .eq. jds+2) then
4512 do k = kts, ktf
4513 a_vel = 0.
4514 do i = i_start, i_end
4515 a_vel = 0.
4516 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
4517 ! recompute : vel
4518 a_v(i,k,j-2) = a_v(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
4519 a_v(i,k,j-1) = a_v(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
4520 a_v(i,k,j+1) = a_v(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
4521 a_v(i,k,j) = a_v(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
4522 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(v(i,k,j)+v(i,k,j-1))-0.083333333*(v(i,k,j+1)+v(i,k,j-2)))
4523 a_fqy(i,k,jp1) = 0.
4524 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.5*a_vel
4525 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
4526 a_vel = 0.
4527 end do
4528 end do
4529 else if (j .eq. jde) then
4530 do k = kts, ktf
4531 a_vb = 0.
4532 do i = i_start, i_end
4533 a_vb = 0.
4534 vb = v(i,k,j)
4535 ! recompute : vb
4536 if (specified .and. v(i,k,j-1) .gt. 0.) then
4537 vb = v(i,k,j-1)
4538 endif
4539 ! recompute : vb
4540 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(vb+v(i,k,j-1))
4541 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_fqy(i,k,jp1)*(vb+v(i,k,j-1))
4542 a_v(i,k,j-1) = a_v(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
4543 a_vb = a_vb+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
4544 a_fqy(i,k,jp1) = 0.
4545 if (specified .and. v(i,k,j-1) .gt. 0.) then
4546 a_v(i,k,j-1) = a_v(i,k,j-1)+a_vb
4547 a_vb = 0.
4548 endif
4549 a_v(i,k,j) = a_v(i,k,j)+a_vb
4550 a_vb = 0.
4551 end do
4552 end do
4553 else if (j .eq. jde-1) then
4554 do k = kts, ktf
4555 a_vel = 0.
4556 do i = i_start, i_end
4557 a_vel = 0.
4558 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
4559 ! recompute : vel
4560 a_v(i,k,j-2) = a_v(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
4561 a_v(i,k,j-1) = a_v(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
4562 a_v(i,k,j+1) = a_v(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
4563 a_v(i,k,j) = a_v(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
4564 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(v(i,k,j)+v(i,k,j-1))-0.083333333*(v(i,k,j+1)+v(i,k,j-2)))
4565 a_fqy(i,k,jp1) = 0.
4566 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.5*a_vel
4567 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
4568 a_vel = 0.
4569 end do
4570 end do
4571 endif
4572 end do a_j_loop_y_flux_6
4573 else if (horz_order .eq. 5) then a_horizontal_order_test
4574 degrade_xs = .true.
4575 ! recompute : degrade_xs
4576 degrade_xe = .true.
4577 ! recompute : degrade_xe
4578 degrade_ys = .true.
4579 ! recompute : degrade_ys
4580 degrade_ye = .true.
4581 ! recompute : degrade_ye
4582 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
4583 degrade_xs = .false.
4584 endif
4585 ! recompute : degrade_xs
4586 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-3) then
4587 degrade_xe = .false.
4588 endif
4589 ! recompute : degrade_xe
4590 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
4591 degrade_ys = .false.
4592 endif
4593 ! recompute : degrade_ys
4594 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
4595 degrade_ye = .false.
4596 endif
4597 ! recompute : degrade_ye
4598 j_start = jts
4599 ! recompute : j_start
4600 j_end = jte
4601 ! recompute : j_end
4602 j_start_f = j_start
4603 ! recompute : j_start_f
4604 j_end_f = j_end+1
4605 ! recompute : j_end_f
4606 if (degrade_ys) then
4607 j_start_f = jds+3
4608 endif
4609 ! recompute : j_start_f
4610 if (degrade_ye) then
4611 j_end_f = jde-2
4612 endif
4613 ! recompute : j_end_f
4614 i_start = its
4615 ! recompute : i_start
4616 i_end = min(ite,ide-1)
4617 ! recompute : i_end
4618 j_start = jts
4619 ! recompute : j_start
4620 j_end = jte
4621 ! recompute : j_end
4622 if (config_flags%open_ys .or. specified) then
4623 j_start = max(jds+1,jts)
4624 endif
4625 ! recompute : j_start
4626 if (config_flags%open_ye .or. specified) then
4627 j_end = min(jde-1,jte)
4628 endif
4629 ! recompute : j_end
4630 i_start_f = i_start
4631 ! recompute : i_start_f
4632 i_end_f = i_end+1
4633 ! recompute : i_end_f
4634 if (degrade_xs) then
4635 i_start = max(ids+1,its)
4636 i_start_f = i_start+2
4637 endif
4638 ! recompute : i_start,i_start_f
4639 if (degrade_xe) then
4640 i_end = min(ide-2,ite)
4641 i_end_f = ide-3
4642 endif
4643 ! recompute : i_end,i_end_f
4644 do j = j_end, j_start, -1
4645 do k = kts, ktf
4646 do i = i_start, i_end
4647 mrdx = msfv(i,j)*rdx
4648 ! recompute : mrdx
4649 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
4650 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
4651 end do
4652 end do
4653 if (degrade_xe) then
4654 i = ide-2
4655 ! recompute : i
4656 do k = kts, ktf
4657 a_vel = 0.
4658 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
4659 ! recompute : vel
4660 a_v(i-2,k,j) = a_v(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
4661 a_v(i-1,k,j) = a_v(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
4662 a_v(i+1,k,j) = a_v(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
4663 a_v(i,k,j) = a_v(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
4664 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(v(i,k,j)+v(i-1,k,j))-0.083333333*(v(i+1,k,j)+v(i-2,k,j))+0.083333333*(v(i+1,k,j)-v(i-&
4665 &2,k,j)-3.*(v(i,k,j)-v(i-1,k,j)))*sign(1.,vel))
4666 a_fqx(i,k) = 0.
4667 a_ru(i,k,j-1) = a_ru(i,k,j-1)+0.5*a_vel
4668 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
4669 a_vel = 0.
4670 end do
4671 if (i_end .eq. ide-2) then
4672 i = ide-1
4673 ! recompute : i
4674 do k = kts, ktf
4675 a_ru(i_end+1,k,j-1) = a_ru(i_end+1,k,j-1)+0.25*a_fqx(i,k)*(v(i_end+1,k,j)+v(i_end,k,j))
4676 a_ru(i_end+1,k,j) = a_ru(i_end+1,k,j)+0.25*a_fqx(i,k)*(v(i_end+1,k,j)+v(i_end,k,j))
4677 a_v(i_end+1,k,j) = a_v(i_end+1,k,j)+0.25*a_fqx(i,k)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))
4678 a_v(i_end,k,j) = a_v(i_end,k,j)+0.25*a_fqx(i,k)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))
4679 a_fqx(i,k) = 0.
4680 end do
4681 endif
4682 endif
4683 if (degrade_xs) then
4684 i = ids+2
4685 ! recompute : i
4686 do k = kts, ktf
4687 a_vel = 0.
4688 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
4689 ! recompute : vel
4690 a_v(i-2,k,j) = a_v(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
4691 a_v(i-1,k,j) = a_v(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
4692 a_v(i+1,k,j) = a_v(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
4693 a_v(i,k,j) = a_v(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
4694 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(v(i,k,j)+v(i-1,k,j))-0.083333333*(v(i+1,k,j)+v(i-2,k,j))+0.083333333*(v(i+1,k,j)-v(i-&
4695 &2,k,j)-3.*(v(i,k,j)-v(i-1,k,j)))*sign(1.,vel))
4696 a_fqx(i,k) = 0.
4697 a_ru(i,k,j-1) = a_ru(i,k,j-1)+0.5*a_vel
4698 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
4699 a_vel = 0.
4700 end do
4701 if (i_start .eq. ids+1) then
4702 i = ids+1
4703 ! recompute : i
4704 do k = kts, ktf
4705 a_ru(i,k,j-1) = a_ru(i,k,j-1)+0.25*a_fqx(i,k)*(v(i,k,j)+v(i-1,k,j))
4706 a_ru(i,k,j) = a_ru(i,k,j)+0.25*a_fqx(i,k)*(v(i,k,j)+v(i-1,k,j))
4707 a_v(i-1,k,j) = a_v(i-1,k,j)+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i,k,j-1))
4708 a_v(i,k,j) = a_v(i,k,j)+0.25*a_fqx(i,k)*(ru(i,k,j)+ru(i,k,j-1))
4709 a_fqx(i,k) = 0.
4710 end do
4711 endif
4712 endif
4713 do k = kts, ktf
4714 a_vel = 0.
4715 do i = i_start_f, i_end_f
4716 a_vel = 0.
4717 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
4718 ! recompute : vel
4719 a_v(i-3,k,j) = a_v(i-3,k,j)+a_fqx(i,k)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))
4720 a_v(i-2,k,j) = a_v(i-2,k,j)+a_fqx(i,k)*vel*((-0.13333333)-0.083333333*sign(1.,vel))
4721 a_v(i-1,k,j) = a_v(i-1,k,j)+a_fqx(i,k)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))
4722 a_v(i+2,k,j) = a_v(i+2,k,j)+a_fqx(i,k)*vel*(0.016666667-0.016666667*sign(1.,vel))
4723 a_v(i+1,k,j) = a_v(i+1,k,j)+a_fqx(i,k)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))
4724 a_v(i,k,j) = a_v(i,k,j)+a_fqx(i,k)*vel*(0.61666667-0.16666667*sign(1.,vel))
4725 a_vel = a_vel+a_fqx(i,k)*(0.61666667*(v(i,k,j)+v(i-1,k,j))-0.13333333*(v(i+1,k,j)+v(i-2,k,j))+0.016666667*(v(i+2,k,j)+v(i-&
4726 &3,k,j))-0.016666667*(v(i+2,k,j)-v(i-3,k,j)-5.*(v(i+1,k,j)-v(i-2,k,j))+10.*(v(i,k,j)-v(i-1,k,j)))*sign(1.,vel))
4727 a_fqx(i,k) = 0.
4728 a_ru(i,k,j-1) = a_ru(i,k,j-1)+0.5*a_vel
4729 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
4730 a_vel = 0.
4731 end do
4732 end do
4733 end do
4734 ! recdepend vars : its
4735 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1765
4736 ! recompute vars : i_start
4737 i_start = its
4738 ! recompute vars : i_start
4739 ! recdepend vars : i_start,ide,ite
4740 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1766
4741 ! recompute vars : i_end
4742 i_end = min(ite,ide-1)
4743 ! recompute vars : i_end
4744 ! recdepend vars : i_end,i_start,jts
4745 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1767
4746 ! recompute vars : j_start
4747 j_start = jts
4748 ! recompute vars : j_start
4749 ! recdepend vars : i_end,i_start,j_start,jte
4750 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1768
4751 ! recompute vars : j_end
4752 j_end = jte
4753 ! recompute vars : j_end
4754 ! recdepend vars : degrade_ys,i_end,i_start,j_end,j_start,jds,jts
4755 ! recompute pos : IF_STMT module_advect_em.f90:1776
4756 ! recompute vars : j_start
4757 if (degrade_ys) then
4758 j_start = max(jts,jds+1)
4759 endif
4760 ! recompute vars : j_start
4761 ! recdepend vars : degrade_ye,i_end,i_start,j_end,j_start,jde,jte
4762 ! recompute pos : IF_STMT module_advect_em.f90:1781
4763 ! recompute vars : j_end
4764 if (degrade_ye) then
4765 j_end = min(jte,jde-1)
4766 endif
4767 ! recompute vars : j_end
4768 a_j_loop_y_flux_5: do j = j_end+1, j_start, -1
4769 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1788
4770 ! recompute vars : jp1
4771 jp1 = 2
4772 ! recompute vars : jp1
4773 ! recdepend vars : jp1
4774 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1789
4775 ! recompute vars : jp0
4776 jp0 = 1
4777 ! recompute vars : jp0
4778 j_loop_y_flux_9a: do j1 = j_start, j-1
4779 jtmp = jp1
4780 jp1 = jp0
4781 jp0 = jtmp
4782 end do j_loop_y_flux_9a
4783 if (j .gt. j_start) then
4784 do k = kts, ktf
4785 do i = i_start, i_end
4786 mrdy = msfv(i,j-1)*rdy
4787 ! recompute : mrdy
4788 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
4789 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
4790 end do
4791 end do
4792 endif
4793 if (j .ge. j_start_f .and. j .le. j_end_f) then
4794 do k = kts, ktf
4795 a_vel = 0.
4796 do i = i_start, i_end
4797 a_vel = 0.
4798 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
4799 ! recompute : vel
4800 a_v(i,k,j-3) = a_v(i,k,j-3)+a_fqy(i,k,jp1)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))
4801 a_v(i,k,j-2) = a_v(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.13333333)-0.083333333*sign(1.,vel))
4802 a_v(i,k,j-1) = a_v(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))
4803 a_v(i,k,j+2) = a_v(i,k,j+2)+a_fqy(i,k,jp1)*vel*(0.016666667-0.016666667*sign(1.,vel))
4804 a_v(i,k,j+1) = a_v(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))
4805 a_v(i,k,j) = a_v(i,k,j)+a_fqy(i,k,jp1)*vel*(0.61666667-0.16666667*sign(1.,vel))
4806 a_vel = a_vel+a_fqy(i,k,jp1)*(0.61666667*(v(i,k,j)+v(i,k,j-1))-0.13333333*(v(i,k,j+1)+v(i,k,j-2))+0.016666667*(v(i,k,j+2)&
4807 &+v(i,k,j-3))-0.016666667*(v(i,k,j+2)-v(i,k,j-3)-5.*(v(i,k,j+1)-v(i,k,j-2))+10.*(v(i,k,j)-v(i,k,j-1)))*sign(1.,vel))
4808 a_fqy(i,k,jp1) = 0.
4809 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.5*a_vel
4810 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
4811 a_vel = 0.
4812 end do
4813 end do
4814 else if (j .eq. jds+1) then
4815 do k = kts, ktf
4816 a_vb = 0.
4817 do i = i_start, i_end
4818 a_vb = 0.
4819 vb = v(i,k,j-1)
4820 ! recompute : vb
4821 if (specified .and. v(i,k,j) .lt. 0.) then
4822 vb = v(i,k,j)
4823 endif
4824 ! recompute : vb
4825 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(v(i,k,j)+vb)
4826 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_fqy(i,k,jp1)*(v(i,k,j)+vb)
4827 a_v(i,k,j) = a_v(i,k,j)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
4828 a_vb = a_vb+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
4829 a_fqy(i,k,jp1) = 0.
4830 if (specified .and. v(i,k,j) .lt. 0.) then
4831 a_v(i,k,j) = a_v(i,k,j)+a_vb
4832 a_vb = 0.
4833 endif
4834 a_v(i,k,j-1) = a_v(i,k,j-1)+a_vb
4835 a_vb = 0.
4836 end do
4837 end do
4838 else if (j .eq. jds+2) then
4839 do k = kts, ktf
4840 a_vel = 0.
4841 do i = i_start, i_end
4842 a_vel = 0.
4843 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
4844 ! recompute : vel
4845 a_v(i,k,j-2) = a_v(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
4846 a_v(i,k,j-1) = a_v(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
4847 a_v(i,k,j+1) = a_v(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
4848 a_v(i,k,j) = a_v(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
4849 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(v(i,k,j)+v(i,k,j-1))-0.083333333*(v(i,k,j+1)+v(i,k,j-2))+0.083333333*(v(i,k,j+&
4850 &1)-v(i,k,j-2)-3.*(v(i,k,j)-v(i,k,j-1)))*sign(1.,vel))
4851 a_fqy(i,k,jp1) = 0.
4852 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.5*a_vel
4853 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
4854 a_vel = 0.
4855 end do
4856 end do
4857 else if (j .eq. jde) then
4858 do k = kts, ktf
4859 a_vb = 0.
4860 do i = i_start, i_end
4861 a_vb = 0.
4862 vb = v(i,k,j)
4863 ! recompute : vb
4864 if (specified .and. v(i,k,j-1) .gt. 0.) then
4865 vb = v(i,k,j-1)
4866 endif
4867 ! recompute : vb
4868 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(vb+v(i,k,j-1))
4869 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_fqy(i,k,jp1)*(vb+v(i,k,j-1))
4870 a_v(i,k,j-1) = a_v(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
4871 a_vb = a_vb+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
4872 a_fqy(i,k,jp1) = 0.
4873 if (specified .and. v(i,k,j-1) .gt. 0.) then
4874 a_v(i,k,j-1) = a_v(i,k,j-1)+a_vb
4875 a_vb = 0.
4876 endif
4877 a_v(i,k,j) = a_v(i,k,j)+a_vb
4878 a_vb = 0.
4879 end do
4880 end do
4881 else if (j .eq. jde-1) then
4882 do k = kts, ktf
4883 a_vel = 0.
4884 do i = i_start, i_end
4885 a_vel = 0.
4886 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
4887 ! recompute : vel
4888 a_v(i,k,j-2) = a_v(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
4889 a_v(i,k,j-1) = a_v(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
4890 a_v(i,k,j+1) = a_v(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
4891 a_v(i,k,j) = a_v(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
4892 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(v(i,k,j)+v(i,k,j-1))-0.083333333*(v(i,k,j+1)+v(i,k,j-2))+0.083333333*(v(i,k,j+&
4893 &1)-v(i,k,j-2)-3.*(v(i,k,j)-v(i,k,j-1)))*sign(1.,vel))
4894 a_fqy(i,k,jp1) = 0.
4895 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.5*a_vel
4896 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
4897 a_vel = 0.
4898 end do
4899 end do
4900 endif
4901 end do a_j_loop_y_flux_5
4902 else if (horz_order .eq. 4) then a_horizontal_order_test
4903 degrade_xs = .true.
4904 ! recompute : degrade_xs
4905 degrade_xe = .true.
4906 ! recompute : degrade_xe
4907 degrade_ys = .true.
4908 ! recompute : degrade_ys
4909 degrade_ye = .true.
4910 ! recompute : degrade_ye
4911 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
4912 degrade_xs = .false.
4913 endif
4914 ! recompute : degrade_xs
4915 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
4916 degrade_xe = .false.
4917 endif
4918 ! recompute : degrade_xe
4919 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
4920 degrade_ys = .false.
4921 endif
4922 ! recompute : degrade_ys
4923 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-1) then
4924 degrade_ye = .false.
4925 endif
4926 ! recompute : degrade_ye
4927 ! recompute : ktf
4928 i_start = its
4929 ! recompute : i_start
4930 i_end = min(ite,ide-1)
4931 ! recompute : i_end
4932 j_start = jts
4933 ! recompute : j_start
4934 j_end = jte
4935 ! recompute : j_end
4936 if (config_flags%open_ys .or. specified) then
4937 j_start = max(jds+1,jts)
4938 endif
4939 ! recompute : j_start
4940 if (config_flags%open_ye .or. specified) then
4941 j_end = min(jde-1,jte)
4942 endif
4943 ! recompute : j_end
4944 i_start_f = i_start
4945 ! recompute : i_start_f
4946 i_end_f = i_end+1
4947 ! recompute : i_end_f
4948 if (degrade_xs) then
4949 i_start = ids+1
4950 i_start_f = i_start+1
4951 endif
4952 ! recompute : i_start,i_start_f
4953 if (degrade_xe) then
4954 i_end = ide-2
4955 i_end_f = ide-2
4956 endif
4957 ! recompute : i_end,i_end_f
4958 do j = j_start, j_end
4959 a_vel = 0.
4960 do k = kts, ktf
4961 do i = i_start, i_end
4962 mrdx = msfv(i,j)*rdx
4963 ! recompute : mrdx
4964 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
4965 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
4966 end do
4967 end do
4968 if (degrade_xe) then
4969 do k = kts, ktf
4970 a_ru(i_end+1,k,j-1) = a_ru(i_end+1,k,j-1)+0.25*a_fqx(i_end+1,k)*(v(i_end+1,k,j)+v(i_end,k,j))
4971 a_ru(i_end+1,k,j) = a_ru(i_end+1,k,j)+0.25*a_fqx(i_end+1,k)*(v(i_end+1,k,j)+v(i_end,k,j))
4972 a_v(i_end+1,k,j) = a_v(i_end+1,k,j)+0.25*a_fqx(i_end+1,k)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))
4973 a_v(i_end,k,j) = a_v(i_end,k,j)+0.25*a_fqx(i_end+1,k)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))
4974 a_fqx(i_end+1,k) = 0.
4975 end do
4976 endif
4977 if (degrade_xs) then
4978 do k = kts, ktf
4979 a_ru(i_start,k,j-1) = a_ru(i_start,k,j-1)+0.25*a_fqx(i_start,k)*(v(i_start,k,j)+v(i_start-1,k,j))
4980 a_ru(i_start,k,j) = a_ru(i_start,k,j)+0.25*a_fqx(i_start,k)*(v(i_start,k,j)+v(i_start-1,k,j))
4981 a_v(i_start-1,k,j) = a_v(i_start-1,k,j)+0.25*a_fqx(i_start,k)*(ru(i_start,k,j)+ru(i_start,k,j-1))
4982 a_v(i_start,k,j) = a_v(i_start,k,j)+0.25*a_fqx(i_start,k)*(ru(i_start,k,j)+ru(i_start,k,j-1))
4983 a_fqx(i_start,k) = 0.
4984 end do
4985 endif
4986 do k = kts, ktf
4987 a_vel = 0.
4988 do i = i_start_f, i_end_f
4989 a_vel = 0.
4990 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
4991 ! recompute : vel
4992 a_v(i-2,k,j) = a_v(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
4993 a_v(i-1,k,j) = a_v(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
4994 a_v(i+1,k,j) = a_v(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
4995 a_v(i,k,j) = a_v(i,k,j)+0.58333333*a_fqx(i,k)*vel
4996 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(v(i,k,j)+v(i-1,k,j))-0.083333333*(v(i+1,k,j)+v(i-2,k,j)))
4997 a_fqx(i,k) = 0.
4998 a_ru(i,k,j-1) = a_ru(i,k,j-1)+0.5*a_vel
4999 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
5000 a_vel = 0.
5001 end do
5002 end do
5003 end do
5004 ! recdepend vars : its
5005 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1998
5006 ! recompute vars : i_start
5007 i_start = its
5008 ! recompute vars : i_start
5009 ! recdepend vars : i_start,ide,ite
5010 ! recompute pos : ASSIGN_STMT module_advect_em.f90:1999
5011 ! recompute vars : i_end
5012 i_end = min(ite,ide-1)
5013 ! recompute vars : i_end
5014 ! recdepend vars : i_end,i_start,jts
5015 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2000
5016 ! recompute vars : j_start
5017 j_start = jts
5018 ! recompute vars : j_start
5019 ! recdepend vars : i_end,i_start,j_start,jte
5020 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2001
5021 ! recompute vars : j_end
5022 j_end = jte
5023 ! recompute vars : j_end
5024 ! recdepend vars : degrade_ys,i_end,i_start,j_end,j_start,jds
5025 ! recompute pos : IF_STMT module_advect_em.f90:2010
5026 ! recompute vars : j_start
5027 if (degrade_ys) then
5028 j_start = jds+1
5029 endif
5030 ! recompute vars : j_start
5031 ! recdepend vars : degrade_ye,i_end,i_start,j_end,j_start,jde
5032 ! recompute pos : IF_STMT module_advect_em.f90:2015
5033 ! recompute vars : j_end
5034 if (degrade_ye) then
5035 j_end = jde-1
5036 endif
5037 ! recompute vars : j_end
5038 do j = j_end+1, j_start, -1
5039 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2023
5040 ! recompute vars : jp0
5041 jp0 = 1
5042 ! recompute vars : jp0
5043 ! recdepend vars : jp0
5044 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2024
5045 ! recompute vars : jp1
5046 jp1 = 2
5047 ! recompute vars : jp1
5048 do j2 = j_start, j-1
5049 jtmp = jp1
5050 jp1 = jp0
5051 jp0 = jtmp
5052 end do
5053 if (j .gt. j_start) then
5054 do k = kts, ktf
5055 do i = i_start, i_end
5056 mrdy = msfv(i,j-1)*rdy
5057 ! recompute : mrdy
5058 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
5059 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
5060 end do
5061 end do
5062 endif
5063 if (j .eq. j_start .and. degrade_ys) then
5064 do k = kts, ktf
5065 a_vb = 0.
5066 do i = i_start, i_end
5067 a_vb = 0.
5068 vb = v(i,k,j-1)
5069 ! recompute : vb
5070 if (specified .and. v(i,k,j) .lt. 0.) then
5071 vb = v(i,k,j)
5072 endif
5073 ! recompute : vb
5074 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(v(i,k,j)+vb)
5075 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_fqy(i,k,jp1)*(v(i,k,j)+vb)
5076 a_v(i,k,j) = a_v(i,k,j)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
5077 a_vb = a_vb+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
5078 a_fqy(i,k,jp1) = 0.
5079 if (specified .and. v(i,k,j) .lt. 0.) then
5080 a_v(i,k,j) = a_v(i,k,j)+a_vb
5081 a_vb = 0.
5082 endif
5083 a_v(i,k,j-1) = a_v(i,k,j-1)+a_vb
5084 a_vb = 0.
5085 end do
5086 end do
5087 else if (j .eq. j_end+1 .and. degrade_ye) then
5088 do k = kts, ktf
5089 a_vb = 0.
5090 do i = i_start, i_end
5091 a_vb = 0.
5092 vb = v(i,k,j)
5093 ! recompute : vb
5094 if (specified .and. v(i,k,j-1) .gt. 0.) then
5095 vb = v(i,k,j-1)
5096 endif
5097 ! recompute : vb
5098 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(vb+v(i,k,j-1))
5099 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_fqy(i,k,jp1)*(vb+v(i,k,j-1))
5100 a_v(i,k,j-1) = a_v(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
5101 a_vb = a_vb+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
5102 a_fqy(i,k,jp1) = 0.
5103 if (specified .and. v(i,k,j-1) .gt. 0.) then
5104 a_v(i,k,j-1) = a_v(i,k,j-1)+a_vb
5105 a_vb = 0.
5106 endif
5107 a_v(i,k,j) = a_v(i,k,j)+a_vb
5108 a_vb = 0.
5109 end do
5110 end do
5111 else
5112 do k = kts, ktf
5113 a_vel = 0.
5114 do i = i_start, i_end
5115 a_vel = 0.
5116 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
5117 ! recompute : vel
5118 a_v(i,k,j-2) = a_v(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
5119 a_v(i,k,j-1) = a_v(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
5120 a_v(i,k,j+1) = a_v(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
5121 a_v(i,k,j) = a_v(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
5122 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(v(i,k,j)+v(i,k,j-1))-0.083333333*(v(i,k,j+1)+v(i,k,j-2)))
5123 a_fqy(i,k,jp1) = 0.
5124 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.5*a_vel
5125 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
5126 a_vel = 0.
5127 end do
5128 end do
5129 endif
5130 end do
5131 else if (horz_order .eq. 3) then a_horizontal_order_test
5132 degrade_xs = .true.
5133 ! recompute : degrade_xs
5134 degrade_xe = .true.
5135 ! recompute : degrade_xe
5136 degrade_ys = .true.
5137 ! recompute : degrade_ys
5138 degrade_ye = .true.
5139 ! recompute : degrade_ye
5140 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
5141 degrade_xs = .false.
5142 endif
5143 ! recompute : degrade_xs
5144 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
5145 degrade_xe = .false.
5146 endif
5147 ! recompute : degrade_xe
5148 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
5149 degrade_ys = .false.
5150 endif
5151 ! recompute : degrade_ys
5152 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-1) then
5153 degrade_ye = .false.
5154 endif
5155 ! recompute : degrade_ye
5156 ! recompute : ktf
5157 i_start = its
5158 ! recompute : i_start
5159 i_end = min(ite,ide-1)
5160 ! recompute : i_end
5161 j_start = jts
5162 ! recompute : j_start
5163 j_end = jte
5164 ! recompute : j_end
5165 if (config_flags%open_ys .or. specified) then
5166 j_start = max(jds+1,jts)
5167 endif
5168 ! recompute : j_start
5169 if (config_flags%open_ye .or. specified) then
5170 j_end = min(jde-1,jte)
5171 endif
5172 ! recompute : j_end
5173 i_start_f = i_start
5174 ! recompute : i_start_f
5175 i_end_f = i_end+1
5176 ! recompute : i_end_f
5177 if (degrade_xs) then
5178 i_start = ids+1
5179 i_start_f = i_start+1
5180 endif
5181 ! recompute : i_start,i_start_f
5182 if (degrade_xe) then
5183 i_end = ide-2
5184 i_end_f = ide-2
5185 endif
5186 ! recompute : i_end,i_end_f
5187 do j = j_start, j_end
5188 a_vel = 0.
5189 do k = kts, ktf
5190 do i = i_start, i_end
5191 mrdx = msfv(i,j)*rdx
5192 ! recompute : mrdx
5193 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
5194 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
5195 end do
5196 end do
5197 if (degrade_xe) then
5198 do k = kts, ktf
5199 a_ru(i_end+1,k,j-1) = a_ru(i_end+1,k,j-1)+0.25*a_fqx(i_end+1,k)*(v(i_end+1,k,j)+v(i_end,k,j))
5200 a_ru(i_end+1,k,j) = a_ru(i_end+1,k,j)+0.25*a_fqx(i_end+1,k)*(v(i_end+1,k,j)+v(i_end,k,j))
5201 a_v(i_end+1,k,j) = a_v(i_end+1,k,j)+0.25*a_fqx(i_end+1,k)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))
5202 a_v(i_end,k,j) = a_v(i_end,k,j)+0.25*a_fqx(i_end+1,k)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))
5203 a_fqx(i_end+1,k) = 0.
5204 end do
5205 endif
5206 if (degrade_xs) then
5207 do k = kts, ktf
5208 a_ru(i_start,k,j-1) = a_ru(i_start,k,j-1)+0.25*a_fqx(i_start,k)*(v(i_start,k,j)+v(i_start-1,k,j))
5209 a_ru(i_start,k,j) = a_ru(i_start,k,j)+0.25*a_fqx(i_start,k)*(v(i_start,k,j)+v(i_start-1,k,j))
5210 a_v(i_start-1,k,j) = a_v(i_start-1,k,j)+0.25*a_fqx(i_start,k)*(ru(i_start,k,j)+ru(i_start,k,j-1))
5211 a_v(i_start,k,j) = a_v(i_start,k,j)+0.25*a_fqx(i_start,k)*(ru(i_start,k,j)+ru(i_start,k,j-1))
5212 a_fqx(i_start,k) = 0.
5213 end do
5214 endif
5215 do k = kts, ktf
5216 a_vel = 0.
5217 do i = i_start_f, i_end_f
5218 a_vel = 0.
5219 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
5220 ! recompute : vel
5221 a_v(i-2,k,j) = a_v(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
5222 a_v(i-1,k,j) = a_v(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
5223 a_v(i+1,k,j) = a_v(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
5224 a_v(i,k,j) = a_v(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
5225 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(v(i,k,j)+v(i-1,k,j))-0.083333333*(v(i+1,k,j)+v(i-2,k,j))+0.083333333*(v(i+1,k,j)-v(i-&
5226 &2,k,j)-3.*(v(i,k,j)-v(i-1,k,j)))*sign(1.,vel))
5227 a_fqx(i,k) = 0.
5228 a_ru(i,k,j-1) = a_ru(i,k,j-1)+0.5*a_vel
5229 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_vel
5230 a_vel = 0.
5231 end do
5232 end do
5233 end do
5234 ! recdepend vars : its
5235 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2173
5236 ! recompute vars : i_start
5237 i_start = its
5238 ! recompute vars : i_start
5239 ! recdepend vars : i_start,ide,ite
5240 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2174
5241 ! recompute vars : i_end
5242 i_end = min(ite,ide-1)
5243 ! recompute vars : i_end
5244 ! recdepend vars : i_end,i_start,jts
5245 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2175
5246 ! recompute vars : j_start
5247 j_start = jts
5248 ! recompute vars : j_start
5249 ! recdepend vars : i_end,i_start,j_start,jte
5250 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2176
5251 ! recompute vars : j_end
5252 j_end = jte
5253 ! recompute vars : j_end
5254 ! recdepend vars : degrade_ys,i_end,i_start,j_end,j_start,jds
5255 ! recompute pos : IF_STMT module_advect_em.f90:2185
5256 ! recompute vars : j_start
5257 if (degrade_ys) then
5258 j_start = jds+1
5259 endif
5260 ! recompute vars : j_start
5261 ! recdepend vars : degrade_ye,i_end,i_start,j_end,j_start,jde
5262 ! recompute pos : IF_STMT module_advect_em.f90:2190
5263 ! recompute vars : j_end
5264 if (degrade_ye) then
5265 j_end = jde-1
5266 endif
5267 ! recompute vars : j_end
5268 do j = j_end+1, j_start, -1
5269 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2198
5270 ! recompute vars : jp0
5271 jp0 = 1
5272 ! recompute vars : jp0
5273 ! recdepend vars : jp0
5274 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2199
5275 ! recompute vars : jp1
5276 jp1 = 2
5277 ! recompute vars : jp1
5278 do j3 = j_start, j-1
5279 jtmp = jp1
5280 jp1 = jp0
5281 jp0 = jtmp
5282 end do
5283 if (j .gt. j_start) then
5284 do k = kts, ktf
5285 do i = i_start, i_end
5286 mrdy = msfv(i,j-1)*rdy
5287 ! recompute : mrdy
5288 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
5289 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
5290 end do
5291 end do
5292 endif
5293 if (j .eq. j_start .and. degrade_ys) then
5294 do k = kts, ktf
5295 a_vb = 0.
5296 do i = i_start, i_end
5297 a_vb = 0.
5298 vb = v(i,k,j-1)
5299 ! recompute : vb
5300 if (specified .and. v(i,k,j) .lt. 0.) then
5301 vb = v(i,k,j)
5302 endif
5303 ! recompute : vb
5304 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(v(i,k,j)+vb)
5305 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_fqy(i,k,jp1)*(v(i,k,j)+vb)
5306 a_v(i,k,j) = a_v(i,k,j)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
5307 a_vb = a_vb+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
5308 a_fqy(i,k,jp1) = 0.
5309 if (specified .and. v(i,k,j) .lt. 0.) then
5310 a_v(i,k,j) = a_v(i,k,j)+a_vb
5311 a_vb = 0.
5312 endif
5313 a_v(i,k,j-1) = a_v(i,k,j-1)+a_vb
5314 a_vb = 0.
5315 end do
5316 end do
5317 else if (j .eq. j_end+1 .and. degrade_ye) then
5318 do k = kts, ktf
5319 a_vb = 0.
5320 do i = i_start, i_end
5321 a_vb = 0.
5322 vb = v(i,k,j)
5323 ! recompute : vb
5324 if (specified .and. v(i,k,j-1) .gt. 0.) then
5325 vb = v(i,k,j-1)
5326 endif
5327 ! recompute : vb
5328 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(vb+v(i,k,j-1))
5329 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_fqy(i,k,jp1)*(vb+v(i,k,j-1))
5330 a_v(i,k,j-1) = a_v(i,k,j-1)+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
5331 a_vb = a_vb+0.25*a_fqy(i,k,jp1)*(rv(i,k,j)+rv(i,k,j-1))
5332 a_fqy(i,k,jp1) = 0.
5333 if (specified .and. v(i,k,j-1) .gt. 0.) then
5334 a_v(i,k,j-1) = a_v(i,k,j-1)+a_vb
5335 a_vb = 0.
5336 endif
5337 a_v(i,k,j) = a_v(i,k,j)+a_vb
5338 a_vb = 0.
5339 end do
5340 end do
5341 else
5342 do k = kts, ktf
5343 a_vel = 0.
5344 do i = i_start, i_end
5345 a_vel = 0.
5346 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
5347 ! recompute : vel
5348 a_v(i,k,j-2) = a_v(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
5349 a_v(i,k,j-1) = a_v(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
5350 a_v(i,k,j+1) = a_v(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
5351 a_v(i,k,j) = a_v(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
5352 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(v(i,k,j)+v(i,k,j-1))-0.083333333*(v(i,k,j+1)+v(i,k,j-2))+0.083333333*(v(i,k,j+&
5353 &1)-v(i,k,j-2)-3.*(v(i,k,j)-v(i,k,j-1)))*sign(1.,vel))
5354 a_fqy(i,k,jp1) = 0.
5355 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.5*a_vel
5356 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_vel
5357 a_vel = 0.
5358 end do
5359 end do
5360 endif
5361 end do
5362 else if (horz_order .eq. 2) then a_horizontal_order_test
5363 i_start = its
5364 ! recompute : i_start
5365 i_end = min(ite,ide-1)
5366 ! recompute : i_end
5367 j_start = jts
5368 ! recompute : j_start
5369 j_end = jte
5370 ! recompute : j_end
5371 if (config_flags%open_ys) then
5372 j_start = max(jds+1,jts)
5373 endif
5374 ! recompute : j_start
5375 if (config_flags%open_ye) then
5376 j_end = min(jde-1,jte)
5377 endif
5378 ! recompute : j_end
5379 if (specified) then
5380 j_start = max(jds+2,jts)
5381 endif
5382 ! recompute : j_start
5383 if (specified) then
5384 j_end = min(jde-2,jte)
5385 endif
5386 ! recompute : j_end
5387 if (config_flags%open_xs .or. specified) then
5388 i_start = max(ids+1,its)
5389 endif
5390 ! recompute : i_start
5391 if (config_flags%open_xe .or. specified) then
5392 i_end = min(ide-2,ite)
5393 endif
5394 ! recompute : i_end
5395 do j = j_start, j_end
5396 do k = kts, ktf
5397 do i = i_start, i_end
5398 mrdx = msfv(i,j)*rdx
5399 ! recompute : mrdx
5400 a_ru(i+1,k,j-1) = a_ru(i+1,k,j-1)-0.25*a_tendency(i,k,j)*mrdx*(v(i+1,k,j)+v(i,k,j))
5401 a_ru(i,k,j-1) = a_ru(i,k,j-1)+0.25*a_tendency(i,k,j)*mrdx*(v(i,k,j)+v(i-1,k,j))
5402 a_ru(i+1,k,j) = a_ru(i+1,k,j)-0.25*a_tendency(i,k,j)*mrdx*(v(i+1,k,j)+v(i,k,j))
5403 a_ru(i,k,j) = a_ru(i,k,j)+0.25*a_tendency(i,k,j)*mrdx*(v(i,k,j)+v(i-1,k,j))
5404 a_v(i-1,k,j) = a_v(i-1,k,j)+0.25*a_tendency(i,k,j)*mrdx*(ru(i,k,j)+ru(i,k,j-1))
5405 a_v(i+1,k,j) = a_v(i+1,k,j)-0.25*a_tendency(i,k,j)*mrdx*(ru(i+1,k,j)+ru(i+1,k,j-1))
5406 a_v(i,k,j) = a_v(i,k,j)-0.25*a_tendency(i,k,j)*mrdx*(ru(i+1,k,j)+ru(i+1,k,j-1)-(ru(i,k,j)+ru(i,k,j-1)))
5407 end do
5408 end do
5409 end do
5410 ! recdepend vars : its
5411 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2319
5412 ! recompute vars : i_start
5413 i_start = its
5414 ! recompute vars : i_start
5415 ! recdepend vars : i_start,ide,ite
5416 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2320
5417 ! recompute vars : i_end
5418 i_end = min(ite,ide-1)
5419 ! recompute vars : i_end
5420 if (specified .and. jte .ge. jde-1) then
5421 j = jde-1
5422 ! recompute : j
5423 do k = kts, ktf
5424 a_vb = 0.
5425 do i = i_start, i_end
5426 a_vb = 0.
5427 mrdy = msfv(i,j)*rdy
5428 ! recompute : mrdy
5429 vb = v(i,k,j+1)
5430 ! recompute : vb
5431 if (v(i,k,j) .gt. 0.) then
5432 vb = v(i,k,j)
5433 endif
5434 ! recompute : vb
5435 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.25*a_tendency(i,k,j)*mrdy*(v(i,k,j)+v(i,k,j-1))
5436 a_rv(i,k,j+1) = a_rv(i,k,j+1)-0.25*a_tendency(i,k,j)*mrdy*(vb+v(i,k,j))
5437 a_rv(i,k,j) = a_rv(i,k,j)-0.25*a_tendency(i,k,j)*mrdy*(vb+v(i,k,j)-(v(i,k,j)+v(i,k,j-1)))
5438 a_v(i,k,j-1) = a_v(i,k,j-1)+0.25*a_tendency(i,k,j)*mrdy*(rv(i,k,j)+rv(i,k,j-1))
5439 a_v(i,k,j) = a_v(i,k,j)-0.25*a_tendency(i,k,j)*mrdy*(rv(i,k,j+1)+rv(i,k,j)-(rv(i,k,j)+rv(i,k,j-1)))
5440 a_vb = a_vb-0.25*a_tendency(i,k,j)*mrdy*(rv(i,k,j+1)+rv(i,k,j))
5441 if (v(i,k,j) .gt. 0.) then
5442 a_v(i,k,j) = a_v(i,k,j)+a_vb
5443 a_vb = 0.
5444 endif
5445 a_v(i,k,j+1) = a_v(i,k,j+1)+a_vb
5446 a_vb = 0.
5447 end do
5448 end do
5449 endif
5450 ! recdepend vars : its
5451 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2319
5452 ! recompute vars : i_start
5453 i_start = its
5454 ! recompute vars : i_start
5455 ! recdepend vars : i_start,ide,ite
5456 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2320
5457 ! recompute vars : i_end
5458 i_end = min(ite,ide-1)
5459 ! recompute vars : i_end
5460 if (specified .and. jts .le. jds+1) then
5461 j = jds+1
5462 ! recompute : j
5463 do k = kts, ktf
5464 a_vb = 0.
5465 do i = i_start, i_end
5466 a_vb = 0.
5467 mrdy = msfv(i,j)*rdy
5468 ! recompute : mrdy
5469 vb = v(i,k,j-1)
5470 ! recompute : vb
5471 if (v(i,k,j) .lt. 0.) then
5472 vb = v(i,k,j)
5473 endif
5474 ! recompute : vb
5475 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.25*a_tendency(i,k,j)*mrdy*(v(i,k,j)+vb)
5476 a_rv(i,k,j+1) = a_rv(i,k,j+1)-0.25*a_tendency(i,k,j)*mrdy*(v(i,k,j+1)+v(i,k,j))
5477 a_rv(i,k,j) = a_rv(i,k,j)-0.25*a_tendency(i,k,j)*mrdy*(v(i,k,j+1)+v(i,k,j)-(v(i,k,j)+vb))
5478 a_v(i,k,j+1) = a_v(i,k,j+1)-0.25*a_tendency(i,k,j)*mrdy*(rv(i,k,j+1)+rv(i,k,j))
5479 a_v(i,k,j) = a_v(i,k,j)-0.25*a_tendency(i,k,j)*mrdy*(rv(i,k,j+1)+rv(i,k,j)-(rv(i,k,j)+rv(i,k,j-1)))
5480 a_vb = a_vb+0.25*a_tendency(i,k,j)*mrdy*(rv(i,k,j)+rv(i,k,j-1))
5481 if (v(i,k,j) .lt. 0.) then
5482 a_v(i,k,j) = a_v(i,k,j)+a_vb
5483 a_vb = 0.
5484 endif
5485 a_v(i,k,j-1) = a_v(i,k,j-1)+a_vb
5486 a_vb = 0.
5487 end do
5488 end do
5489 endif
5490 ! recdepend vars : its
5491 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2319
5492 ! recompute vars : i_start
5493 i_start = its
5494 ! recompute vars : i_start
5495 ! recdepend vars : i_start,ide,ite
5496 ! recompute pos : ASSIGN_STMT module_advect_em.f90:2320
5497 ! recompute vars : i_end
5498 i_end = min(ite,ide-1)
5499 ! recompute vars : i_end
5500 do j = j_start, j_end
5501 do k = kts, ktf
5502 do i = i_start, i_end
5503 mrdy = msfv(i,j)*rdy
5504 ! recompute : mrdy
5505 a_rv(i,k,j-1) = a_rv(i,k,j-1)+0.25*a_tendency(i,k,j)*mrdy*(v(i,k,j)+v(i,k,j-1))
5506 a_rv(i,k,j+1) = a_rv(i,k,j+1)-0.25*a_tendency(i,k,j)*mrdy*(v(i,k,j+1)+v(i,k,j))
5507 a_rv(i,k,j) = a_rv(i,k,j)-0.25*a_tendency(i,k,j)*mrdy*(v(i,k,j+1)+v(i,k,j)-(v(i,k,j)+v(i,k,j-1)))
5508 a_v(i,k,j-1) = a_v(i,k,j-1)+0.25*a_tendency(i,k,j)*mrdy*(rv(i,k,j)+rv(i,k,j-1))
5509 a_v(i,k,j+1) = a_v(i,k,j+1)-0.25*a_tendency(i,k,j)*mrdy*(rv(i,k,j+1)+rv(i,k,j))
5510 a_v(i,k,j) = a_v(i,k,j)-0.25*a_tendency(i,k,j)*mrdy*(rv(i,k,j+1)+rv(i,k,j)-(rv(i,k,j)+rv(i,k,j-1)))
5511 end do
5512 end do
5513 end do
5514 endif a_horizontal_order_test
5515
5516 end subroutine a_advect_v
5517
5518
5519 subroutine a_advect_w( w, a_w, w_old, a_w_old, a_tendency, ru, a_ru, rv, a_rv, rom, a_rom, config_flags, msft, fzm, fzp, rdx, rdy, &
5520 &rdzu, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
5521 !******************************************************************
5522 !******************************************************************
5523 !** This routine was generated by Automatic differentiation. **
5524 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
5525 !******************************************************************
5526 !******************************************************************
5527 !==============================================
5528 ! all entries are defined explicitly
5529 !==============================================
5530 implicit none
5531
5532 !==============================================
5533 ! declare arguments
5534 !==============================================
5535 integer, intent(in) :: ime
5536 integer, intent(in) :: ims
5537 integer, intent(in) :: jme
5538 integer, intent(in) :: jms
5539 integer, intent(in) :: kme
5540 integer, intent(in) :: kms
5541 real, intent(inout) :: a_rom(ims:ime,kms:kme,jms:jme)
5542 real, intent(inout) :: a_ru(ims:ime,kms:kme,jms:jme)
5543 real, intent(inout) :: a_rv(ims:ime,kms:kme,jms:jme)
5544 real, intent(inout) :: a_tendency(ims:ime,kms:kme,jms:jme)
5545 real, intent(inout) :: a_w(ims:ime,kms:kme,jms:jme)
5546 real, intent(inout) :: a_w_old(ims:ime,kms:kme,jms:jme)
5547 type (grid_config_rec_type), intent(in) :: config_flags
5548 real, intent(in) :: fzm(kms:kme)
5549 real, intent(in) :: fzp(kms:kme)
5550 integer, intent(in) :: ide
5551 integer, intent(in) :: ids
5552 integer, intent(in) :: ite
5553 integer, intent(in) :: its
5554 integer, intent(in) :: jde
5555 integer, intent(in) :: jds
5556 integer, intent(in) :: jte
5557 integer, intent(in) :: jts
5558 integer, intent(in) :: kde
5559 integer, intent(in) :: kte
5560 integer, intent(in) :: kts
5561 real, intent(in) :: msft(ims:ime,jms:jme)
5562 real, intent(in) :: rdx
5563 real, intent(in) :: rdy
5564 real, intent(in) :: rdzu(kms:kme)
5565 real, intent(in) :: rom(ims:ime,kms:kme,jms:jme)
5566 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
5567 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
5568 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
5569 real, intent(in) :: w_old(ims:ime,kms:kme,jms:jme)
5570
5571 !==============================================
5572 ! declare local variables
5573 !==============================================
5574 real a_fqx(its:ite+1,kts:kte)
5575 real a_fqy(its:ite,kts:kte,2)
5576 real a_ub
5577 real a_uw
5578 real a_vb
5579 real a_vel
5580 real a_vflux(its:ite,kts:kte)
5581 real a_vw
5582 logical degrade_xe
5583 logical degrade_xs
5584 logical degrade_ye
5585 logical degrade_ys
5586 integer horz_order
5587 integer i
5588 integer i_end
5589 integer i_end_f
5590 integer i_start
5591 integer i_start_f
5592 integer j
5593 integer j1
5594 integer j2
5595 integer j3
5596 integer j4
5597 integer j_end
5598 integer j_end_f
5599 integer j_start
5600 integer j_start_f
5601 integer jp0
5602 integer jp1
5603 integer jtmp
5604 integer k
5605 integer ktf
5606 real mrdx
5607 real mrdy
5608 logical specified
5609 real ub
5610 real uw
5611 real vb
5612 real vel
5613 integer vert_order
5614 real vw
5615
5616 !----------------------------------------------
5617 ! RESET LOCAL ADJOINT VARIABLES
5618 !----------------------------------------------
5619 a_fqx(:,:) = 0.
5620 a_fqy(:,:,:) = 0.
5621 a_ub = 0.
5622 a_uw = 0.
5623 a_vb = 0.
5624 a_vel = 0.
5625 a_vflux(:,:) = 0.
5626 a_vw = 0.
5627
5628 !----------------------------------------------
5629 ! ROUTINE BODY
5630 !----------------------------------------------
5631 specified = .false.
5632 ! recompute : specified
5633 if (config_flags%specified .or. config_flags%nested) then
5634 specified = .true.
5635 endif
5636 ! recompute : specified
5637 ktf = min(kte,kde-1)
5638 ! recompute : ktf
5639 horz_order = config_flags%h_sca_adv_order
5640 ! recompute : horz_order
5641 vert_order = config_flags%v_sca_adv_order
5642 ! recompute : vert_order
5643 horizontal_order_tesu: if (horz_order .eq. 6) then
5644 else if (horz_order .eq. 4) then horizontal_order_tesu
5645 ktf = min(kte,kde-1)
5646 else if (horz_order .eq. 3) then horizontal_order_tesu
5647 ktf = min(kte,kde-1)
5648 endif horizontal_order_tesu
5649 ! recompute : ktf
5650 i_start = its
5651 ! recompute : i_start
5652 i_end = min(ite,ide-1)
5653 ! recompute : i_end
5654 j_start = jts
5655 ! recompute : j_start
5656 j_end = min(jte,jde-1)
5657 ! recompute : j_end
5658 a_vert_order_test: if (vert_order .eq. 6) then
5659 do j = j_end, j_start, -1
5660 k = ktf+1
5661 ! recompute : k
5662 do i = i_start, i_end
5663 a_vflux(i,k) = a_vflux(i,k)+2*a_tendency(i,k,j)*rdzu(k-1)
5664 end do
5665 do k = kts+1, ktf
5666 do i = i_start, i_end
5667 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzu(k)
5668 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzu(k)
5669 end do
5670 end do
5671 do i = i_start, i_end
5672 a_vel = 0.
5673 k = ktf
5674 ! recompute : k
5675 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
5676 ! recompute : vel
5677 k = ktf+1
5678 ! recompute : k
5679 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5680 a_rom(i,k,j) = a_rom(i,k,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5681 a_w(i,k-1,j) = a_w(i,k-1,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5682 a_w(i,k,j) = a_w(i,k,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5683 a_vflux(i,k) = 0.
5684 ! recdepend vars : ktf
5685 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5204
5686 ! recompute vars : k
5687 k = ktf
5688 ! recompute vars : k
5689 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(w(i,k,j)+w(i,k-1,j))-0.083333333*(w(i,k+1,j)+w(i,k-2,j)))
5690 a_w(i,k-2,j) = a_w(i,k-2,j)-0.083333333*a_vflux(i,k)*vel
5691 a_w(i,k-1,j) = a_w(i,k-1,j)+0.58333333*a_vflux(i,k)*vel
5692 a_w(i,k+1,j) = a_w(i,k+1,j)-0.083333333*a_vflux(i,k)*vel
5693 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_vflux(i,k)*vel
5694 a_vflux(i,k) = 0.
5695 ! recdepend vars : ktf
5696 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5204
5697 ! recompute vars : k
5698 k = ktf
5699 ! recompute vars : k
5700 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.5*a_vel
5701 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
5702 a_vel = 0.
5703 ! recdepend vars : kts
5704 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5198
5705 ! recompute vars : k
5706 k = kts+2
5707 ! recompute vars : k
5708 ! recdepend vars : i,j,k,rom
5709 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5199
5710 ! recompute vars : vel
5711 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
5712 ! recompute vars : vel
5713 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(w(i,k,j)+w(i,k-1,j))-0.083333333*(w(i,k+1,j)+w(i,k-2,j)))
5714 a_w(i,k-2,j) = a_w(i,k-2,j)-0.083333333*a_vflux(i,k)*vel
5715 a_w(i,k-1,j) = a_w(i,k-1,j)+0.58333333*a_vflux(i,k)*vel
5716 a_w(i,k+1,j) = a_w(i,k+1,j)-0.083333333*a_vflux(i,k)*vel
5717 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_vflux(i,k)*vel
5718 a_vflux(i,k) = 0.
5719 ! recdepend vars : kts
5720 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5198
5721 ! recompute vars : k
5722 k = kts+2
5723 ! recompute vars : k
5724 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.5*a_vel
5725 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
5726 a_vel = 0.
5727 ! recdepend vars : kts
5728 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5195
5729 ! recompute vars : k
5730 k = kts+1
5731 ! recompute vars : k
5732 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5733 a_rom(i,k,j) = a_rom(i,k,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5734 a_w(i,k-1,j) = a_w(i,k-1,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5735 a_w(i,k,j) = a_w(i,k,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5736 a_vflux(i,k) = 0.
5737 end do
5738 do k = kts+3, ktf-1
5739 a_vel = 0.
5740 do i = i_start, i_end
5741 a_vel = 0.
5742 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
5743 ! recompute : vel
5744 a_vel = a_vel+a_vflux(i,k)*(0.61666667*(w(i,k,j)+w(i,k-1,j))-0.13333333*(w(i,k+1,j)+w(i,k-2,j))+0.016666667*(w(i,k+2,j)+&
5745 &w(i,k-3,j)))
5746 a_w(i,k-3,j) = a_w(i,k-3,j)+0.016666667*a_vflux(i,k)*vel
5747 a_w(i,k-2,j) = a_w(i,k-2,j)-0.13333333*a_vflux(i,k)*vel
5748 a_w(i,k-1,j) = a_w(i,k-1,j)+0.61666667*a_vflux(i,k)*vel
5749 a_w(i,k+2,j) = a_w(i,k+2,j)+0.016666667*a_vflux(i,k)*vel
5750 a_w(i,k+1,j) = a_w(i,k+1,j)-0.13333333*a_vflux(i,k)*vel
5751 a_w(i,k,j) = a_w(i,k,j)+0.61666667*a_vflux(i,k)*vel
5752 a_vflux(i,k) = 0.
5753 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.5*a_vel
5754 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
5755 a_vel = 0.
5756 end do
5757 end do
5758 end do
5759 else if (vert_order .eq. 5) then a_vert_order_test
5760 do j = j_end, j_start, -1
5761 k = ktf+1
5762 ! recompute : k
5763 do i = i_start, i_end
5764 a_vflux(i,k) = a_vflux(i,k)+2*a_tendency(i,k,j)*rdzu(k-1)
5765 end do
5766 do k = kts+1, ktf
5767 do i = i_start, i_end
5768 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzu(k)
5769 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzu(k)
5770 end do
5771 end do
5772 do i = i_start, i_end
5773 a_vel = 0.
5774 k = ktf
5775 ! recompute : k
5776 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
5777 ! recompute : vel
5778 k = ktf+1
5779 ! recompute : k
5780 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5781 a_rom(i,k,j) = a_rom(i,k,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5782 a_w(i,k-1,j) = a_w(i,k-1,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5783 a_w(i,k,j) = a_w(i,k,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5784 a_vflux(i,k) = 0.
5785 ! recdepend vars : ktf
5786 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5252
5787 ! recompute vars : k
5788 k = ktf
5789 ! recompute vars : k
5790 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(w(i,k,j)+w(i,k-1,j))-0.083333333*(w(i,k+1,j)+w(i,k-2,j))+0.083333333*(w(i,k+1,j)-w(i,&
5791 &k-2,j)-3.*(w(i,k,j)-w(i,k-1,j)))*sign(1.,-vel))
5792 a_w(i,k-2,j) = a_w(i,k-2,j)+a_vflux(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))
5793 a_w(i,k-1,j) = a_w(i,k-1,j)+a_vflux(i,k)*vel*(0.58333333+0.25*sign(1.,-vel))
5794 a_w(i,k+1,j) = a_w(i,k+1,j)+a_vflux(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))
5795 a_w(i,k,j) = a_w(i,k,j)+a_vflux(i,k)*vel*(0.58333333+(-0.25)*sign(1.,-vel))
5796 a_vflux(i,k) = 0.
5797 ! recdepend vars : ktf
5798 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5252
5799 ! recompute vars : k
5800 k = ktf
5801 ! recompute vars : k
5802 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.5*a_vel
5803 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
5804 a_vel = 0.
5805 ! recdepend vars : kts
5806 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5247
5807 ! recompute vars : k
5808 k = kts+2
5809 ! recompute vars : k
5810 ! recdepend vars : i,j,k,rom
5811 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5248
5812 ! recompute vars : vel
5813 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
5814 ! recompute vars : vel
5815 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(w(i,k,j)+w(i,k-1,j))-0.083333333*(w(i,k+1,j)+w(i,k-2,j))+0.083333333*(w(i,k+1,j)-w(i,&
5816 &k-2,j)-3.*(w(i,k,j)-w(i,k-1,j)))*sign(1.,-vel))
5817 a_w(i,k-2,j) = a_w(i,k-2,j)+a_vflux(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))
5818 a_w(i,k-1,j) = a_w(i,k-1,j)+a_vflux(i,k)*vel*(0.58333333+0.25*sign(1.,-vel))
5819 a_w(i,k+1,j) = a_w(i,k+1,j)+a_vflux(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))
5820 a_w(i,k,j) = a_w(i,k,j)+a_vflux(i,k)*vel*(0.58333333+(-0.25)*sign(1.,-vel))
5821 a_vflux(i,k) = 0.
5822 ! recdepend vars : kts
5823 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5247
5824 ! recompute vars : k
5825 k = kts+2
5826 ! recompute vars : k
5827 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.5*a_vel
5828 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
5829 a_vel = 0.
5830 ! recdepend vars : kts
5831 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5244
5832 ! recompute vars : k
5833 k = kts+1
5834 ! recompute vars : k
5835 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5836 a_rom(i,k,j) = a_rom(i,k,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5837 a_w(i,k-1,j) = a_w(i,k-1,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5838 a_w(i,k,j) = a_w(i,k,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5839 a_vflux(i,k) = 0.
5840 end do
5841 do k = kts+3, ktf-1
5842 a_vel = 0.
5843 do i = i_start, i_end
5844 a_vel = 0.
5845 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
5846 ! recompute : vel
5847 a_vel = a_vel+a_vflux(i,k)*(0.61666667*(w(i,k,j)+w(i,k-1,j))-0.13333333*(w(i,k+1,j)+w(i,k-2,j))+0.016666667*(w(i,k+2,j)+&
5848 &w(i,k-3,j))-0.016666667*(w(i,k+2,j)-w(i,k-3,j)-5.*(w(i,k+1,j)-w(i,k-2,j))+10.*(w(i,k,j)-w(i,k-1,j)))*sign(1.,-vel))
5849 a_w(i,k-3,j) = a_w(i,k-3,j)+a_vflux(i,k)*vel*(0.016666667-(-0.016666667)*sign(1.,-vel))
5850 a_w(i,k-2,j) = a_w(i,k-2,j)+a_vflux(i,k)*vel*((-0.13333333)-0.083333333*sign(1.,-vel))
5851 a_w(i,k-1,j) = a_w(i,k-1,j)+a_vflux(i,k)*vel*(0.61666667-(-0.16666667)*sign(1.,-vel))
5852 a_w(i,k+2,j) = a_w(i,k+2,j)+a_vflux(i,k)*vel*(0.016666667-0.016666667*sign(1.,-vel))
5853 a_w(i,k+1,j) = a_w(i,k+1,j)+a_vflux(i,k)*vel*((-0.13333333)-(-0.083333333)*sign(1.,-vel))
5854 a_w(i,k,j) = a_w(i,k,j)+a_vflux(i,k)*vel*(0.61666667-0.16666667*sign(1.,-vel))
5855 a_vflux(i,k) = 0.
5856 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.5*a_vel
5857 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
5858 a_vel = 0.
5859 end do
5860 end do
5861 end do
5862 else if (vert_order .eq. 4) then a_vert_order_test
5863 do j = j_end, j_start, -1
5864 k = ktf+1
5865 ! recompute : k
5866 do i = i_start, i_end
5867 a_vflux(i,k) = a_vflux(i,k)+2*a_tendency(i,k,j)*rdzu(k-1)
5868 end do
5869 do k = kts+1, ktf
5870 do i = i_start, i_end
5871 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzu(k)
5872 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzu(k)
5873 end do
5874 end do
5875 do i = i_start, i_end
5876 k = ktf+1
5877 ! recompute : k
5878 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5879 a_rom(i,k,j) = a_rom(i,k,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5880 a_w(i,k-1,j) = a_w(i,k-1,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5881 a_w(i,k,j) = a_w(i,k,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5882 a_vflux(i,k) = 0.
5883 ! recdepend vars : kts
5884 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5292
5885 ! recompute vars : k
5886 k = kts+1
5887 ! recompute vars : k
5888 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5889 a_rom(i,k,j) = a_rom(i,k,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5890 a_w(i,k-1,j) = a_w(i,k-1,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5891 a_w(i,k,j) = a_w(i,k,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5892 a_vflux(i,k) = 0.
5893 end do
5894 do k = kts+2, ktf
5895 a_vel = 0.
5896 do i = i_start, i_end
5897 a_vel = 0.
5898 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
5899 ! recompute : vel
5900 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(w(i,k,j)+w(i,k-1,j))-0.083333333*(w(i,k+1,j)+w(i,k-2,j)))
5901 a_w(i,k-2,j) = a_w(i,k-2,j)-0.083333333*a_vflux(i,k)*vel
5902 a_w(i,k-1,j) = a_w(i,k-1,j)+0.58333333*a_vflux(i,k)*vel
5903 a_w(i,k+1,j) = a_w(i,k+1,j)-0.083333333*a_vflux(i,k)*vel
5904 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_vflux(i,k)*vel
5905 a_vflux(i,k) = 0.
5906 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.5*a_vel
5907 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
5908 a_vel = 0.
5909 end do
5910 end do
5911 end do
5912 else if (vert_order .eq. 3) then a_vert_order_test
5913 do j = j_end, j_start, -1
5914 k = ktf+1
5915 ! recompute : k
5916 do i = i_start, i_end
5917 a_vflux(i,k) = a_vflux(i,k)+2*a_tendency(i,k,j)*rdzu(k-1)
5918 end do
5919 do k = kts+1, ktf
5920 do i = i_start, i_end
5921 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzu(k)
5922 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzu(k)
5923 end do
5924 end do
5925 do i = i_start, i_end
5926 k = ktf+1
5927 ! recompute : k
5928 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5929 a_rom(i,k,j) = a_rom(i,k,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5930 a_w(i,k-1,j) = a_w(i,k-1,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5931 a_w(i,k,j) = a_w(i,k,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5932 a_vflux(i,k) = 0.
5933 ! recdepend vars : kts
5934 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5328
5935 ! recompute vars : k
5936 k = kts+1
5937 ! recompute vars : k
5938 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5939 a_rom(i,k,j) = a_rom(i,k,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5940 a_w(i,k-1,j) = a_w(i,k-1,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5941 a_w(i,k,j) = a_w(i,k,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5942 a_vflux(i,k) = 0.
5943 end do
5944 do k = kts+2, ktf
5945 a_vel = 0.
5946 do i = i_start, i_end
5947 a_vel = 0.
5948 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
5949 ! recompute : vel
5950 a_vel = a_vel+a_vflux(i,k)*(0.58333333*(w(i,k,j)+w(i,k-1,j))-0.083333333*(w(i,k+1,j)+w(i,k-2,j))+0.083333333*(w(i,k+1,j)-&
5951 &w(i,k-2,j)-3.*(w(i,k,j)-w(i,k-1,j)))*sign(1.,-vel))
5952 a_w(i,k-2,j) = a_w(i,k-2,j)+a_vflux(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))
5953 a_w(i,k-1,j) = a_w(i,k-1,j)+a_vflux(i,k)*vel*(0.58333333+0.25*sign(1.,-vel))
5954 a_w(i,k+1,j) = a_w(i,k+1,j)+a_vflux(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))
5955 a_w(i,k,j) = a_w(i,k,j)+a_vflux(i,k)*vel*(0.58333333+(-0.25)*sign(1.,-vel))
5956 a_vflux(i,k) = 0.
5957 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.5*a_vel
5958 a_rom(i,k,j) = a_rom(i,k,j)+0.5*a_vel
5959 a_vel = 0.
5960 end do
5961 end do
5962 end do
5963 else if (vert_order .eq. 2) then a_vert_order_test
5964 do j = j_end, j_start, -1
5965 k = ktf+1
5966 ! recompute : k
5967 do i = i_start, i_end
5968 a_vflux(i,k) = a_vflux(i,k)+2*a_tendency(i,k,j)*rdzu(k-1)
5969 end do
5970 do k = kts+1, ktf
5971 do i = i_start, i_end
5972 a_vflux(i,k+1) = a_vflux(i,k+1)-a_tendency(i,k,j)*rdzu(k)
5973 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*rdzu(k)
5974 end do
5975 end do
5976 do k = kts+1, ktf+1
5977 do i = i_start, i_end
5978 a_rom(i,k-1,j) = a_rom(i,k-1,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5979 a_rom(i,k,j) = a_rom(i,k,j)+0.25*a_vflux(i,k)*(w(i,k,j)+w(i,k-1,j))
5980 a_w(i,k-1,j) = a_w(i,k-1,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5981 a_w(i,k,j) = a_w(i,k,j)+0.25*a_vflux(i,k)*(rom(i,k,j)+rom(i,k-1,j))
5982 a_vflux(i,k) = 0.
5983 end do
5984 end do
5985 end do
5986 endif a_vert_order_test
5987 ! recdepend vars : its
5988 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5015
5989 ! recompute vars : i_start
5990 i_start = its
5991 ! recompute vars : i_start
5992 ! recdepend vars : i_start,ide,ite
5993 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5016
5994 ! recompute vars : i_end
5995 i_end = min(ite,ide-1)
5996 ! recompute vars : i_end
5997 ! recdepend vars : i_end,i_start,jde,jte
5998 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5018
5999 ! recompute vars : j_end
6000 j_end = min(jte,jde-1)
6001 ! recompute vars : j_end
6002 if (config_flags%open_ye .and. jte .eq. jde) then
6003 k = ktf+1
6004 ! recompute : k
6005 do i = i_start, i_end
6006 a_vb = 0.
6007 a_vw = 0.
6008 vw = 0.5*((2.-fzm(k-1))*(rv(i,k-1,jte-1)+rv(i,k-1,jte))-fzp(k-1)*(rv(i,k-2,jte-1)+rv(i,k-2,jte)))
6009 ! recompute : vw
6010 vb = max(vw,0.)
6011 ! recompute : vb
6012 a_rv(i,k-2,jte-1) = a_rv(i,k-2,jte-1)-a_tendency(i,k,j_end)*rdy*w(i,k,j_end)*fzp(k-1)
6013 a_rv(i,k-2,jte) = a_rv(i,k-2,jte)+a_tendency(i,k,j_end)*rdy*w(i,k,j_end)*fzp(k-1)
6014 a_rv(i,k-1,jte-1) = a_rv(i,k-1,jte-1)+a_tendency(i,k,j_end)*rdy*w(i,k,j_end)*(2.-fzm(k-1))
6015 a_rv(i,k-1,jte) = a_rv(i,k-1,jte)-a_tendency(i,k,j_end)*rdy*w(i,k,j_end)*(2-fzm(k-1))
6016 a_vb = a_vb-a_tendency(i,k,j_end)*rdy*(w_old(i,k,j_end)-w_old(i,k,j_end-1))
6017 a_w(i,k,j_end) = a_w(i,k,j_end)-a_tendency(i,k,j_end)*rdy*((2.-fzm(k-1))*(rv(i,k-1,jte)-rv(i,k-1,jte-1))-fzp(k-1)*(rv(i,k-2,&
6018 &jte)-rv(i,k-2,jte-1)))
6019 a_w_old(i,k,j_end-1) = a_w_old(i,k,j_end-1)+a_tendency(i,k,j_end)*rdy*vb
6020 a_w_old(i,k,j_end) = a_w_old(i,k,j_end)-a_tendency(i,k,j_end)*rdy*vb
6021 a_vw = a_vw+a_vb*(0.5+sign(0.5,vw-0.))
6022 a_vb = 0.
6023 a_rv(i,k-2,jte-1) = a_rv(i,k-2,jte-1)-0.5*a_vw*fzp(k-1)
6024 a_rv(i,k-2,jte) = a_rv(i,k-2,jte)-0.5*a_vw*fzp(k-1)
6025 a_rv(i,k-1,jte-1) = a_rv(i,k-1,jte-1)+0.5*a_vw*(2-fzm(k-1))
6026 a_rv(i,k-1,jte) = a_rv(i,k-1,jte)+0.5*a_vw*(2-fzm(k-1))
6027 a_vw = 0.
6028 end do
6029 do i = i_start, i_end
6030 a_vb = 0.
6031 a_vw = 0.
6032 do k = kts+1, ktf
6033 a_vb = 0.
6034 a_vw = 0.
6035 vw = 0.5*(fzm(k)*(rv(i,k,jte-1)+rv(i,k,jte))+fzp(k)*(rv(i,k-1,jte-1)+rv(i,k-1,jte)))
6036 ! recompute : vw
6037 vb = max(vw,0.)
6038 ! recompute : vb
6039 a_rv(i,k-1,jte-1) = a_rv(i,k-1,jte-1)+a_tendency(i,k,j_end)*rdy*w(i,k,j_end)*fzp(k)
6040 a_rv(i,k-1,jte) = a_rv(i,k-1,jte)-a_tendency(i,k,j_end)*rdy*w(i,k,j_end)*fzp(k)
6041 a_rv(i,k,jte-1) = a_rv(i,k,jte-1)+a_tendency(i,k,j_end)*rdy*w(i,k,j_end)*fzm(k)
6042 a_rv(i,k,jte) = a_rv(i,k,jte)-a_tendency(i,k,j_end)*rdy*w(i,k,j_end)*fzm(k)
6043 a_vb = a_vb-a_tendency(i,k,j_end)*rdy*(w_old(i,k,j_end)-w_old(i,k,j_end-1))
6044 a_w(i,k,j_end) = a_w(i,k,j_end)-a_tendency(i,k,j_end)*rdy*(fzm(k)*(rv(i,k,jte)-rv(i,k,jte-1))+fzp(k)*(rv(i,k-1,jte)-rv(i,k-1,&
6045 &jte-1)))
6046 a_w_old(i,k,j_end-1) = a_w_old(i,k,j_end-1)+a_tendency(i,k,j_end)*rdy*vb
6047 a_w_old(i,k,j_end) = a_w_old(i,k,j_end)-a_tendency(i,k,j_end)*rdy*vb
6048 a_vw = a_vw+a_vb*(0.5+sign(0.5,vw-0.))
6049 a_vb = 0.
6050 a_rv(i,k-1,jte-1) = a_rv(i,k-1,jte-1)+0.5*a_vw*fzp(k)
6051 a_rv(i,k-1,jte) = a_rv(i,k-1,jte)+0.5*a_vw*fzp(k)
6052 a_rv(i,k,jte-1) = a_rv(i,k,jte-1)+0.5*a_vw*fzm(k)
6053 a_rv(i,k,jte) = a_rv(i,k,jte)+0.5*a_vw*fzm(k)
6054 a_vw = 0.
6055 end do
6056 end do
6057 endif
6058 ! recdepend vars : its
6059 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5015
6060 ! recompute vars : i_start
6061 i_start = its
6062 ! recompute vars : i_start
6063 ! recdepend vars : i_start,ide,ite
6064 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5016
6065 ! recompute vars : i_end
6066 i_end = min(ite,ide-1)
6067 ! recompute vars : i_end
6068 if (config_flags%open_ys .and. jts .eq. jds) then
6069 k = ktf+1
6070 ! recompute : k
6071 do i = i_start, i_end
6072 a_vb = 0.
6073 a_vw = 0.
6074 vw = 0.5*((2.-fzm(k-1))*(rv(i,k-1,jts)+rv(i,k-1,jts+1))-fzp(k-1)*(rv(i,k-2,jts)+rv(i,k-2,jts+1)))
6075 ! recompute : vw
6076 vb = min(vw,0.)
6077 ! recompute : vb
6078 a_rv(i,k-2,jts+1) = a_rv(i,k-2,jts+1)+a_tendency(i,k,jts)*rdy*w(i,k,jts)*fzp(k-1)
6079 a_rv(i,k-2,jts) = a_rv(i,k-2,jts)-a_tendency(i,k,jts)*rdy*w(i,k,jts)*fzp(k-1)
6080 a_rv(i,k-1,jts+1) = a_rv(i,k-1,jts+1)-a_tendency(i,k,jts)*rdy*w(i,k,jts)*(2-fzm(k-1))
6081 a_rv(i,k-1,jts) = a_rv(i,k-1,jts)+a_tendency(i,k,jts)*rdy*w(i,k,jts)*(2.-fzm(k-1))
6082 a_vb = a_vb-a_tendency(i,k,jts)*rdy*(w_old(i,k,jts+1)-w_old(i,k,jts))
6083 a_w(i,k,jts) = a_w(i,k,jts)-a_tendency(i,k,jts)*rdy*((2.-fzm(k-1))*(rv(i,k-1,jts+1)-rv(i,k-1,jts))-fzp(k-1)*(rv(i,k-2,jts+1)-&
6084 &rv(i,k-2,jts)))
6085 a_w_old(i,k,jts+1) = a_w_old(i,k,jts+1)-a_tendency(i,k,jts)*rdy*vb
6086 a_w_old(i,k,jts) = a_w_old(i,k,jts)+a_tendency(i,k,jts)*rdy*vb
6087 a_vw = a_vw+a_vb*(0.5+sign(0.5,0.-vw))
6088 a_vb = 0.
6089 a_rv(i,k-2,jts+1) = a_rv(i,k-2,jts+1)-0.5*a_vw*fzp(k-1)
6090 a_rv(i,k-2,jts) = a_rv(i,k-2,jts)-0.5*a_vw*fzp(k-1)
6091 a_rv(i,k-1,jts+1) = a_rv(i,k-1,jts+1)+0.5*a_vw*(2-fzm(k-1))
6092 a_rv(i,k-1,jts) = a_rv(i,k-1,jts)+0.5*a_vw*(2-fzm(k-1))
6093 a_vw = 0.
6094 end do
6095 do i = i_start, i_end
6096 a_vb = 0.
6097 a_vw = 0.
6098 do k = kts+1, ktf
6099 a_vb = 0.
6100 a_vw = 0.
6101 vw = 0.5*(fzm(k)*(rv(i,k,jts)+rv(i,k,jts+1))+fzp(k)*(rv(i,k-1,jts)+rv(i,k-1,jts+1)))
6102 ! recompute : vw
6103 vb = min(vw,0.)
6104 ! recompute : vb
6105 a_rv(i,k-1,jts+1) = a_rv(i,k-1,jts+1)-a_tendency(i,k,jts)*rdy*w(i,k,jts)*fzp(k)
6106 a_rv(i,k-1,jts) = a_rv(i,k-1,jts)+a_tendency(i,k,jts)*rdy*w(i,k,jts)*fzp(k)
6107 a_rv(i,k,jts+1) = a_rv(i,k,jts+1)-a_tendency(i,k,jts)*rdy*w(i,k,jts)*fzm(k)
6108 a_rv(i,k,jts) = a_rv(i,k,jts)+a_tendency(i,k,jts)*rdy*w(i,k,jts)*fzm(k)
6109 a_vb = a_vb-a_tendency(i,k,jts)*rdy*(w_old(i,k,jts+1)-w_old(i,k,jts))
6110 a_w(i,k,jts) = a_w(i,k,jts)-a_tendency(i,k,jts)*rdy*(fzm(k)*(rv(i,k,jts+1)-rv(i,k,jts))+fzp(k)*(rv(i,k-1,jts+1)-rv(i,k-1,jts)&
6111 &))
6112 a_w_old(i,k,jts+1) = a_w_old(i,k,jts+1)-a_tendency(i,k,jts)*rdy*vb
6113 a_w_old(i,k,jts) = a_w_old(i,k,jts)+a_tendency(i,k,jts)*rdy*vb
6114 a_vw = a_vw+a_vb*(0.5+sign(0.5,0.-vw))
6115 a_vb = 0.
6116 a_rv(i,k-1,jts+1) = a_rv(i,k-1,jts+1)+0.5*a_vw*fzp(k)
6117 a_rv(i,k-1,jts) = a_rv(i,k-1,jts)+0.5*a_vw*fzp(k)
6118 a_rv(i,k,jts+1) = a_rv(i,k,jts+1)+0.5*a_vw*fzm(k)
6119 a_rv(i,k,jts) = a_rv(i,k,jts)+0.5*a_vw*fzm(k)
6120 a_vw = 0.
6121 end do
6122 end do
6123 endif
6124 ! recdepend vars : ide,ite
6125 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5016
6126 ! recompute vars : i_end
6127 i_end = min(ite,ide-1)
6128 ! recompute vars : i_end
6129 ! recdepend vars : i_end,jts
6130 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5017
6131 ! recompute vars : j_start
6132 j_start = jts
6133 ! recompute vars : j_start
6134 ! recdepend vars : i_end,j_start,jde,jte
6135 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5018
6136 ! recompute vars : j_end
6137 j_end = min(jte,jde-1)
6138 ! recompute vars : j_end
6139 if (config_flags%open_xe .and. ite .eq. ide) then
6140 k = ktf+1
6141 ! recompute : k
6142 do j = j_start, j_end
6143 a_ub = 0.
6144 a_uw = 0.
6145 uw = 0.5*((2.-fzm(k-1))*(ru(ite-1,k-1,j)+ru(ite,k-1,j))-fzp(k-1)*(ru(ite-1,k-2,j)+ru(ite,k-2,j)))
6146 ! recompute : uw
6147 ub = max(uw,0.)
6148 ! recompute : ub
6149 a_ru(ite-1,k-2,j) = a_ru(ite-1,k-2,j)-a_tendency(i_end,k,j)*rdx*w(i_end,k,j)*fzp(k-1)
6150 a_ru(ite,k-2,j) = a_ru(ite,k-2,j)+a_tendency(i_end,k,j)*rdx*w(i_end,k,j)*fzp(k-1)
6151 a_ru(ite-1,k-1,j) = a_ru(ite-1,k-1,j)+a_tendency(i_end,k,j)*rdx*w(i_end,k,j)*(2.-fzm(k-1))
6152 a_ru(ite,k-1,j) = a_ru(ite,k-1,j)-a_tendency(i_end,k,j)*rdx*w(i_end,k,j)*(2-fzm(k-1))
6153 a_ub = a_ub-a_tendency(i_end,k,j)*rdx*(w_old(i_end,k,j)-w_old(i_end-1,k,j))
6154 a_w(i_end,k,j) = a_w(i_end,k,j)-a_tendency(i_end,k,j)*rdx*((2.-fzm(k-1))*(ru(ite,k-1,j)-ru(ite-1,k-1,j))-fzp(k-1)*(ru(ite,k-2,&
6155 &j)-ru(ite-1,k-2,j)))
6156 a_w_old(i_end-1,k,j) = a_w_old(i_end-1,k,j)+a_tendency(i_end,k,j)*rdx*ub
6157 a_w_old(i_end,k,j) = a_w_old(i_end,k,j)-a_tendency(i_end,k,j)*rdx*ub
6158 a_uw = a_uw+a_ub*(0.5+sign(0.5,uw-0.))
6159 a_ub = 0.
6160 a_ru(ite-1,k-2,j) = a_ru(ite-1,k-2,j)-0.5*a_uw*fzp(k-1)
6161 a_ru(ite,k-2,j) = a_ru(ite,k-2,j)-0.5*a_uw*fzp(k-1)
6162 a_ru(ite-1,k-1,j) = a_ru(ite-1,k-1,j)+0.5*a_uw*(2-fzm(k-1))
6163 a_ru(ite,k-1,j) = a_ru(ite,k-1,j)+0.5*a_uw*(2-fzm(k-1))
6164 a_uw = 0.
6165 end do
6166 do j = j_start, j_end
6167 a_ub = 0.
6168 a_uw = 0.
6169 do k = kts+1, ktf
6170 a_ub = 0.
6171 a_uw = 0.
6172 uw = 0.5*(fzm(k)*(ru(ite-1,k,j)+ru(ite,k,j))+fzp(k)*(ru(ite-1,k-1,j)+ru(ite,k-1,j)))
6173 ! recompute : uw
6174 ub = max(uw,0.)
6175 ! recompute : ub
6176 a_ru(ite-1,k-1,j) = a_ru(ite-1,k-1,j)+a_tendency(i_end,k,j)*rdx*w(i_end,k,j)*fzp(k)
6177 a_ru(ite,k-1,j) = a_ru(ite,k-1,j)-a_tendency(i_end,k,j)*rdx*w(i_end,k,j)*fzp(k)
6178 a_ru(ite-1,k,j) = a_ru(ite-1,k,j)+a_tendency(i_end,k,j)*rdx*w(i_end,k,j)*fzm(k)
6179 a_ru(ite,k,j) = a_ru(ite,k,j)-a_tendency(i_end,k,j)*rdx*w(i_end,k,j)*fzm(k)
6180 a_ub = a_ub-a_tendency(i_end,k,j)*rdx*(w_old(i_end,k,j)-w_old(i_end-1,k,j))
6181 a_w(i_end,k,j) = a_w(i_end,k,j)-a_tendency(i_end,k,j)*rdx*(fzm(k)*(ru(ite,k,j)-ru(ite-1,k,j))+fzp(k)*(ru(ite,k-1,j)-ru(ite-1,&
6182 &k-1,j)))
6183 a_w_old(i_end-1,k,j) = a_w_old(i_end-1,k,j)+a_tendency(i_end,k,j)*rdx*ub
6184 a_w_old(i_end,k,j) = a_w_old(i_end,k,j)-a_tendency(i_end,k,j)*rdx*ub
6185 a_uw = a_uw+a_ub*(0.5+sign(0.5,uw-0.))
6186 a_ub = 0.
6187 a_ru(ite-1,k-1,j) = a_ru(ite-1,k-1,j)+0.5*a_uw*fzp(k)
6188 a_ru(ite,k-1,j) = a_ru(ite,k-1,j)+0.5*a_uw*fzp(k)
6189 a_ru(ite-1,k,j) = a_ru(ite-1,k,j)+0.5*a_uw*fzm(k)
6190 a_ru(ite,k,j) = a_ru(ite,k,j)+0.5*a_uw*fzm(k)
6191 a_uw = 0.
6192 end do
6193 end do
6194 endif
6195 ! recdepend vars : jts
6196 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5017
6197 ! recompute vars : j_start
6198 j_start = jts
6199 ! recompute vars : j_start
6200 ! recdepend vars : j_start,jde,jte
6201 ! recompute pos : ASSIGN_STMT module_advect_em.f90:5018
6202 ! recompute vars : j_end
6203 j_end = min(jte,jde-1)
6204 ! recompute vars : j_end
6205 if (config_flags%open_xs .and. its .eq. ids) then
6206 k = ktf+1
6207 ! recompute : k
6208 do j = j_start, j_end
6209 a_ub = 0.
6210 a_uw = 0.
6211 uw = 0.5*((2.-fzm(k-1))*(ru(its,k-1,j)+ru(its+1,k-1,j))-fzp(k-1)*(ru(its,k-2,j)+ru(its+1,k-2,j)))
6212 ! recompute : uw
6213 ub = min(uw,0.)
6214 ! recompute : ub
6215 a_ru(its+1,k-2,j) = a_ru(its+1,k-2,j)+a_tendency(its,k,j)*rdx*w(its,k,j)*fzp(k-1)
6216 a_ru(its,k-2,j) = a_ru(its,k-2,j)-a_tendency(its,k,j)*rdx*w(its,k,j)*fzp(k-1)
6217 a_ru(its+1,k-1,j) = a_ru(its+1,k-1,j)-a_tendency(its,k,j)*rdx*w(its,k,j)*(2-fzm(k-1))
6218 a_ru(its,k-1,j) = a_ru(its,k-1,j)+a_tendency(its,k,j)*rdx*w(its,k,j)*(2.-fzm(k-1))
6219 a_ub = a_ub-a_tendency(its,k,j)*rdx*(w_old(its+1,k,j)-w_old(its,k,j))
6220 a_w(its,k,j) = a_w(its,k,j)-a_tendency(its,k,j)*rdx*((2.-fzm(k-1))*(ru(its+1,k-1,j)-ru(its,k-1,j))-fzp(k-1)*(ru(its+1,k-2,j)-&
6221 &ru(its,k-2,j)))
6222 a_w_old(its+1,k,j) = a_w_old(its+1,k,j)-a_tendency(its,k,j)*rdx*ub
6223 a_w_old(its,k,j) = a_w_old(its,k,j)+a_tendency(its,k,j)*rdx*ub
6224 a_uw = a_uw+a_ub*(0.5+sign(0.5,0.-uw))
6225 a_ub = 0.
6226 a_ru(its+1,k-2,j) = a_ru(its+1,k-2,j)-0.5*a_uw*fzp(k-1)
6227 a_ru(its,k-2,j) = a_ru(its,k-2,j)-0.5*a_uw*fzp(k-1)
6228 a_ru(its+1,k-1,j) = a_ru(its+1,k-1,j)+0.5*a_uw*(2-fzm(k-1))
6229 a_ru(its,k-1,j) = a_ru(its,k-1,j)+0.5*a_uw*(2-fzm(k-1))
6230 a_uw = 0.
6231 end do
6232 do j = j_start, j_end
6233 a_ub = 0.
6234 a_uw = 0.
6235 do k = kts+1, ktf
6236 a_ub = 0.
6237 a_uw = 0.
6238 uw = 0.5*(fzm(k)*(ru(its,k,j)+ru(its+1,k,j))+fzp(k)*(ru(its,k-1,j)+ru(its+1,k-1,j)))
6239 ! recompute : uw
6240 ub = min(uw,0.)
6241 ! recompute : ub
6242 a_ru(its+1,k-1,j) = a_ru(its+1,k-1,j)-a_tendency(its,k,j)*rdx*w(its,k,j)*fzp(k)
6243 a_ru(its,k-1,j) = a_ru(its,k-1,j)+a_tendency(its,k,j)*rdx*w(its,k,j)*fzp(k)
6244 a_ru(its+1,k,j) = a_ru(its+1,k,j)-a_tendency(its,k,j)*rdx*w(its,k,j)*fzm(k)
6245 a_ru(its,k,j) = a_ru(its,k,j)+a_tendency(its,k,j)*rdx*w(its,k,j)*fzm(k)
6246 a_ub = a_ub-a_tendency(its,k,j)*rdx*(w_old(its+1,k,j)-w_old(its,k,j))
6247 a_w(its,k,j) = a_w(its,k,j)-a_tendency(its,k,j)*rdx*(fzm(k)*(ru(its+1,k,j)-ru(its,k,j))+fzp(k)*(ru(its+1,k-1,j)-ru(its,k-1,j)&
6248 &))
6249 a_w_old(its+1,k,j) = a_w_old(its+1,k,j)-a_tendency(its,k,j)*rdx*ub
6250 a_w_old(its,k,j) = a_w_old(its,k,j)+a_tendency(its,k,j)*rdx*ub
6251 a_uw = a_uw+a_ub*(0.5+sign(0.5,0.-uw))
6252 a_ub = 0.
6253 a_ru(its+1,k-1,j) = a_ru(its+1,k-1,j)+0.5*a_uw*fzp(k)
6254 a_ru(its,k-1,j) = a_ru(its,k-1,j)+0.5*a_uw*fzp(k)
6255 a_ru(its+1,k,j) = a_ru(its+1,k,j)+0.5*a_uw*fzm(k)
6256 a_ru(its,k,j) = a_ru(its,k,j)+0.5*a_uw*fzm(k)
6257 a_uw = 0.
6258 end do
6259 end do
6260 endif
6261 ! recdepend vars : kde,kte
6262 ! recompute pos : ASSIGN_STMT module_advect_em.f90:3963
6263 ! recompute vars : ktf
6264 ktf = min(kte,kde-1)
6265 ! recompute vars : ktf
6266 a_horizontal_order_test: if (horz_order .eq. 6) then
6267 degrade_xs = .true.
6268 ! recompute : degrade_xs
6269 degrade_xe = .true.
6270 ! recompute : degrade_xe
6271 degrade_ys = .true.
6272 ! recompute : degrade_ys
6273 degrade_ye = .true.
6274 ! recompute : degrade_ye
6275 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
6276 degrade_xs = .false.
6277 endif
6278 ! recompute : degrade_xs
6279 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-3) then
6280 degrade_xe = .false.
6281 endif
6282 ! recompute : degrade_xe
6283 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
6284 degrade_ys = .false.
6285 endif
6286 ! recompute : degrade_ys
6287 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-3) then
6288 degrade_ye = .false.
6289 endif
6290 ! recompute : degrade_ye
6291 j_start = jts
6292 ! recompute : j_start
6293 j_end = min(jte,jde-1)
6294 ! recompute : j_end
6295 j_start_f = j_start
6296 ! recompute : j_start_f
6297 j_end_f = j_end+1
6298 ! recompute : j_end_f
6299 if (degrade_ys) then
6300 j_start_f = jds+3
6301 endif
6302 ! recompute : j_start_f
6303 if (degrade_ye) then
6304 j_end_f = jde-3
6305 endif
6306 ! recompute : j_end_f
6307 i_start = its
6308 ! recompute : i_start
6309 i_end = min(ite,ide-1)
6310 ! recompute : i_end
6311 j_start = jts
6312 ! recompute : j_start
6313 j_end = min(jte,jde-1)
6314 ! recompute : j_end
6315 i_start_f = i_start
6316 ! recompute : i_start_f
6317 i_end_f = i_end+1
6318 ! recompute : i_end_f
6319 if (degrade_xs) then
6320 i_start = max(ids+1,its)
6321 i_start_f = i_start+2
6322 endif
6323 ! recompute : i_start,i_start_f
6324 if (degrade_xe) then
6325 i_end = min(ide-2,ite)
6326 i_end_f = ide-3
6327 endif
6328 ! recompute : i_end,i_end_f
6329 do j = j_end, j_start, -1
6330 do k = kts+1, ktf+1
6331 do i = i_start, i_end
6332 mrdx = msft(i,j)*rdx
6333 ! recompute : mrdx
6334 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
6335 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
6336 end do
6337 end do
6338 if (degrade_xe) then
6339 i = ide-2
6340 ! recompute : i
6341 k = ktf+1
6342 ! recompute : k
6343 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
6344 ! recompute : vel
6345 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(w(i,k,j)+w(i-1,k,j))-0.083333333*(w(i+1,k,j)+w(i-2,k,j)))
6346 a_w(i-2,k,j) = a_w(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
6347 a_w(i-1,k,j) = a_w(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
6348 a_w(i+1,k,j) = a_w(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
6349 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_fqx(i,k)*vel
6350 a_fqx(i,k) = 0.
6351 a_ru(i,k-2,j) = a_ru(i,k-2,j)-a_vel*fzp(k-1)
6352 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*(2-fzm(k-1))
6353 a_vel = 0.
6354 do k = kts+1, ktf
6355 a_vel = 0.
6356 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
6357 ! recompute : vel
6358 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(w(i,k,j)+w(i-1,k,j))-0.083333333*(w(i+1,k,j)+w(i-2,k,j)))
6359 a_w(i-2,k,j) = a_w(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
6360 a_w(i-1,k,j) = a_w(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
6361 a_w(i+1,k,j) = a_w(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
6362 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_fqx(i,k)*vel
6363 a_fqx(i,k) = 0.
6364 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*fzp(k)
6365 a_ru(i,k,j) = a_ru(i,k,j)+a_vel*fzm(k)
6366 a_vel = 0.
6367 end do
6368 if (i_end .eq. ide-2) then
6369 i = ide-1
6370 ! recompute : i
6371 k = ktf+1
6372 ! recompute : k
6373 a_ru(i,k-2,j) = a_ru(i,k-2,j)-0.5*a_fqx(i,k)*fzp(k-1)*(w(i,k,j)+w(i-1,k,j))
6374 a_ru(i,k-1,j) = a_ru(i,k-1,j)+0.5*a_fqx(i,k)*(2-fzm(k-1))*(w(i,k,j)+w(i-1,k,j))
6375 a_w(i-1,k,j) = a_w(i-1,k,j)+0.5*a_fqx(i,k)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))
6376 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqx(i,k)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))
6377 a_fqx(i,k) = 0.
6378 do k = kts+1, ktf
6379 a_ru(i,k-1,j) = a_ru(i,k-1,j)+0.5*a_fqx(i,k)*fzp(k)*(w(i,k,j)+w(i-1,k,j))
6380 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_fqx(i,k)*fzm(k)*(w(i,k,j)+w(i-1,k,j))
6381 a_w(i-1,k,j) = a_w(i-1,k,j)+0.5*a_fqx(i,k)*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))
6382 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqx(i,k)*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))
6383 a_fqx(i,k) = 0.
6384 end do
6385 endif
6386 endif
6387 if (degrade_xs) then
6388 do k = kts+1, ktf
6389 i = i_start+1
6390 end do
6391 ! recompute : i
6392 k = ktf+1
6393 ! recompute : k
6394 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
6395 ! recompute : vel
6396 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(w(i,k,j)+w(i-1,k,j))-0.083333333*(w(i+1,k,j)+w(i-2,k,j)))
6397 a_w(i-2,k,j) = a_w(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
6398 a_w(i-1,k,j) = a_w(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
6399 a_w(i+1,k,j) = a_w(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
6400 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_fqx(i,k)*vel
6401 a_fqx(i,k) = 0.
6402 a_ru(i,k-2,j) = a_ru(i,k-2,j)-a_vel*fzp(k-1)
6403 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*(2-fzm(k-1))
6404 a_vel = 0.
6405 k = ktf
6406 i = i_start+1
6407 ! recompute : i
6408 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
6409 ! recompute : vel
6410 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(w(i,k,j)+w(i-1,k,j))-0.083333333*(w(i+1,k,j)+w(i-2,k,j)))
6411 a_w(i-2,k,j) = a_w(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
6412 a_w(i-1,k,j) = a_w(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
6413 a_w(i+1,k,j) = a_w(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
6414 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_fqx(i,k)*vel
6415 a_fqx(i,k) = 0.
6416 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*fzp(k)
6417 a_ru(i,k,j) = a_ru(i,k,j)+a_vel*fzm(k)
6418 a_vel = 0.
6419 do k = kts+1, ktf-1
6420 a_vel = 0.
6421 i = i_start+1
6422 ! recompute : i
6423 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
6424 ! recompute : vel
6425 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(w(i,k,j)+w(i-1,k,j))-0.083333333*(w(i+1,k,j)+w(i-2,k,j)))
6426 a_w(i-2,k,j) = a_w(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
6427 a_w(i-1,k,j) = a_w(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
6428 a_w(i+1,k,j) = a_w(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
6429 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_fqx(i,k)*vel
6430 a_fqx(i,k) = 0.
6431 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*fzp(k)
6432 a_ru(i,k,j) = a_ru(i,k,j)+a_vel*fzm(k)
6433 a_vel = 0.
6434 end do
6435 if (i_start .eq. ids+1) then
6436 i = ids+1
6437 ! recompute : i
6438 k = ktf+1
6439 ! recompute : k
6440 a_ru(i,k-2,j) = a_ru(i,k-2,j)-0.5*a_fqx(i,k)*fzp(k-1)*(w(i,k,j)+w(i-1,k,j))
6441 a_ru(i,k-1,j) = a_ru(i,k-1,j)+0.5*a_fqx(i,k)*(2-fzm(k-1))*(w(i,k,j)+w(i-1,k,j))
6442 a_w(i-1,k,j) = a_w(i-1,k,j)+0.5*a_fqx(i,k)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))
6443 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqx(i,k)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))
6444 a_fqx(i,k) = 0.
6445 do k = kts+1, ktf
6446 a_ru(i,k-1,j) = a_ru(i,k-1,j)+0.5*a_fqx(i,k)*fzp(k)*(w(i,k,j)+w(i-1,k,j))
6447 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_fqx(i,k)*fzm(k)*(w(i,k,j)+w(i-1,k,j))
6448 a_w(i-1,k,j) = a_w(i-1,k,j)+0.5*a_fqx(i,k)*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))
6449 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqx(i,k)*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))
6450 a_fqx(i,k) = 0.
6451 end do
6452 endif
6453 endif
6454 ! recdepend vars : ktf
6455 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4174
6456 ! recompute vars : k
6457 k = ktf+1
6458 ! recompute vars : k
6459 do i = i_start_f, i_end_f
6460 a_vel = 0.
6461 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
6462 ! recompute : vel
6463 a_vel = a_vel+a_fqx(i,k)*(0.61666667*(w(i,k,j)+w(i-1,k,j))-0.13333333*(w(i+1,k,j)+w(i-2,k,j))+0.016666667*(w(i+2,k,j)+w(i-3,&
6464 &k,j)))
6465 a_w(i-3,k,j) = a_w(i-3,k,j)+0.016666667*a_fqx(i,k)*vel
6466 a_w(i-2,k,j) = a_w(i-2,k,j)-0.13333333*a_fqx(i,k)*vel
6467 a_w(i-1,k,j) = a_w(i-1,k,j)+0.61666667*a_fqx(i,k)*vel
6468 a_w(i+2,k,j) = a_w(i+2,k,j)+0.016666667*a_fqx(i,k)*vel
6469 a_w(i+1,k,j) = a_w(i+1,k,j)-0.13333333*a_fqx(i,k)*vel
6470 a_w(i,k,j) = a_w(i,k,j)+0.61666667*a_fqx(i,k)*vel
6471 a_fqx(i,k) = 0.
6472 a_ru(i,k-2,j) = a_ru(i,k-2,j)-a_vel*fzp(k-1)
6473 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*(2-fzm(k-1))
6474 a_vel = 0.
6475 end do
6476 do k = kts+1, ktf
6477 a_vel = 0.
6478 do i = i_start_f, i_end_f
6479 a_vel = 0.
6480 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
6481 ! recompute : vel
6482 a_vel = a_vel+a_fqx(i,k)*(0.61666667*(w(i,k,j)+w(i-1,k,j))-0.13333333*(w(i+1,k,j)+w(i-2,k,j))+0.016666667*(w(i+2,k,j)+w(i-&
6483 &3,k,j)))
6484 a_w(i-3,k,j) = a_w(i-3,k,j)+0.016666667*a_fqx(i,k)*vel
6485 a_w(i-2,k,j) = a_w(i-2,k,j)-0.13333333*a_fqx(i,k)*vel
6486 a_w(i-1,k,j) = a_w(i-1,k,j)+0.61666667*a_fqx(i,k)*vel
6487 a_w(i+2,k,j) = a_w(i+2,k,j)+0.016666667*a_fqx(i,k)*vel
6488 a_w(i+1,k,j) = a_w(i+1,k,j)-0.13333333*a_fqx(i,k)*vel
6489 a_w(i,k,j) = a_w(i,k,j)+0.61666667*a_fqx(i,k)*vel
6490 a_fqx(i,k) = 0.
6491 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*fzp(k)
6492 a_ru(i,k,j) = a_ru(i,k,j)+a_vel*fzm(k)
6493 a_vel = 0.
6494 end do
6495 end do
6496 end do
6497 ! recdepend vars : its
6498 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4000
6499 ! recompute vars : i_start
6500 i_start = its
6501 ! recompute vars : i_start
6502 ! recdepend vars : i_start,ide,ite
6503 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4001
6504 ! recompute vars : i_end
6505 i_end = min(ite,ide-1)
6506 ! recompute vars : i_end
6507 ! recdepend vars : i_end,i_start,jts
6508 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4002
6509 ! recompute vars : j_start
6510 j_start = jts
6511 ! recompute vars : j_start
6512 ! recdepend vars : i_end,i_start,j_start,jde,jte
6513 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4003
6514 ! recompute vars : j_end
6515 j_end = min(jte,jde-1)
6516 ! recompute vars : j_end
6517 ! recdepend vars : degrade_ys,i_end,i_start,j_end,j_start,jds,jts
6518 ! recompute pos : IF_STMT module_advect_em.f90:4011
6519 ! recompute vars : j_start
6520 if (degrade_ys) then
6521 j_start = max(jts,jds+1)
6522 endif
6523 ! recompute vars : j_start
6524 ! recdepend vars : degrade_ye,i_end,i_start,j_end,j_start,jde,jte
6525 ! recompute pos : IF_STMT module_advect_em.f90:4016
6526 ! recompute vars : j_end
6527 if (degrade_ye) then
6528 j_end = min(jte,jde-2)
6529 endif
6530 ! recompute vars : j_end
6531 a_j_loop_y_flux_6: do j = j_end+1, j_start, -1
6532 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4023
6533 ! recompute vars : jp1
6534 jp1 = 2
6535 ! recompute vars : jp1
6536 ! recdepend vars : jp1
6537 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4024
6538 ! recompute vars : jp0
6539 jp0 = 1
6540 ! recompute vars : jp0
6541 j_loop_y_flux_9c: do j4 = j_start, j-1
6542 jtmp = jp1
6543 jp1 = jp0
6544 jp0 = jtmp
6545 end do j_loop_y_flux_9c
6546 if (j .gt. j_start) then
6547 do k = kts+1, ktf+1
6548 do i = i_start, i_end
6549 mrdy = msft(i,j-1)*rdy
6550 ! recompute : mrdy
6551 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
6552 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
6553 end do
6554 end do
6555 endif
6556 if (j .ge. j_start_f .and. j .le. j_end_f) then
6557 k = ktf+1
6558 ! recompute : k
6559 do i = i_start, i_end
6560 a_vel = 0.
6561 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
6562 ! recompute : vel
6563 a_vel = a_vel+a_fqy(i,k,jp1)*(0.61666667*(w(i,k,j)+w(i,k,j-1))-0.13333333*(w(i,k,j+1)+w(i,k,j-2))+0.016666667*(w(i,k,j+2)+&
6564 &w(i,k,j-3)))
6565 a_w(i,k,j-3) = a_w(i,k,j-3)+0.016666667*a_fqy(i,k,jp1)*vel
6566 a_w(i,k,j-2) = a_w(i,k,j-2)-0.13333333*a_fqy(i,k,jp1)*vel
6567 a_w(i,k,j-1) = a_w(i,k,j-1)+0.61666667*a_fqy(i,k,jp1)*vel
6568 a_w(i,k,j+2) = a_w(i,k,j+2)+0.016666667*a_fqy(i,k,jp1)*vel
6569 a_w(i,k,j+1) = a_w(i,k,j+1)-0.13333333*a_fqy(i,k,jp1)*vel
6570 a_w(i,k,j) = a_w(i,k,j)+0.61666667*a_fqy(i,k,jp1)*vel
6571 a_fqy(i,k,jp1) = 0.
6572 a_rv(i,k-2,j) = a_rv(i,k-2,j)-a_vel*fzp(k-1)
6573 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*(2-fzm(k-1))
6574 a_vel = 0.
6575 end do
6576 do k = kts+1, ktf
6577 a_vel = 0.
6578 do i = i_start, i_end
6579 a_vel = 0.
6580 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
6581 ! recompute : vel
6582 a_vel = a_vel+a_fqy(i,k,jp1)*(0.61666667*(w(i,k,j)+w(i,k,j-1))-0.13333333*(w(i,k,j+1)+w(i,k,j-2))+0.016666667*(w(i,k,j+2)&
6583 &+w(i,k,j-3)))
6584 a_w(i,k,j-3) = a_w(i,k,j-3)+0.016666667*a_fqy(i,k,jp1)*vel
6585 a_w(i,k,j-2) = a_w(i,k,j-2)-0.13333333*a_fqy(i,k,jp1)*vel
6586 a_w(i,k,j-1) = a_w(i,k,j-1)+0.61666667*a_fqy(i,k,jp1)*vel
6587 a_w(i,k,j+2) = a_w(i,k,j+2)+0.016666667*a_fqy(i,k,jp1)*vel
6588 a_w(i,k,j+1) = a_w(i,k,j+1)-0.13333333*a_fqy(i,k,jp1)*vel
6589 a_w(i,k,j) = a_w(i,k,j)+0.61666667*a_fqy(i,k,jp1)*vel
6590 a_fqy(i,k,jp1) = 0.
6591 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*fzp(k)
6592 a_rv(i,k,j) = a_rv(i,k,j)+a_vel*fzm(k)
6593 a_vel = 0.
6594 end do
6595 end do
6596 else if (j .eq. jds+1) then
6597 k = ktf+1
6598 ! recompute : k
6599 do i = i_start, i_end
6600 a_rv(i,k-2,j) = a_rv(i,k-2,j)-0.5*a_fqy(i,k,jp1)*fzp(k-1)*(w(i,k,j)+w(i,k,j-1))
6601 a_rv(i,k-1,j) = a_rv(i,k-1,j)+0.5*a_fqy(i,k,jp1)*(2-fzm(k-1))*(w(i,k,j)+w(i,k,j-1))
6602 a_w(i,k,j-1) = a_w(i,k,j-1)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))
6603 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))
6604 a_fqy(i,k,jp1) = 0.
6605 end do
6606 do k = kts+1, ktf
6607 do i = i_start, i_end
6608 a_rv(i,k-1,j) = a_rv(i,k-1,j)+0.5*a_fqy(i,k,jp1)*fzp(k)*(w(i,k,j)+w(i,k,j-1))
6609 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_fqy(i,k,jp1)*fzm(k)*(w(i,k,j)+w(i,k,j-1))
6610 a_w(i,k,j-1) = a_w(i,k,j-1)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))
6611 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))
6612 a_fqy(i,k,jp1) = 0.
6613 end do
6614 end do
6615 else if (j .eq. jds+2) then
6616 k = ktf+1
6617 ! recompute : k
6618 do i = i_start, i_end
6619 a_vel = 0.
6620 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
6621 ! recompute : vel
6622 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(w(i,k,j)+w(i,k,j-1))-0.083333333*(w(i,k,j+1)+w(i,k,j-2)))
6623 a_w(i,k,j-2) = a_w(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
6624 a_w(i,k,j-1) = a_w(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
6625 a_w(i,k,j+1) = a_w(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
6626 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
6627 a_fqy(i,k,jp1) = 0.
6628 a_rv(i,k-2,j) = a_rv(i,k-2,j)-a_vel*fzp(k-1)
6629 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*(2-fzm(k-1))
6630 a_vel = 0.
6631 end do
6632 do k = kts+1, ktf
6633 a_vel = 0.
6634 do i = i_start, i_end
6635 a_vel = 0.
6636 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
6637 ! recompute : vel
6638 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(w(i,k,j)+w(i,k,j-1))-0.083333333*(w(i,k,j+1)+w(i,k,j-2)))
6639 a_w(i,k,j-2) = a_w(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
6640 a_w(i,k,j-1) = a_w(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
6641 a_w(i,k,j+1) = a_w(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
6642 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
6643 a_fqy(i,k,jp1) = 0.
6644 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*fzp(k)
6645 a_rv(i,k,j) = a_rv(i,k,j)+a_vel*fzm(k)
6646 a_vel = 0.
6647 end do
6648 end do
6649 else if (j .eq. jde-1) then
6650 k = ktf+1
6651 ! recompute : k
6652 do i = i_start, i_end
6653 a_rv(i,k-2,j) = a_rv(i,k-2,j)-0.5*a_fqy(i,k,jp1)*fzp(k-1)*(w(i,k,j)+w(i,k,j-1))
6654 a_rv(i,k-1,j) = a_rv(i,k-1,j)+0.5*a_fqy(i,k,jp1)*(2-fzm(k-1))*(w(i,k,j)+w(i,k,j-1))
6655 a_w(i,k,j-1) = a_w(i,k,j-1)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))
6656 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))
6657 a_fqy(i,k,jp1) = 0.
6658 end do
6659 do k = kts+1, ktf
6660 do i = i_start, i_end
6661 a_rv(i,k-1,j) = a_rv(i,k-1,j)+0.5*a_fqy(i,k,jp1)*fzp(k)*(w(i,k,j)+w(i,k,j-1))
6662 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_fqy(i,k,jp1)*fzm(k)*(w(i,k,j)+w(i,k,j-1))
6663 a_w(i,k,j-1) = a_w(i,k,j-1)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))
6664 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))
6665 a_fqy(i,k,jp1) = 0.
6666 end do
6667 end do
6668 else if (j .eq. jde-2) then
6669 k = ktf+1
6670 ! recompute : k
6671 do i = i_start, i_end
6672 a_vel = 0.
6673 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
6674 ! recompute : vel
6675 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(w(i,k,j)+w(i,k,j-1))-0.083333333*(w(i,k,j+1)+w(i,k,j-2)))
6676 a_w(i,k,j-2) = a_w(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
6677 a_w(i,k,j-1) = a_w(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
6678 a_w(i,k,j+1) = a_w(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
6679 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
6680 a_fqy(i,k,jp1) = 0.
6681 a_rv(i,k-2,j) = a_rv(i,k-2,j)-a_vel*fzp(k-1)
6682 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*(2-fzm(k-1))
6683 a_vel = 0.
6684 end do
6685 do k = kts+1, ktf
6686 a_vel = 0.
6687 do i = i_start, i_end
6688 a_vel = 0.
6689 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
6690 ! recompute : vel
6691 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(w(i,k,j)+w(i,k,j-1))-0.083333333*(w(i,k,j+1)+w(i,k,j-2)))
6692 a_w(i,k,j-2) = a_w(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
6693 a_w(i,k,j-1) = a_w(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
6694 a_w(i,k,j+1) = a_w(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
6695 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
6696 a_fqy(i,k,jp1) = 0.
6697 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*fzp(k)
6698 a_rv(i,k,j) = a_rv(i,k,j)+a_vel*fzm(k)
6699 a_vel = 0.
6700 end do
6701 end do
6702 endif
6703 end do a_j_loop_y_flux_6
6704 else if (horz_order .eq. 5) then a_horizontal_order_test
6705 degrade_xs = .true.
6706 ! recompute : degrade_xs
6707 degrade_xe = .true.
6708 ! recompute : degrade_xe
6709 degrade_ys = .true.
6710 ! recompute : degrade_ys
6711 degrade_ye = .true.
6712 ! recompute : degrade_ye
6713 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
6714 degrade_xs = .false.
6715 endif
6716 ! recompute : degrade_xs
6717 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-3) then
6718 degrade_xe = .false.
6719 endif
6720 ! recompute : degrade_xe
6721 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
6722 degrade_ys = .false.
6723 endif
6724 ! recompute : degrade_ys
6725 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-3) then
6726 degrade_ye = .false.
6727 endif
6728 ! recompute : degrade_ye
6729 j_start = jts
6730 ! recompute : j_start
6731 j_end = min(jte,jde-1)
6732 ! recompute : j_end
6733 j_start_f = j_start
6734 ! recompute : j_start_f
6735 j_end_f = j_end+1
6736 ! recompute : j_end_f
6737 if (degrade_ys) then
6738 j_start_f = jds+3
6739 endif
6740 ! recompute : j_start_f
6741 if (degrade_ye) then
6742 j_end_f = jde-3
6743 endif
6744 ! recompute : j_end_f
6745 i_start = its
6746 ! recompute : i_start
6747 i_end = min(ite,ide-1)
6748 ! recompute : i_end
6749 j_start = jts
6750 ! recompute : j_start
6751 j_end = min(jte,jde-1)
6752 ! recompute : j_end
6753 i_start_f = i_start
6754 ! recompute : i_start_f
6755 i_end_f = i_end+1
6756 ! recompute : i_end_f
6757 if (degrade_xs) then
6758 i_start = max(ids+1,its)
6759 i_start_f = i_start+2
6760 endif
6761 ! recompute : i_start,i_start_f
6762 if (degrade_xe) then
6763 i_end = min(ide-2,ite)
6764 i_end_f = ide-3
6765 endif
6766 ! recompute : i_end,i_end_f
6767 do j = j_end, j_start, -1
6768 do k = kts+1, ktf+1
6769 do i = i_start, i_end
6770 mrdx = msft(i,j)*rdx
6771 ! recompute : mrdx
6772 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
6773 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
6774 end do
6775 end do
6776 if (degrade_xe) then
6777 i = ide-2
6778 ! recompute : i
6779 k = ktf+1
6780 ! recompute : k
6781 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
6782 ! recompute : vel
6783 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(w(i,k,j)+w(i-1,k,j))-0.083333333*(w(i+1,k,j)+w(i-2,k,j))+0.083333333*(w(i+1,k,j)-w(i-2,&
6784 &k,j)-3.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))
6785 a_w(i-2,k,j) = a_w(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
6786 a_w(i-1,k,j) = a_w(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
6787 a_w(i+1,k,j) = a_w(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
6788 a_w(i,k,j) = a_w(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
6789 a_fqx(i,k) = 0.
6790 a_ru(i,k-2,j) = a_ru(i,k-2,j)-a_vel*fzp(k-1)
6791 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*(2-fzm(k-1))
6792 a_vel = 0.
6793 do k = kts+1, ktf
6794 a_vel = 0.
6795 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
6796 ! recompute : vel
6797 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(w(i,k,j)+w(i-1,k,j))-0.083333333*(w(i+1,k,j)+w(i-2,k,j))+0.083333333*(w(i+1,k,j)-w(i-&
6798 &2,k,j)-3.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))
6799 a_w(i-2,k,j) = a_w(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
6800 a_w(i-1,k,j) = a_w(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
6801 a_w(i+1,k,j) = a_w(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
6802 a_w(i,k,j) = a_w(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
6803 a_fqx(i,k) = 0.
6804 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*fzp(k)
6805 a_ru(i,k,j) = a_ru(i,k,j)+a_vel*fzm(k)
6806 a_vel = 0.
6807 end do
6808 if (i_end .eq. ide-2) then
6809 i = ide-1
6810 ! recompute : i
6811 k = ktf+1
6812 ! recompute : k
6813 a_ru(i,k-2,j) = a_ru(i,k-2,j)-0.5*a_fqx(i,k)*fzp(k-1)*(w(i,k,j)+w(i-1,k,j))
6814 a_ru(i,k-1,j) = a_ru(i,k-1,j)+0.5*a_fqx(i,k)*(2-fzm(k-1))*(w(i,k,j)+w(i-1,k,j))
6815 a_w(i-1,k,j) = a_w(i-1,k,j)+0.5*a_fqx(i,k)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))
6816 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqx(i,k)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))
6817 a_fqx(i,k) = 0.
6818 do k = kts+1, ktf
6819 a_ru(i,k-1,j) = a_ru(i,k-1,j)+0.5*a_fqx(i,k)*fzp(k)*(w(i,k,j)+w(i-1,k,j))
6820 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_fqx(i,k)*fzm(k)*(w(i,k,j)+w(i-1,k,j))
6821 a_w(i-1,k,j) = a_w(i-1,k,j)+0.5*a_fqx(i,k)*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))
6822 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqx(i,k)*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))
6823 a_fqx(i,k) = 0.
6824 end do
6825 endif
6826 endif
6827 if (degrade_xs) then
6828 i = i_start+1
6829 ! recompute : i
6830 k = ktf+1
6831 ! recompute : k
6832 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
6833 ! recompute : vel
6834 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(w(i,k,j)+w(i-1,k,j))-0.083333333*(w(i+1,k,j)+w(i-2,k,j))+0.083333333*(w(i+1,k,j)-w(i-2,&
6835 &k,j)-3.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))
6836 a_w(i-2,k,j) = a_w(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
6837 a_w(i-1,k,j) = a_w(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
6838 a_w(i+1,k,j) = a_w(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
6839 a_w(i,k,j) = a_w(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
6840 a_fqx(i,k) = 0.
6841 a_ru(i,k-2,j) = a_ru(i,k-2,j)-a_vel*fzp(k-1)
6842 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*(2-fzm(k-1))
6843 a_vel = 0.
6844 do k = kts+1, ktf
6845 a_vel = 0.
6846 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
6847 ! recompute : vel
6848 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(w(i,k,j)+w(i-1,k,j))-0.083333333*(w(i+1,k,j)+w(i-2,k,j))+0.083333333*(w(i+1,k,j)-w(i-&
6849 &2,k,j)-3.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))
6850 a_w(i-2,k,j) = a_w(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
6851 a_w(i-1,k,j) = a_w(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
6852 a_w(i+1,k,j) = a_w(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
6853 a_w(i,k,j) = a_w(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
6854 a_fqx(i,k) = 0.
6855 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*fzp(k)
6856 a_ru(i,k,j) = a_ru(i,k,j)+a_vel*fzm(k)
6857 a_vel = 0.
6858 end do
6859 if (i_start .eq. ids+1) then
6860 i = ids+1
6861 ! recompute : i
6862 k = ktf+1
6863 ! recompute : k
6864 a_ru(i,k-2,j) = a_ru(i,k-2,j)-0.5*a_fqx(i,k)*fzp(k-1)*(w(i,k,j)+w(i-1,k,j))
6865 a_ru(i,k-1,j) = a_ru(i,k-1,j)+0.5*a_fqx(i,k)*(2-fzm(k-1))*(w(i,k,j)+w(i-1,k,j))
6866 a_w(i-1,k,j) = a_w(i-1,k,j)+0.5*a_fqx(i,k)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))
6867 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqx(i,k)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))
6868 a_fqx(i,k) = 0.
6869 do k = kts+1, ktf
6870 a_ru(i,k-1,j) = a_ru(i,k-1,j)+0.5*a_fqx(i,k)*fzp(k)*(w(i,k,j)+w(i-1,k,j))
6871 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_fqx(i,k)*fzm(k)*(w(i,k,j)+w(i-1,k,j))
6872 a_w(i-1,k,j) = a_w(i-1,k,j)+0.5*a_fqx(i,k)*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))
6873 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqx(i,k)*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))
6874 a_fqx(i,k) = 0.
6875 end do
6876 endif
6877 endif
6878 ! recdepend vars : ktf
6879 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4456
6880 ! recompute vars : k
6881 k = ktf+1
6882 ! recompute vars : k
6883 do i = i_start_f, i_end_f
6884 a_vel = 0.
6885 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
6886 ! recompute : vel
6887 a_vel = a_vel+a_fqx(i,k)*(0.61666667*(w(i,k,j)+w(i-1,k,j))-0.13333333*(w(i+1,k,j)+w(i-2,k,j))+0.016666667*(w(i+2,k,j)+w(i-3,&
6888 &k,j))-0.016666667*(w(i+2,k,j)-w(i-3,k,j)-5.*(w(i+1,k,j)-w(i-2,k,j))+10.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))
6889 a_w(i-3,k,j) = a_w(i-3,k,j)+a_fqx(i,k)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))
6890 a_w(i-2,k,j) = a_w(i-2,k,j)+a_fqx(i,k)*vel*((-0.13333333)-0.083333333*sign(1.,vel))
6891 a_w(i-1,k,j) = a_w(i-1,k,j)+a_fqx(i,k)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))
6892 a_w(i+2,k,j) = a_w(i+2,k,j)+a_fqx(i,k)*vel*(0.016666667-0.016666667*sign(1.,vel))
6893 a_w(i+1,k,j) = a_w(i+1,k,j)+a_fqx(i,k)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))
6894 a_w(i,k,j) = a_w(i,k,j)+a_fqx(i,k)*vel*(0.61666667-0.16666667*sign(1.,vel))
6895 a_fqx(i,k) = 0.
6896 a_ru(i,k-2,j) = a_ru(i,k-2,j)-a_vel*fzp(k-1)
6897 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*(2-fzm(k-1))
6898 a_vel = 0.
6899 end do
6900 do k = kts+1, ktf
6901 a_vel = 0.
6902 do i = i_start_f, i_end_f
6903 a_vel = 0.
6904 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
6905 ! recompute : vel
6906 a_vel = a_vel+a_fqx(i,k)*(0.61666667*(w(i,k,j)+w(i-1,k,j))-0.13333333*(w(i+1,k,j)+w(i-2,k,j))+0.016666667*(w(i+2,k,j)+w(i-&
6907 &3,k,j))-0.016666667*(w(i+2,k,j)-w(i-3,k,j)-5.*(w(i+1,k,j)-w(i-2,k,j))+10.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))
6908 a_w(i-3,k,j) = a_w(i-3,k,j)+a_fqx(i,k)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))
6909 a_w(i-2,k,j) = a_w(i-2,k,j)+a_fqx(i,k)*vel*((-0.13333333)-0.083333333*sign(1.,vel))
6910 a_w(i-1,k,j) = a_w(i-1,k,j)+a_fqx(i,k)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))
6911 a_w(i+2,k,j) = a_w(i+2,k,j)+a_fqx(i,k)*vel*(0.016666667-0.016666667*sign(1.,vel))
6912 a_w(i+1,k,j) = a_w(i+1,k,j)+a_fqx(i,k)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))
6913 a_w(i,k,j) = a_w(i,k,j)+a_fqx(i,k)*vel*(0.61666667-0.16666667*sign(1.,vel))
6914 a_fqx(i,k) = 0.
6915 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*fzp(k)
6916 a_ru(i,k,j) = a_ru(i,k,j)+a_vel*fzm(k)
6917 a_vel = 0.
6918 end do
6919 end do
6920 end do
6921 ! recdepend vars : its
6922 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4282
6923 ! recompute vars : i_start
6924 i_start = its
6925 ! recompute vars : i_start
6926 ! recdepend vars : i_start,ide,ite
6927 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4283
6928 ! recompute vars : i_end
6929 i_end = min(ite,ide-1)
6930 ! recompute vars : i_end
6931 ! recdepend vars : i_end,i_start,jts
6932 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4284
6933 ! recompute vars : j_start
6934 j_start = jts
6935 ! recompute vars : j_start
6936 ! recdepend vars : i_end,i_start,j_start,jde,jte
6937 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4285
6938 ! recompute vars : j_end
6939 j_end = min(jte,jde-1)
6940 ! recompute vars : j_end
6941 ! recdepend vars : degrade_ys,i_end,i_start,j_end,j_start,jds,jts
6942 ! recompute pos : IF_STMT module_advect_em.f90:4293
6943 ! recompute vars : j_start
6944 if (degrade_ys) then
6945 j_start = max(jts,jds+1)
6946 endif
6947 ! recompute vars : j_start
6948 ! recdepend vars : degrade_ye,i_end,i_start,j_end,j_start,jde,jte
6949 ! recompute pos : IF_STMT module_advect_em.f90:4298
6950 ! recompute vars : j_end
6951 if (degrade_ye) then
6952 j_end = min(jte,jde-2)
6953 endif
6954 ! recompute vars : j_end
6955 a_j_loop_y_flux_5: do j = j_end+1, j_start, -1
6956 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4305
6957 ! recompute vars : jp1
6958 jp1 = 2
6959 ! recompute vars : jp1
6960 ! recdepend vars : jp1
6961 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4306
6962 ! recompute vars : jp0
6963 jp0 = 1
6964 ! recompute vars : jp0
6965 j_loop_y_flux_9a: do j1 = j_start, j-1
6966 jtmp = jp1
6967 jp1 = jp0
6968 jp0 = jtmp
6969 end do j_loop_y_flux_9a
6970 if (j .gt. j_start) then
6971 do k = kts+1, ktf+1
6972 do i = i_start, i_end
6973 mrdy = msft(i,j-1)*rdy
6974 ! recompute : mrdy
6975 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
6976 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
6977 end do
6978 end do
6979 endif
6980 if (j .ge. j_start_f .and. j .le. j_end_f) then
6981 k = ktf+1
6982 ! recompute : k
6983 do i = i_start, i_end
6984 a_vel = 0.
6985 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
6986 ! recompute : vel
6987 a_vel = a_vel+a_fqy(i,k,jp1)*(0.61666667*(w(i,k,j)+w(i,k,j-1))-0.13333333*(w(i,k,j+1)+w(i,k,j-2))+0.016666667*(w(i,k,j+2)+&
6988 &w(i,k,j-3))-0.016666667*(w(i,k,j+2)-w(i,k,j-3)-5.*(w(i,k,j+1)-w(i,k,j-2))+10.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))
6989 a_w(i,k,j-3) = a_w(i,k,j-3)+a_fqy(i,k,jp1)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))
6990 a_w(i,k,j-2) = a_w(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.13333333)-0.083333333*sign(1.,vel))
6991 a_w(i,k,j-1) = a_w(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))
6992 a_w(i,k,j+2) = a_w(i,k,j+2)+a_fqy(i,k,jp1)*vel*(0.016666667-0.016666667*sign(1.,vel))
6993 a_w(i,k,j+1) = a_w(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))
6994 a_w(i,k,j) = a_w(i,k,j)+a_fqy(i,k,jp1)*vel*(0.61666667-0.16666667*sign(1.,vel))
6995 a_fqy(i,k,jp1) = 0.
6996 a_rv(i,k-2,j) = a_rv(i,k-2,j)-a_vel*fzp(k-1)
6997 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*(2-fzm(k-1))
6998 a_vel = 0.
6999 end do
7000 do k = kts+1, ktf
7001 a_vel = 0.
7002 do i = i_start, i_end
7003 a_vel = 0.
7004 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
7005 ! recompute : vel
7006 a_vel = a_vel+a_fqy(i,k,jp1)*(0.61666667*(w(i,k,j)+w(i,k,j-1))-0.13333333*(w(i,k,j+1)+w(i,k,j-2))+0.016666667*(w(i,k,j+2)&
7007 &+w(i,k,j-3))-0.016666667*(w(i,k,j+2)-w(i,k,j-3)-5.*(w(i,k,j+1)-w(i,k,j-2))+10.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))
7008 a_w(i,k,j-3) = a_w(i,k,j-3)+a_fqy(i,k,jp1)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))
7009 a_w(i,k,j-2) = a_w(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.13333333)-0.083333333*sign(1.,vel))
7010 a_w(i,k,j-1) = a_w(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))
7011 a_w(i,k,j+2) = a_w(i,k,j+2)+a_fqy(i,k,jp1)*vel*(0.016666667-0.016666667*sign(1.,vel))
7012 a_w(i,k,j+1) = a_w(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))
7013 a_w(i,k,j) = a_w(i,k,j)+a_fqy(i,k,jp1)*vel*(0.61666667-0.16666667*sign(1.,vel))
7014 a_fqy(i,k,jp1) = 0.
7015 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*fzp(k)
7016 a_rv(i,k,j) = a_rv(i,k,j)+a_vel*fzm(k)
7017 a_vel = 0.
7018 end do
7019 end do
7020 else if (j .eq. jds+1) then
7021 k = ktf+1
7022 ! recompute : k
7023 do i = i_start, i_end
7024 a_rv(i,k-2,j) = a_rv(i,k-2,j)-0.5*a_fqy(i,k,jp1)*fzp(k-1)*(w(i,k,j)+w(i,k,j-1))
7025 a_rv(i,k-1,j) = a_rv(i,k-1,j)+0.5*a_fqy(i,k,jp1)*(2-fzm(k-1))*(w(i,k,j)+w(i,k,j-1))
7026 a_w(i,k,j-1) = a_w(i,k,j-1)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))
7027 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))
7028 a_fqy(i,k,jp1) = 0.
7029 end do
7030 do k = kts+1, ktf
7031 do i = i_start, i_end
7032 a_rv(i,k-1,j) = a_rv(i,k-1,j)+0.5*a_fqy(i,k,jp1)*fzp(k)*(w(i,k,j)+w(i,k,j-1))
7033 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_fqy(i,k,jp1)*fzm(k)*(w(i,k,j)+w(i,k,j-1))
7034 a_w(i,k,j-1) = a_w(i,k,j-1)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))
7035 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))
7036 a_fqy(i,k,jp1) = 0.
7037 end do
7038 end do
7039 else if (j .eq. jds+2) then
7040 k = ktf+1
7041 ! recompute : k
7042 do i = i_start, i_end
7043 a_vel = 0.
7044 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
7045 ! recompute : vel
7046 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(w(i,k,j)+w(i,k,j-1))-0.083333333*(w(i,k,j+1)+w(i,k,j-2))+0.083333333*(w(i,k,j+1)-&
7047 &w(i,k,j-2)-3.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))
7048 a_w(i,k,j-2) = a_w(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
7049 a_w(i,k,j-1) = a_w(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
7050 a_w(i,k,j+1) = a_w(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
7051 a_w(i,k,j) = a_w(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
7052 a_fqy(i,k,jp1) = 0.
7053 a_rv(i,k-2,j) = a_rv(i,k-2,j)-a_vel*fzp(k-1)
7054 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*(2-fzm(k-1))
7055 a_vel = 0.
7056 end do
7057 do k = kts+1, ktf
7058 a_vel = 0.
7059 do i = i_start, i_end
7060 a_vel = 0.
7061 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
7062 ! recompute : vel
7063 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(w(i,k,j)+w(i,k,j-1))-0.083333333*(w(i,k,j+1)+w(i,k,j-2))+0.083333333*(w(i,k,j+&
7064 &1)-w(i,k,j-2)-3.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))
7065 a_w(i,k,j-2) = a_w(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
7066 a_w(i,k,j-1) = a_w(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
7067 a_w(i,k,j+1) = a_w(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
7068 a_w(i,k,j) = a_w(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
7069 a_fqy(i,k,jp1) = 0.
7070 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*fzp(k)
7071 a_rv(i,k,j) = a_rv(i,k,j)+a_vel*fzm(k)
7072 a_vel = 0.
7073 end do
7074 end do
7075 else if (j .eq. jde-1) then
7076 k = ktf+1
7077 ! recompute : k
7078 do i = i_start, i_end
7079 a_rv(i,k-2,j) = a_rv(i,k-2,j)-0.5*a_fqy(i,k,jp1)*fzp(k-1)*(w(i,k,j)+w(i,k,j-1))
7080 a_rv(i,k-1,j) = a_rv(i,k-1,j)+0.5*a_fqy(i,k,jp1)*(2-fzm(k-1))*(w(i,k,j)+w(i,k,j-1))
7081 a_w(i,k,j-1) = a_w(i,k,j-1)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))
7082 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))
7083 a_fqy(i,k,jp1) = 0.
7084 end do
7085 do k = kts+1, ktf
7086 do i = i_start, i_end
7087 a_rv(i,k-1,j) = a_rv(i,k-1,j)+0.5*a_fqy(i,k,jp1)*fzp(k)*(w(i,k,j)+w(i,k,j-1))
7088 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_fqy(i,k,jp1)*fzm(k)*(w(i,k,j)+w(i,k,j-1))
7089 a_w(i,k,j-1) = a_w(i,k,j-1)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))
7090 a_w(i,k,j) = a_w(i,k,j)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))
7091 a_fqy(i,k,jp1) = 0.
7092 end do
7093 end do
7094 else if (j .eq. jde-2) then
7095 k = ktf+1
7096 ! recompute : k
7097 do i = i_start, i_end
7098 a_vel = 0.
7099 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
7100 ! recompute : vel
7101 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(w(i,k,j)+w(i,k,j-1))-0.083333333*(w(i,k,j+1)+w(i,k,j-2))+0.083333333*(w(i,k,j+1)-&
7102 &w(i,k,j-2)-3.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))
7103 a_w(i,k,j-2) = a_w(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
7104 a_w(i,k,j-1) = a_w(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
7105 a_w(i,k,j+1) = a_w(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
7106 a_w(i,k,j) = a_w(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
7107 a_fqy(i,k,jp1) = 0.
7108 a_rv(i,k-2,j) = a_rv(i,k-2,j)-a_vel*fzp(k-1)
7109 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*(2-fzm(k-1))
7110 a_vel = 0.
7111 end do
7112 do k = kts+1, ktf
7113 a_vel = 0.
7114 do i = i_start, i_end
7115 a_vel = 0.
7116 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
7117 ! recompute : vel
7118 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(w(i,k,j)+w(i,k,j-1))-0.083333333*(w(i,k,j+1)+w(i,k,j-2))+0.083333333*(w(i,k,j+&
7119 &1)-w(i,k,j-2)-3.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))
7120 a_w(i,k,j-2) = a_w(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
7121 a_w(i,k,j-1) = a_w(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
7122 a_w(i,k,j+1) = a_w(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
7123 a_w(i,k,j) = a_w(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
7124 a_fqy(i,k,jp1) = 0.
7125 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*fzp(k)
7126 a_rv(i,k,j) = a_rv(i,k,j)+a_vel*fzm(k)
7127 a_vel = 0.
7128 end do
7129 end do
7130 endif
7131 end do a_j_loop_y_flux_5
7132 else if (horz_order .eq. 4) then a_horizontal_order_test
7133 degrade_xs = .true.
7134 ! recompute : degrade_xs
7135 degrade_xe = .true.
7136 ! recompute : degrade_xe
7137 degrade_ys = .true.
7138 ! recompute : degrade_ys
7139 degrade_ye = .true.
7140 ! recompute : degrade_ye
7141 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
7142 degrade_xs = .false.
7143 endif
7144 ! recompute : degrade_xs
7145 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
7146 degrade_xe = .false.
7147 endif
7148 ! recompute : degrade_xe
7149 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
7150 degrade_ys = .false.
7151 endif
7152 ! recompute : degrade_ys
7153 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
7154 degrade_ye = .false.
7155 endif
7156 ! recompute : degrade_ye
7157 ! recompute : ktf
7158 i_start = its
7159 ! recompute : i_start
7160 i_end = min(ite,ide-1)
7161 ! recompute : i_end
7162 i_start_f = i_start
7163 ! recompute : i_start_f
7164 i_end_f = i_end+1
7165 ! recompute : i_end_f
7166 if (degrade_xs) then
7167 i_start = ids+1
7168 i_start_f = i_start+1
7169 endif
7170 ! recompute : i_start_f
7171 if (degrade_xe) then
7172 i_end_f = ide-2
7173 endif
7174 ! recompute : i_end_f
7175 i_start = its
7176 ! recompute : i_start
7177 i_end = min(ite,ide-1)
7178 ! recompute : i_end
7179 j_start = jts
7180 ! recompute : j_start
7181 j_end = min(jte,jde-1)
7182 ! recompute : j_end
7183 j_start_f = j_start
7184 ! recompute : j_start_f
7185 j_end_f = j_end+1
7186 ! recompute : j_end_f
7187 if (degrade_ys) then
7188 j_start = jds+1
7189 j_start_f = j_start+1
7190 endif
7191 ! recompute : j_start,j_start_f
7192 if (degrade_ye) then
7193 j_end = jde-2
7194 j_end_f = jde-2
7195 endif
7196 ! recompute : j_end,j_end_f
7197 do j = j_end+1, j_start, -1
7198 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4662
7199 ! recompute vars : jp1
7200 jp1 = 2
7201 ! recompute vars : jp1
7202 ! recdepend vars : jp1
7203 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4663
7204 ! recompute vars : jp0
7205 jp0 = 1
7206 ! recompute vars : jp0
7207 do j2 = j_start, j-1
7208 jtmp = jp1
7209 jp1 = jp0
7210 jp0 = jtmp
7211 end do
7212 if (j .gt. j_start) then
7213 do k = kts+1, ktf+1
7214 do i = i_start, i_end
7215 mrdy = msft(i,j-1)*rdy
7216 ! recompute : mrdy
7217 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
7218 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
7219 end do
7220 end do
7221 endif
7222 if (j .lt. j_start_f .and. degrade_ys) then
7223 k = ktf+1
7224 ! recompute : k
7225 do i = i_start, i_end
7226 a_rv(i,k-2,j_start) = a_rv(i,k-2,j_start)-0.5*a_fqy(i,k,jp1)*fzp(k-1)*(w(i,k,j_start)+w(i,k,j_start-1))
7227 a_rv(i,k-1,j_start) = a_rv(i,k-1,j_start)+0.5*a_fqy(i,k,jp1)*(2-fzm(k-1))*(w(i,k,j_start)+w(i,k,j_start-1))
7228 a_w(i,k,j_start-1) = a_w(i,k,j_start-1)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))
7229 a_w(i,k,j_start) = a_w(i,k,j_start)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))
7230 a_fqy(i,k,jp1) = 0.
7231 end do
7232 do k = kts+1, ktf
7233 do i = i_start, i_end
7234 a_rv(i,k-1,j_start) = a_rv(i,k-1,j_start)+0.5*a_fqy(i,k,jp1)*fzp(k)*(w(i,k,j_start)+w(i,k,j_start-1))
7235 a_rv(i,k,j_start) = a_rv(i,k,j_start)+0.5*a_fqy(i,k,jp1)*fzm(k)*(w(i,k,j_start)+w(i,k,j_start-1))
7236 a_w(i,k,j_start-1) = a_w(i,k,j_start-1)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))
7237 a_w(i,k,j_start) = a_w(i,k,j_start)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))
7238 a_fqy(i,k,jp1) = 0.
7239 end do
7240 end do
7241 else if (j .gt. j_end_f .and. degrade_ye) then
7242 k = ktf+1
7243 ! recompute : k
7244 do i = i_start, i_end
7245 a_rv(i,k-2,j_end+1) = a_rv(i,k-2,j_end+1)-0.5*a_fqy(i,k,jp1)*fzp(k-1)*(w(i,k,j_end+1)+w(i,k,j_end))
7246 a_rv(i,k-1,j_end+1) = a_rv(i,k-1,j_end+1)+0.5*a_fqy(i,k,jp1)*(2-fzm(k-1))*(w(i,k,j_end+1)+w(i,k,j_end))
7247 a_w(i,k,j_end+1) = a_w(i,k,j_end+1)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))
7248 a_w(i,k,j_end) = a_w(i,k,j_end)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))
7249 a_fqy(i,k,jp1) = 0.
7250 end do
7251 do k = kts+1, ktf
7252 do i = i_start, i_end
7253 a_rv(i,k-1,j_end+1) = a_rv(i,k-1,j_end+1)+0.5*a_fqy(i,k,jp1)*fzp(k)*(w(i,k,j_end+1)+w(i,k,j_end))
7254 a_rv(i,k,j_end+1) = a_rv(i,k,j_end+1)+0.5*a_fqy(i,k,jp1)*fzm(k)*(w(i,k,j_end+1)+w(i,k,j_end))
7255 a_w(i,k,j_end+1) = a_w(i,k,j_end+1)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))
7256 a_w(i,k,j_end) = a_w(i,k,j_end)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))
7257 a_fqy(i,k,jp1) = 0.
7258 end do
7259 end do
7260 else
7261 k = ktf+1
7262 ! recompute : k
7263 do i = i_start, i_end
7264 a_vel = 0.
7265 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
7266 ! recompute : vel
7267 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(w(i,k,j)+w(i,k,j-1))-0.083333333*(w(i,k,j+1)+w(i,k,j-2)))
7268 a_w(i,k,j-2) = a_w(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
7269 a_w(i,k,j-1) = a_w(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
7270 a_w(i,k,j+1) = a_w(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
7271 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
7272 a_fqy(i,k,jp1) = 0.
7273 a_rv(i,k-2,j) = a_rv(i,k-2,j)-a_vel*fzp(k-1)
7274 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*(2-fzm(k-1))
7275 a_vel = 0.
7276 end do
7277 do k = kts+1, ktf
7278 a_vel = 0.
7279 do i = i_start, i_end
7280 a_vel = 0.
7281 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
7282 ! recompute : vel
7283 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(w(i,k,j)+w(i,k,j-1))-0.083333333*(w(i,k,j+1)+w(i,k,j-2)))
7284 a_w(i,k,j-2) = a_w(i,k,j-2)-0.083333333*a_fqy(i,k,jp1)*vel
7285 a_w(i,k,j-1) = a_w(i,k,j-1)+0.58333333*a_fqy(i,k,jp1)*vel
7286 a_w(i,k,j+1) = a_w(i,k,j+1)-0.083333333*a_fqy(i,k,jp1)*vel
7287 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_fqy(i,k,jp1)*vel
7288 a_fqy(i,k,jp1) = 0.
7289 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*fzp(k)
7290 a_rv(i,k,j) = a_rv(i,k,j)+a_vel*fzm(k)
7291 a_vel = 0.
7292 end do
7293 end do
7294 endif
7295 end do
7296 ! recdepend vars : its
7297 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4560
7298 ! recompute vars : i_start
7299 i_start = its
7300 ! recompute vars : i_start
7301 ! recdepend vars : i_start,ide,ite
7302 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4561
7303 ! recompute vars : i_end
7304 i_end = min(ite,ide-1)
7305 ! recompute vars : i_end
7306 ! recdepend vars : i_end,i_start,jts
7307 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4562
7308 ! recompute vars : j_start
7309 j_start = jts
7310 ! recompute vars : j_start
7311 ! recdepend vars : i_end,i_start,j_start,jde,jte
7312 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4563
7313 ! recompute vars : j_end
7314 j_end = min(jte,jde-1)
7315 ! recompute vars : j_end
7316 ! recdepend vars : degrade_xs,i_end,i_start,ids,j_end,j_start
7317 ! recompute pos : IF_STMT module_advect_em.f90:4571
7318 ! recompute vars : i_start
7319 if (degrade_xs) then
7320 i_start = ids+1
7321 endif
7322 ! recompute vars : i_start
7323 ! recdepend vars : degrade_xe,i_end,i_start,ide,j_end,j_start
7324 ! recompute pos : IF_STMT module_advect_em.f90:4576
7325 ! recompute vars : i_end
7326 if (degrade_xe) then
7327 i_end = ide-2
7328 endif
7329 ! recompute vars : i_end
7330 do j = j_end, j_start, -1
7331 do k = kts+1, ktf+1
7332 do i = i_start, i_end
7333 mrdx = msft(i,j)*rdx
7334 ! recompute : mrdx
7335 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
7336 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
7337 end do
7338 end do
7339 if (degrade_xe) then
7340 k = ktf+1
7341 ! recompute : k
7342 a_ru(i_end+1,k-2,j) = a_ru(i_end+1,k-2,j)-0.5*a_fqx(i_end+1,k)*fzp(k-1)*(w(i_end+1,k,j)+w(i_end,k,j))
7343 a_ru(i_end+1,k-1,j) = a_ru(i_end+1,k-1,j)+0.5*a_fqx(i_end+1,k)*(2-fzm(k-1))*(w(i_end+1,k,j)+w(i_end,k,j))
7344 a_w(i_end+1,k,j) = a_w(i_end+1,k,j)+0.5*a_fqx(i_end+1,k)*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))
7345 a_w(i_end,k,j) = a_w(i_end,k,j)+0.5*a_fqx(i_end+1,k)*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))
7346 a_fqx(i_end+1,k) = 0.
7347 do k = kts+1, ktf
7348 a_ru(i_end+1,k-1,j) = a_ru(i_end+1,k-1,j)+0.5*a_fqx(i_end+1,k)*fzp(k)*(w(i_end+1,k,j)+w(i_end,k,j))
7349 a_ru(i_end+1,k,j) = a_ru(i_end+1,k,j)+0.5*a_fqx(i_end+1,k)*fzm(k)*(w(i_end+1,k,j)+w(i_end,k,j))
7350 a_w(i_end+1,k,j) = a_w(i_end+1,k,j)+0.5*a_fqx(i_end+1,k)*(fzm(k)*ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))
7351 a_w(i_end,k,j) = a_w(i_end,k,j)+0.5*a_fqx(i_end+1,k)*(fzm(k)*ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))
7352 a_fqx(i_end+1,k) = 0.
7353 end do
7354 endif
7355 if (degrade_xs) then
7356 k = ktf+1
7357 ! recompute : k
7358 a_ru(i_start,k-2,j) = a_ru(i_start,k-2,j)-0.5*a_fqx(i_start,k)*fzp(k-1)*(w(i_start,k,j)+w(i_start-1,k,j))
7359 a_ru(i_start,k-1,j) = a_ru(i_start,k-1,j)+0.5*a_fqx(i_start,k)*(2-fzm(k-1))*(w(i_start,k,j)+w(i_start-1,k,j))
7360 a_w(i_start-1,k,j) = a_w(i_start-1,k,j)+0.5*a_fqx(i_start,k)*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))
7361 a_w(i_start,k,j) = a_w(i_start,k,j)+0.5*a_fqx(i_start,k)*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))
7362 a_fqx(i_start,k) = 0.
7363 do k = kts+1, ktf
7364 a_ru(i_start,k-1,j) = a_ru(i_start,k-1,j)+0.5*a_fqx(i_start,k)*fzp(k)*(w(i_start,k,j)+w(i_start-1,k,j))
7365 a_ru(i_start,k,j) = a_ru(i_start,k,j)+0.5*a_fqx(i_start,k)*fzm(k)*(w(i_start,k,j)+w(i_start-1,k,j))
7366 a_w(i_start-1,k,j) = a_w(i_start-1,k,j)+0.5*a_fqx(i_start,k)*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))
7367 a_w(i_start,k,j) = a_w(i_start,k,j)+0.5*a_fqx(i_start,k)*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))
7368 a_fqx(i_start,k) = 0.
7369 end do
7370 endif
7371 ! recdepend vars : ktf
7372 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4594
7373 ! recompute vars : k
7374 k = ktf+1
7375 ! recompute vars : k
7376 do i = i_start_f, i_end_f
7377 a_vel = 0.
7378 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
7379 ! recompute : vel
7380 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(w(i,k,j)+w(i-1,k,j))-0.083333333*(w(i+1,k,j)+w(i-2,k,j)))
7381 a_w(i-2,k,j) = a_w(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
7382 a_w(i-1,k,j) = a_w(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
7383 a_w(i+1,k,j) = a_w(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
7384 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_fqx(i,k)*vel
7385 a_fqx(i,k) = 0.
7386 a_ru(i,k-2,j) = a_ru(i,k-2,j)-a_vel*fzp(k-1)
7387 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*(2-fzm(k-1))
7388 a_vel = 0.
7389 end do
7390 do k = kts+1, ktf
7391 a_vel = 0.
7392 do i = i_start_f, i_end_f
7393 a_vel = 0.
7394 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
7395 ! recompute : vel
7396 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(w(i,k,j)+w(i-1,k,j))-0.083333333*(w(i+1,k,j)+w(i-2,k,j)))
7397 a_w(i-2,k,j) = a_w(i-2,k,j)-0.083333333*a_fqx(i,k)*vel
7398 a_w(i-1,k,j) = a_w(i-1,k,j)+0.58333333*a_fqx(i,k)*vel
7399 a_w(i+1,k,j) = a_w(i+1,k,j)-0.083333333*a_fqx(i,k)*vel
7400 a_w(i,k,j) = a_w(i,k,j)+0.58333333*a_fqx(i,k)*vel
7401 a_fqx(i,k) = 0.
7402 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*fzp(k)
7403 a_ru(i,k,j) = a_ru(i,k,j)+a_vel*fzm(k)
7404 a_vel = 0.
7405 end do
7406 end do
7407 end do
7408 else if (horz_order .eq. 3) then a_horizontal_order_test
7409 degrade_xs = .true.
7410 ! recompute : degrade_xs
7411 degrade_xe = .true.
7412 ! recompute : degrade_xe
7413 degrade_ys = .true.
7414 ! recompute : degrade_ys
7415 degrade_ye = .true.
7416 ! recompute : degrade_ye
7417 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
7418 degrade_xs = .false.
7419 endif
7420 ! recompute : degrade_xs
7421 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
7422 degrade_xe = .false.
7423 endif
7424 ! recompute : degrade_xe
7425 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
7426 degrade_ys = .false.
7427 endif
7428 ! recompute : degrade_ys
7429 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
7430 degrade_ye = .false.
7431 endif
7432 ! recompute : degrade_ye
7433 ! recompute : ktf
7434 i_start = its
7435 ! recompute : i_start
7436 i_end = min(ite,ide-1)
7437 ! recompute : i_end
7438 i_start_f = i_start
7439 ! recompute : i_start_f
7440 i_end_f = i_end+1
7441 ! recompute : i_end_f
7442 if (degrade_xs) then
7443 i_start = ids+1
7444 i_start_f = i_start+1
7445 endif
7446 ! recompute : i_start_f
7447 if (degrade_xe) then
7448 i_end_f = ide-2
7449 endif
7450 ! recompute : i_end_f
7451 i_start = its
7452 ! recompute : i_start
7453 i_end = min(ite,ide-1)
7454 ! recompute : i_end
7455 j_start = jts
7456 ! recompute : j_start
7457 j_end = min(jte,jde-1)
7458 ! recompute : j_end
7459 j_start_f = j_start
7460 ! recompute : j_start_f
7461 j_end_f = j_end+1
7462 ! recompute : j_end_f
7463 if (degrade_ys) then
7464 j_start = jds+1
7465 j_start_f = j_start+1
7466 endif
7467 ! recompute : j_start,j_start_f
7468 if (degrade_ye) then
7469 j_end = jde-2
7470 j_end_f = jde-2
7471 endif
7472 ! recompute : j_end,j_end_f
7473 do j = j_end+1, j_start, -1
7474 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4859
7475 ! recompute vars : jp1
7476 jp1 = 2
7477 ! recompute vars : jp1
7478 ! recdepend vars : jp1
7479 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4860
7480 ! recompute vars : jp0
7481 jp0 = 1
7482 ! recompute vars : jp0
7483 do j3 = j_start, j-1
7484 jtmp = jp1
7485 jp1 = jp0
7486 jp0 = jtmp
7487 end do
7488 if (j .gt. j_start) then
7489 do k = kts+1, ktf+1
7490 do i = i_start, i_end
7491 mrdy = msft(i,j-1)*rdy
7492 ! recompute : mrdy
7493 a_fqy(i,k,jp0) = a_fqy(i,k,jp0)+a_tendency(i,k,j-1)*mrdy
7494 a_fqy(i,k,jp1) = a_fqy(i,k,jp1)-a_tendency(i,k,j-1)*mrdy
7495 end do
7496 end do
7497 endif
7498 if (j .lt. j_start_f .and. degrade_ys) then
7499 k = ktf+1
7500 ! recompute : k
7501 do i = i_start, i_end
7502 a_rv(i,k-2,j_start) = a_rv(i,k-2,j_start)-0.5*a_fqy(i,k,jp1)*fzp(k-1)*(w(i,k,j_start)+w(i,k,j_start-1))
7503 a_rv(i,k-1,j_start) = a_rv(i,k-1,j_start)+0.5*a_fqy(i,k,jp1)*(2-fzm(k-1))*(w(i,k,j_start)+w(i,k,j_start-1))
7504 a_w(i,k,j_start-1) = a_w(i,k,j_start-1)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))
7505 a_w(i,k,j_start) = a_w(i,k,j_start)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))
7506 a_fqy(i,k,jp1) = 0.
7507 end do
7508 do k = kts+1, ktf
7509 do i = i_start, i_end
7510 a_rv(i,k-1,j_start) = a_rv(i,k-1,j_start)+0.5*a_fqy(i,k,jp1)*fzp(k)*(w(i,k,j_start)+w(i,k,j_start-1))
7511 a_rv(i,k,j_start) = a_rv(i,k,j_start)+0.5*a_fqy(i,k,jp1)*fzm(k)*(w(i,k,j_start)+w(i,k,j_start-1))
7512 a_w(i,k,j_start-1) = a_w(i,k,j_start-1)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))
7513 a_w(i,k,j_start) = a_w(i,k,j_start)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))
7514 a_fqy(i,k,jp1) = 0.
7515 end do
7516 end do
7517 else if (j .gt. j_end_f .and. degrade_ye) then
7518 k = ktf+1
7519 ! recompute : k
7520 do i = i_start, i_end
7521 a_rv(i,k-2,j_end+1) = a_rv(i,k-2,j_end+1)-0.5*a_fqy(i,k,jp1)*fzp(k-1)*(w(i,k,j_end+1)+w(i,k,j_end))
7522 a_rv(i,k-1,j_end+1) = a_rv(i,k-1,j_end+1)+0.5*a_fqy(i,k,jp1)*(2-fzm(k-1))*(w(i,k,j_end+1)+w(i,k,j_end))
7523 a_w(i,k,j_end+1) = a_w(i,k,j_end+1)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))
7524 a_w(i,k,j_end) = a_w(i,k,j_end)+0.5*a_fqy(i,k,jp1)*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))
7525 a_fqy(i,k,jp1) = 0.
7526 end do
7527 do k = kts+1, ktf
7528 do i = i_start, i_end
7529 a_rv(i,k-1,j_end+1) = a_rv(i,k-1,j_end+1)+0.5*a_fqy(i,k,jp1)*fzp(k)*(w(i,k,j_end+1)+w(i,k,j_end))
7530 a_rv(i,k,j_end+1) = a_rv(i,k,j_end+1)+0.5*a_fqy(i,k,jp1)*fzm(k)*(w(i,k,j_end+1)+w(i,k,j_end))
7531 a_w(i,k,j_end+1) = a_w(i,k,j_end+1)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))
7532 a_w(i,k,j_end) = a_w(i,k,j_end)+0.5*a_fqy(i,k,jp1)*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))
7533 a_fqy(i,k,jp1) = 0.
7534 end do
7535 end do
7536 else
7537 k = ktf+1
7538 ! recompute : k
7539 do i = i_start, i_end
7540 a_vel = 0.
7541 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
7542 ! recompute : vel
7543 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(w(i,k,j)+w(i,k,j-1))-0.083333333*(w(i,k,j+1)+w(i,k,j-2))+0.083333333*(w(i,k,j+1)-&
7544 &w(i,k,j-2)-3.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))
7545 a_w(i,k,j-2) = a_w(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
7546 a_w(i,k,j-1) = a_w(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
7547 a_w(i,k,j+1) = a_w(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
7548 a_w(i,k,j) = a_w(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
7549 a_fqy(i,k,jp1) = 0.
7550 a_rv(i,k-2,j) = a_rv(i,k-2,j)-a_vel*fzp(k-1)
7551 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*(2-fzm(k-1))
7552 a_vel = 0.
7553 end do
7554 do k = kts+1, ktf
7555 a_vel = 0.
7556 do i = i_start, i_end
7557 a_vel = 0.
7558 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
7559 ! recompute : vel
7560 a_vel = a_vel+a_fqy(i,k,jp1)*(0.58333333*(w(i,k,j)+w(i,k,j-1))-0.083333333*(w(i,k,j+1)+w(i,k,j-2))+0.083333333*(w(i,k,j+&
7561 &1)-w(i,k,j-2)-3.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))
7562 a_w(i,k,j-2) = a_w(i,k,j-2)+a_fqy(i,k,jp1)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
7563 a_w(i,k,j-1) = a_w(i,k,j-1)+a_fqy(i,k,jp1)*vel*(0.58333333+0.25*sign(1.,vel))
7564 a_w(i,k,j+1) = a_w(i,k,j+1)+a_fqy(i,k,jp1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
7565 a_w(i,k,j) = a_w(i,k,j)+a_fqy(i,k,jp1)*vel*(0.58333333+(-0.25)*sign(1.,vel))
7566 a_fqy(i,k,jp1) = 0.
7567 a_rv(i,k-1,j) = a_rv(i,k-1,j)+a_vel*fzp(k)
7568 a_rv(i,k,j) = a_rv(i,k,j)+a_vel*fzm(k)
7569 a_vel = 0.
7570 end do
7571 end do
7572 endif
7573 end do
7574 ! recdepend vars : its
7575 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4757
7576 ! recompute vars : i_start
7577 i_start = its
7578 ! recompute vars : i_start
7579 ! recdepend vars : i_start,ide,ite
7580 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4758
7581 ! recompute vars : i_end
7582 i_end = min(ite,ide-1)
7583 ! recompute vars : i_end
7584 ! recdepend vars : i_end,i_start,jts
7585 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4759
7586 ! recompute vars : j_start
7587 j_start = jts
7588 ! recompute vars : j_start
7589 ! recdepend vars : i_end,i_start,j_start,jde,jte
7590 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4760
7591 ! recompute vars : j_end
7592 j_end = min(jte,jde-1)
7593 ! recompute vars : j_end
7594 ! recdepend vars : degrade_xs,i_end,i_start,ids,j_end,j_start
7595 ! recompute pos : IF_STMT module_advect_em.f90:4768
7596 ! recompute vars : i_start
7597 if (degrade_xs) then
7598 i_start = ids+1
7599 endif
7600 ! recompute vars : i_start
7601 ! recdepend vars : degrade_xe,i_end,i_start,ide,j_end,j_start
7602 ! recompute pos : IF_STMT module_advect_em.f90:4773
7603 ! recompute vars : i_end
7604 if (degrade_xe) then
7605 i_end = ide-2
7606 endif
7607 ! recompute vars : i_end
7608 do j = j_end, j_start, -1
7609 do k = kts+1, ktf+1
7610 do i = i_start, i_end
7611 mrdx = msft(i,j)*rdx
7612 ! recompute : mrdx
7613 a_fqx(i+1,k) = a_fqx(i+1,k)-a_tendency(i,k,j)*mrdx
7614 a_fqx(i,k) = a_fqx(i,k)+a_tendency(i,k,j)*mrdx
7615 end do
7616 end do
7617 if (degrade_xe) then
7618 k = ktf+1
7619 ! recompute : k
7620 a_ru(i_end+1,k-2,j) = a_ru(i_end+1,k-2,j)-0.5*a_fqx(i_end+1,k)*fzp(k-1)*(w(i_end+1,k,j)+w(i_end,k,j))
7621 a_ru(i_end+1,k-1,j) = a_ru(i_end+1,k-1,j)+0.5*a_fqx(i_end+1,k)*(2-fzm(k-1))*(w(i_end+1,k,j)+w(i_end,k,j))
7622 a_w(i_end+1,k,j) = a_w(i_end+1,k,j)+0.5*a_fqx(i_end+1,k)*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))
7623 a_w(i_end,k,j) = a_w(i_end,k,j)+0.5*a_fqx(i_end+1,k)*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))
7624 a_fqx(i_end+1,k) = 0.
7625 do k = kts+1, ktf
7626 a_ru(i_end+1,k-1,j) = a_ru(i_end+1,k-1,j)+0.5*a_fqx(i_end+1,k)*fzp(k)*(w(i_end+1,k,j)+w(i_end,k,j))
7627 a_ru(i_end+1,k,j) = a_ru(i_end+1,k,j)+0.5*a_fqx(i_end+1,k)*fzm(k)*(w(i_end+1,k,j)+w(i_end,k,j))
7628 a_w(i_end+1,k,j) = a_w(i_end+1,k,j)+0.5*a_fqx(i_end+1,k)*(fzm(k)*ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))
7629 a_w(i_end,k,j) = a_w(i_end,k,j)+0.5*a_fqx(i_end+1,k)*(fzm(k)*ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))
7630 a_fqx(i_end+1,k) = 0.
7631 end do
7632 endif
7633 if (degrade_xs) then
7634 k = ktf+1
7635 ! recompute : k
7636 a_ru(i_start,k-2,j) = a_ru(i_start,k-2,j)-0.5*a_fqx(i_start,k)*fzp(k-1)*(w(i_start,k,j)+w(i_start-1,k,j))
7637 a_ru(i_start,k-1,j) = a_ru(i_start,k-1,j)+0.5*a_fqx(i_start,k)*(2-fzm(k-1))*(w(i_start,k,j)+w(i_start-1,k,j))
7638 a_w(i_start-1,k,j) = a_w(i_start-1,k,j)+0.5*a_fqx(i_start,k)*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))
7639 a_w(i_start,k,j) = a_w(i_start,k,j)+0.5*a_fqx(i_start,k)*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))
7640 a_fqx(i_start,k) = 0.
7641 do k = kts+1, ktf
7642 a_ru(i_start,k-1,j) = a_ru(i_start,k-1,j)+0.5*a_fqx(i_start,k)*fzp(k)*(w(i_start,k,j)+w(i_start-1,k,j))
7643 a_ru(i_start,k,j) = a_ru(i_start,k,j)+0.5*a_fqx(i_start,k)*fzm(k)*(w(i_start,k,j)+w(i_start-1,k,j))
7644 a_w(i_start-1,k,j) = a_w(i_start-1,k,j)+0.5*a_fqx(i_start,k)*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))
7645 a_w(i_start,k,j) = a_w(i_start,k,j)+0.5*a_fqx(i_start,k)*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))
7646 a_fqx(i_start,k) = 0.
7647 end do
7648 endif
7649 ! recdepend vars : ktf
7650 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4790
7651 ! recompute vars : k
7652 k = ktf+1
7653 ! recompute vars : k
7654 do i = i_start_f, i_end_f
7655 a_vel = 0.
7656 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
7657 ! recompute : vel
7658 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(w(i,k,j)+w(i-1,k,j))-0.083333333*(w(i+1,k,j)+w(i-2,k,j))+0.083333333*(w(i+1,k,j)-w(i-2,&
7659 &k,j)-3.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))
7660 a_w(i-2,k,j) = a_w(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
7661 a_w(i-1,k,j) = a_w(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
7662 a_w(i+1,k,j) = a_w(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
7663 a_w(i,k,j) = a_w(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
7664 a_fqx(i,k) = 0.
7665 a_ru(i,k-2,j) = a_ru(i,k-2,j)-a_vel*fzp(k-1)
7666 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*(2-fzm(k-1))
7667 a_vel = 0.
7668 end do
7669 do k = kts+1, ktf
7670 a_vel = 0.
7671 do i = i_start_f, i_end_f
7672 a_vel = 0.
7673 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
7674 ! recompute : vel
7675 a_vel = a_vel+a_fqx(i,k)*(0.58333333*(w(i,k,j)+w(i-1,k,j))-0.083333333*(w(i+1,k,j)+w(i-2,k,j))+0.083333333*(w(i+1,k,j)-w(i-&
7676 &2,k,j)-3.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))
7677 a_w(i-2,k,j) = a_w(i-2,k,j)+a_fqx(i,k)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))
7678 a_w(i-1,k,j) = a_w(i-1,k,j)+a_fqx(i,k)*vel*(0.58333333+0.25*sign(1.,vel))
7679 a_w(i+1,k,j) = a_w(i+1,k,j)+a_fqx(i,k)*vel*((-0.083333333)+0.083333333*sign(1.,vel))
7680 a_w(i,k,j) = a_w(i,k,j)+a_fqx(i,k)*vel*(0.58333333+(-0.25)*sign(1.,vel))
7681 a_fqx(i,k) = 0.
7682 a_ru(i,k-1,j) = a_ru(i,k-1,j)+a_vel*fzp(k)
7683 a_ru(i,k,j) = a_ru(i,k,j)+a_vel*fzm(k)
7684 a_vel = 0.
7685 end do
7686 end do
7687 end do
7688 else if (horz_order .eq. 2) then a_horizontal_order_test
7689 j_start = jts
7690 ! recompute : j_start
7691 j_end = min(jte,jde-1)
7692 ! recompute : j_end
7693 i_start = its
7694 ! recompute : i_start
7695 i_end = min(ite,ide-1)
7696 ! recompute : i_end
7697 if (config_flags%open_ys .or. specified) then
7698 j_start = max(jds+1,jts)
7699 endif
7700 ! recompute : j_start
7701 if (config_flags%open_ye .or. specified) then
7702 j_end = min(jde-2,jte)
7703 endif
7704 ! recompute : j_end
7705 do j = j_end, j_start, -1
7706 k = ktf+1
7707 ! recompute : k
7708 do i = i_start, i_end
7709 mrdy = msft(i,j)*rdy
7710 ! recompute : mrdy
7711 a_rv(i,k-2,j+1) = a_rv(i,k-2,j+1)+0.5*a_tendency(i,k,j)*mrdy*fzp(k-1)*(w(i,k,j+1)+w(i,k,j))
7712 a_rv(i,k-2,j) = a_rv(i,k-2,j)-0.5*a_tendency(i,k,j)*mrdy*fzp(k-1)*(w(i,k,j)+w(i,k,j-1))
7713 a_rv(i,k-1,j+1) = a_rv(i,k-1,j+1)-0.5*a_tendency(i,k,j)*mrdy*(2-fzm(k-1))*(w(i,k,j+1)+w(i,k,j))
7714 a_rv(i,k-1,j) = a_rv(i,k-1,j)+0.5*a_tendency(i,k,j)*mrdy*(2-fzm(k-1))*(w(i,k,j)+w(i,k,j-1))
7715 a_w(i,k,j-1) = a_w(i,k,j-1)+0.5*a_tendency(i,k,j)*mrdy*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))
7716 a_w(i,k,j+1) = a_w(i,k,j+1)-0.5*a_tendency(i,k,j)*mrdy*((2.-fzm(k-1))*rv(i,k-1,j+1)-fzp(k-1)*rv(i,k-2,j+1))
7717 a_w(i,k,j) = a_w(i,k,j)-0.5*a_tendency(i,k,j)*mrdy*((2.-fzm(k-1))*rv(i,k-1,j+1)-fzp(k-1)*rv(i,k-2,j+1)-((2.-fzm(k-1))*rv(i,k-&
7718 &1,j)-fzp(k-1)*rv(i,k-2,j)))
7719 end do
7720 do k = kts+1, ktf
7721 do i = i_start, i_end
7722 mrdy = msft(i,j)*rdy
7723 ! recompute : mrdy
7724 a_rv(i,k-1,j+1) = a_rv(i,k-1,j+1)-0.5*a_tendency(i,k,j)*mrdy*fzp(k)*(w(i,k,j+1)+w(i,k,j))
7725 a_rv(i,k-1,j) = a_rv(i,k-1,j)+0.5*a_tendency(i,k,j)*mrdy*fzp(k)*(w(i,k,j)+w(i,k,j-1))
7726 a_rv(i,k,j+1) = a_rv(i,k,j+1)-0.5*a_tendency(i,k,j)*mrdy*fzm(k)*(w(i,k,j+1)+w(i,k,j))
7727 a_rv(i,k,j) = a_rv(i,k,j)+0.5*a_tendency(i,k,j)*mrdy*fzm(k)*(w(i,k,j)+w(i,k,j-1))
7728 a_w(i,k,j-1) = a_w(i,k,j-1)+0.5*a_tendency(i,k,j)*mrdy*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))
7729 a_w(i,k,j+1) = a_w(i,k,j+1)-0.5*a_tendency(i,k,j)*mrdy*(fzm(k)*rv(i,k,j+1)+fzp(k)*rv(i,k-1,j+1))
7730 a_w(i,k,j) = a_w(i,k,j)-0.5*a_tendency(i,k,j)*mrdy*(fzm(k)*rv(i,k,j+1)+fzp(k)*rv(i,k-1,j+1)-(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,&
7731 &k-1,j)))
7732 end do
7733 end do
7734 end do
7735 ! recdepend vars : its
7736 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4929
7737 ! recompute vars : i_start
7738 i_start = its
7739 ! recompute vars : i_start
7740 ! recdepend vars : i_start,ide,ite
7741 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4930
7742 ! recompute vars : i_end
7743 i_end = min(ite,ide-1)
7744 ! recompute vars : i_end
7745 ! recdepend vars : i_end,i_start,jts
7746 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4931
7747 ! recompute vars : j_start
7748 j_start = jts
7749 ! recompute vars : j_start
7750 ! recdepend vars : i_end,i_start,j_start,jde,jte
7751 ! recompute pos : ASSIGN_STMT module_advect_em.f90:4932
7752 ! recompute vars : j_end
7753 j_end = min(jte,jde-1)
7754 ! recompute vars : j_end
7755 ! recdepend vars : config_flags,i_end,i_start,ids,its,j_end,j_start,spe
7756 ! cified
7757 ! recompute pos : IF_STMT module_advect_em.f90:4934
7758 ! recompute vars : i_start
7759 if (config_flags%open_xs .or. specified) then
7760 i_start = max(ids+1,its)
7761 endif
7762 ! recompute vars : i_start
7763 ! recdepend vars : config_flags,i_end,i_start,ide,ite,j_end,j_start,spe
7764 ! cified
7765 ! recompute pos : IF_STMT module_advect_em.f90:4935
7766 ! recompute vars : i_end
7767 if (config_flags%open_xe .or. specified) then
7768 i_end = min(ide-2,ite)
7769 endif
7770 ! recompute vars : i_end
7771 do j = j_end, j_start, -1
7772 k = ktf+1
7773 ! recompute : k
7774 do i = i_start, i_end
7775 mrdx = msft(i,j)*rdx
7776 ! recompute : mrdx
7777 a_ru(i+1,k-2,j) = a_ru(i+1,k-2,j)+0.5*a_tendency(i,k,j)*mrdx*fzp(k-1)*(w(i+1,k,j)+w(i,k,j))
7778 a_ru(i,k-2,j) = a_ru(i,k-2,j)-0.5*a_tendency(i,k,j)*mrdx*fzp(k-1)*(w(i,k,j)+w(i-1,k,j))
7779 a_ru(i+1,k-1,j) = a_ru(i+1,k-1,j)-0.5*a_tendency(i,k,j)*mrdx*(2-fzm(k-1))*(w(i+1,k,j)+w(i,k,j))
7780 a_ru(i,k-1,j) = a_ru(i,k-1,j)+0.5*a_tendency(i,k,j)*mrdx*(2-fzm(k-1))*(w(i,k,j)+w(i-1,k,j))
7781 a_w(i-1,k,j) = a_w(i-1,k,j)+0.5*a_tendency(i,k,j)*mrdx*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))
7782 a_w(i+1,k,j) = a_w(i+1,k,j)-0.5*a_tendency(i,k,j)*mrdx*((2.-fzm(k-1))*ru(i+1,k-1,j)-fzp(k-1)*ru(i+1,k-2,j))
7783 a_w(i,k,j) = a_w(i,k,j)-0.5*a_tendency(i,k,j)*mrdx*((2.-fzm(k-1))*ru(i+1,k-1,j)-fzp(k-1)*ru(i+1,k-2,j)-((2.-fzm(k-1))*ru(i,k-&
7784 &1,j)-fzp(k-1)*ru(i,k-2,j)))
7785 end do
7786 do k = kts+1, ktf
7787 do i = i_start, i_end
7788 mrdx = msft(i,j)*rdx
7789 ! recompute : mrdx
7790 a_ru(i+1,k-1,j) = a_ru(i+1,k-1,j)-0.5*a_tendency(i,k,j)*mrdx*fzp(k)*(w(i+1,k,j)+w(i,k,j))
7791 a_ru(i,k-1,j) = a_ru(i,k-1,j)+0.5*a_tendency(i,k,j)*mrdx*fzp(k)*(w(i,k,j)+w(i-1,k,j))
7792 a_ru(i+1,k,j) = a_ru(i+1,k,j)-0.5*a_tendency(i,k,j)*mrdx*fzm(k)*(w(i+1,k,j)+w(i,k,j))
7793 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_tendency(i,k,j)*mrdx*fzm(k)*(w(i,k,j)+w(i-1,k,j))
7794 a_w(i-1,k,j) = a_w(i-1,k,j)+0.5*a_tendency(i,k,j)*mrdx*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))
7795 a_w(i+1,k,j) = a_w(i+1,k,j)-0.5*a_tendency(i,k,j)*mrdx*(fzm(k)*ru(i+1,k,j)+fzp(k)*ru(i+1,k-1,j))
7796 a_w(i,k,j) = a_w(i,k,j)-0.5*a_tendency(i,k,j)*mrdx*(fzm(k)*ru(i+1,k,j)+fzp(k)*ru(i+1,k-1,j)-(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,&
7797 &k-1,j)))
7798 end do
7799 end do
7800 end do
7801 endif a_horizontal_order_test
7802
7803 end subroutine a_advect_w
7804
7805
7806 end module a_module_advect_em
7807
7808