module_advect_em_tl.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 g_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 g_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 g_advect_scalar( field, g_field, field_old, g_field_old, tendency, g_tendency, ru, g_ru, rv, g_rv, rom, g_rom, &
46 &config_flags, msft, 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 type (grid_config_rec_type), intent(in) :: config_flags
62 integer, intent(in) :: ime
63 integer, intent(in) :: ims
64 integer, intent(in) :: jme
65 integer, intent(in) :: jms
66 integer, intent(in) :: kme
67 integer, intent(in) :: kms
68 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
69 real, intent(in) :: field_old(ims:ime,kms:kme,jms:jme)
70 real, intent(in) :: fzm(kms:kme)
71 real, intent(in) :: fzp(kms:kme)
72 real, intent(in) :: g_field(ims:ime,kms:kme,jms:jme)
73 real, intent(in) :: g_field_old(ims:ime,kms:kme,jms:jme)
74 real, intent(in) :: g_rom(ims:ime,kms:kme,jms:jme)
75 real, intent(in) :: g_ru(ims:ime,kms:kme,jms:jme)
76 real, intent(in) :: g_rv(ims:ime,kms:kme,jms:jme)
77 real, intent(inout) :: g_tendency(ims:ime,kms:kme,jms:jme)
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 real, intent(inout) :: tendency(ims:ime,kms:kme,jms:jme)
97
98 !==============================================
99 ! declare local variables
100 !==============================================
101 logical degrade_xe
102 logical degrade_xs
103 logical degrade_ye
104 logical degrade_ys
105 real fqx(its:ite+1,kts:kte)
106 real fqy(its:ite,kts:kte,2)
107 real g_fqx(its:ite+1,kts:kte)
108 real g_fqy(its:ite,kts:kte,2)
109 real g_ub
110 real g_vb
111 real g_vel
112 real g_vflux(its:ite,kts:kte)
113 integer horz_order
114 integer i
115 integer i_end
116 integer i_end_f
117 integer i_start
118 integer i_start_f
119 integer j
120 integer j_end
121 integer j_end_f
122 integer j_start
123 integer j_start_f
124 integer jp0
125 integer jp1
126 integer jtmp
127 integer k
128 integer ktf
129 real mrdx
130 real mrdy
131 logical specified
132 real ub
133 real vb
134 real vel
135 integer vert_order
136 real vflux(its:ite,kts:kte)
137
138 !----------------------------------------------
139 ! TANGENT LINEAR AND FUNCTION STATEMENTS
140 !----------------------------------------------
141 specified = .false.
142 if (config_flags%specified .or. config_flags%nested) then
143 specified = .true.
144 endif
145 ktf = min(kte,kde-1)
146 horz_order = config_flags%h_sca_adv_order
147 vert_order = config_flags%v_sca_adv_order
148 horizontal_order_tesu: if (horz_order .eq. 6) then
149 degrade_xs = .true.
150 degrade_xe = .true.
151 degrade_ys = .true.
152 degrade_ye = .true.
153 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
154 degrade_xs = .false.
155 endif
156 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-3) then
157 degrade_xe = .false.
158 endif
159 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
160 degrade_ys = .false.
161 endif
162 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-3) then
163 degrade_ye = .false.
164 endif
165 ktf = min(kte,kde-1)
166 i_start = its
167 i_end = min(ite,ide-1)
168 j_start = jts
169 j_end = min(jte,jde-1)
170 j_start_f = j_start
171 j_end_f = j_end+1
172 if (degrade_ys) then
173 j_start = max(jts,jds+1)
174 j_start_f = jds+3
175 endif
176 if (degrade_ye) then
177 j_end = min(jte,jde-2)
178 j_end_f = jde-3
179 endif
180 jp1 = 2
181 jp0 = 1
182 j_loop_y_flux_6: do j = j_start, j_end+1
183 if (j .ge. j_start_f .and. j .le. j_end_f) then
184 do k = kts, ktf
185 do i = i_start, i_end
186 g_vel = g_rv(i,k,j)
187 vel = rv(i,k,j)
188 g_fqy(i,k,jp1) = 0.016666667*g_field(i,k,j-3)*vel-0.13333333*g_field(i,k,j-2)*vel+0.61666667*g_field(i,k,j-1)*vel+&
189 &0.016666667*g_field(i,k,j+2)*vel-0.13333333*g_field(i,k,j+1)*vel+0.61666667*g_field(i,k,j)*vel+g_vel*(0.61666667*&
190 &(field(i,k,j)+field(i,k,j-1))-0.13333333*(field(i,k,j+1)+field(i,k,j-2))+0.016666667*(field(i,k,j+2)+field(i,k,j-3)))
191 fqy(i,k,jp1) = vel*(37./60.*(field(i,k,j)+field(i,k,j-1))-2./15.*(field(i,k,j+1)+field(i,k,j-2))+1./60.*(field(i,k,j+2)+&
192 &field(i,k,j-3)))
193 end do
194 end do
195 else if (j .eq. jds+1) then
196 do k = kts, ktf
197 do i = i_start, i_end
198 g_fqy(i,k,jp1) = 0.5*g_field(i,k,j-1)*rv(i,k,j)+0.5*g_field(i,k,j)*rv(i,k,j)+0.5*g_rv(i,k,j)*(field(i,k,j)+field(i,k,j-1))
199 fqy(i,k,jp1) = 0.5*rv(i,k,j)*(field(i,k,j)+field(i,k,j-1))
200 end do
201 end do
202 else if (j .eq. jds+2) then
203 do k = kts, ktf
204 do i = i_start, i_end
205 g_vel = g_rv(i,k,j)
206 vel = rv(i,k,j)
207 g_fqy(i,k,jp1) = (-0.083333333)*g_field(i,k,j-2)*vel+0.58333333*g_field(i,k,j-1)*vel-0.083333333*g_field(i,k,j+1)*vel+&
208 &0.58333333*g_field(i,k,j)*vel+g_vel*(0.58333333*(field(i,k,j)+field(i,k,j-1))-0.083333333*(field(i,k,j+1)+field(i,k,j-2)))
209 fqy(i,k,jp1) = vel*(7./12.*(field(i,k,j)+field(i,k,j-1))-1./12.*(field(i,k,j+1)+field(i,k,j-2)))
210 end do
211 end do
212 else if (j .eq. jde-1) then
213 do k = kts, ktf
214 do i = i_start, i_end
215 g_fqy(i,k,jp1) = 0.5*g_field(i,k,j-1)*rv(i,k,j)+0.5*g_field(i,k,j)*rv(i,k,j)+0.5*g_rv(i,k,j)*(field(i,k,j)+field(i,k,j-1))
216 fqy(i,k,jp1) = 0.5*rv(i,k,j)*(field(i,k,j)+field(i,k,j-1))
217 end do
218 end do
219 else if (j .eq. jde-2) then
220 do k = kts, ktf
221 do i = i_start, i_end
222 g_vel = g_rv(i,k,j)
223 vel = rv(i,k,j)
224 g_fqy(i,k,jp1) = (-0.083333333)*g_field(i,k,j-2)*vel+0.58333333*g_field(i,k,j-1)*vel-0.083333333*g_field(i,k,j+1)*vel+&
225 &0.58333333*g_field(i,k,j)*vel+g_vel*(0.58333333*(field(i,k,j)+field(i,k,j-1))-0.083333333*(field(i,k,j+1)+field(i,k,j-2)))
226 fqy(i,k,jp1) = vel*(7./12.*(field(i,k,j)+field(i,k,j-1))-1./12.*(field(i,k,j+1)+field(i,k,j-2)))
227 end do
228 end do
229 endif
230 if (j .gt. j_start) then
231 do k = kts, ktf
232 do i = i_start, i_end
233 mrdy = msft(i,j-1)*rdy
234 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
235 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
236 end do
237 end do
238 endif
239 jtmp = jp1
240 jp1 = jp0
241 jp0 = jtmp
242 end do j_loop_y_flux_6
243 i_start = its
244 i_end = min(ite,ide-1)
245 j_start = jts
246 j_end = min(jte,jde-1)
247 i_start_f = i_start
248 i_end_f = i_end+1
249 if (degrade_xs) then
250 i_start = max(ids+1,its)
251 i_start_f = i_start+2
252 endif
253 if (degrade_xe) then
254 i_end = min(ide-2,ite)
255 i_end_f = ide-3
256 endif
257 do j = j_start, j_end
258 do k = kts, ktf
259 do i = i_start_f, i_end_f
260 g_vel = g_ru(i,k,j)
261 vel = ru(i,k,j)
262 g_fqx(i,k) = 0.016666667*g_field(i-3,k,j)*vel-0.13333333*g_field(i-2,k,j)*vel+0.61666667*g_field(i-1,k,j)*vel+0.016666667*&
263 &g_field(i+2,k,j)*vel-0.13333333*g_field(i+1,k,j)*vel+0.61666667*g_field(i,k,j)*vel+g_vel*(0.61666667*(field(i,k,j)+&
264 &field(i-1,k,j))-0.13333333*(field(i+1,k,j)+field(i-2,k,j))+0.016666667*(field(i+2,k,j)+field(i-3,k,j)))
265 fqx(i,k) = vel*(37./60.*(field(i,k,j)+field(i-1,k,j))-2./15.*(field(i+1,k,j)+field(i-2,k,j))+1./60.*(field(i+2,k,j)+&
266 &field(i-3,k,j)))
267 end do
268 end do
269 if (degrade_xs) then
270 if (i_start .eq. ids+1) then
271 i = ids+1
272 do k = kts, ktf
273 g_fqx(i,k) = 0.5*g_field(i-1,k,j)*ru(i,k,j)+0.5*g_field(i,k,j)*ru(i,k,j)+0.5*g_ru(i,k,j)*(field(i,k,j)+field(i-1,k,j))
274 fqx(i,k) = 0.5*ru(i,k,j)*(field(i,k,j)+field(i-1,k,j))
275 end do
276 endif
277 i = ids+2
278 do k = kts, ktf
279 g_vel = g_ru(i,k,j)
280 vel = ru(i,k,j)
281 g_fqx(i,k) = (-0.083333333)*g_field(i-2,k,j)*vel+0.58333333*g_field(i-1,k,j)*vel-0.083333333*g_field(i+1,k,j)*vel+&
282 &0.58333333*g_field(i,k,j)*vel+g_vel*(0.58333333*(field(i,k,j)+field(i-1,k,j))-0.083333333*(field(i+1,k,j)+field(i-2,k,j)))
283 fqx(i,k) = vel*(7./12.*(field(i,k,j)+field(i-1,k,j))-1./12.*(field(i+1,k,j)+field(i-2,k,j)))
284 end do
285 endif
286 if (degrade_xe) then
287 if (i_end .eq. ide-2) then
288 i = ide-1
289 do k = kts, ktf
290 g_fqx(i,k) = 0.5*g_field(i-1,k,j)*ru(i,k,j)+0.5*g_field(i,k,j)*ru(i,k,j)+0.5*g_ru(i,k,j)*(field(i,k,j)+field(i-1,k,j))
291 fqx(i,k) = 0.5*ru(i,k,j)*(field(i,k,j)+field(i-1,k,j))
292 end do
293 endif
294 i = ide-2
295 do k = kts, ktf
296 g_vel = g_ru(i,k,j)
297 vel = ru(i,k,j)
298 g_fqx(i,k) = (-0.083333333)*g_field(i-2,k,j)*vel+0.58333333*g_field(i-1,k,j)*vel-0.083333333*g_field(i+1,k,j)*vel+&
299 &0.58333333*g_field(i,k,j)*vel+g_vel*(0.58333333*(field(i,k,j)+field(i-1,k,j))-0.083333333*(field(i+1,k,j)+field(i-2,k,j)))
300 fqx(i,k) = vel*(7./12.*(field(i,k,j)+field(i-1,k,j))-1./12.*(field(i+1,k,j)+field(i-2,k,j)))
301 end do
302 endif
303 do k = kts, ktf
304 do i = i_start, i_end
305 mrdx = msft(i,j)*rdx
306 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
307 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
308 end do
309 end do
310 end do
311 else if (horz_order .eq. 5) then horizontal_order_tesu
312 degrade_xs = .true.
313 degrade_xe = .true.
314 degrade_ys = .true.
315 degrade_ye = .true.
316 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
317 degrade_xs = .false.
318 endif
319 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-3) then
320 degrade_xe = .false.
321 endif
322 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
323 degrade_ys = .false.
324 endif
325 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-3) then
326 degrade_ye = .false.
327 endif
328 ktf = min(kte,kde-1)
329 i_start = its
330 i_end = min(ite,ide-1)
331 j_start = jts
332 j_end = min(jte,jde-1)
333 j_start_f = j_start
334 j_end_f = j_end+1
335 if (degrade_ys) then
336 j_start = max(jts,jds+1)
337 j_start_f = jds+3
338 endif
339 if (degrade_ye) then
340 j_end = min(jte,jde-2)
341 j_end_f = jde-3
342 endif
343 jp1 = 2
344 jp0 = 1
345 j_loop_y_flux_5: do j = j_start, j_end+1
346 if (j .ge. j_start_f .and. j .le. j_end_f) then
347 do k = kts, ktf
348 do i = i_start, i_end
349 g_vel = g_rv(i,k,j)
350 vel = rv(i,k,j)
351 g_fqy(i,k,jp1) = g_field(i,k,j-3)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))+g_field(i,k,j-2)*vel*((-0.13333333)-&
352 &0.083333333*sign(1.,vel))+g_field(i,k,j-1)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))+g_field(i,k,j+2)*vel*&
353 &(0.016666667-0.016666667*sign(1.,vel))+g_field(i,k,j+1)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))+g_field(i,k,j)*&
354 &vel*(0.61666667-0.16666667*sign(1.,vel))+g_vel*(0.61666667*(field(i,k,j)+field(i,k,j-1))-0.13333333*(field(i,k,j+1)+&
355 &field(i,k,j-2))+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+&
356 &1)-field(i,k,j-2))+10.*(field(i,k,j)-field(i,k,j-1)))*sign(1.,vel))
357 fqy(i,k,jp1) = vel*(37./60.*(field(i,k,j)+field(i,k,j-1))-2./15.*(field(i,k,j+1)+field(i,k,j-2))+1./60.*(field(i,k,j+2)+&
358 &field(i,k,j-3))-sign(1.,vel)*(1./60.)*(field(i,k,j+2)-field(i,k,j-3)-5.*(field(i,k,j+1)-field(i,k,j-2))+10.*(field(i,k,&
359 &j)-field(i,k,j-1))))
360 end do
361 end do
362 else if (j .eq. jds+1) then
363 do k = kts, ktf
364 do i = i_start, i_end
365 g_fqy(i,k,jp1) = 0.5*g_field(i,k,j-1)*rv(i,k,j)+0.5*g_field(i,k,j)*rv(i,k,j)+0.5*g_rv(i,k,j)*(field(i,k,j)+field(i,k,j-1))
366 fqy(i,k,jp1) = 0.5*rv(i,k,j)*(field(i,k,j)+field(i,k,j-1))
367 end do
368 end do
369 else if (j .eq. jds+2) then
370 do k = kts, ktf
371 do i = i_start, i_end
372 g_vel = g_rv(i,k,j)
373 vel = rv(i,k,j)
374 g_fqy(i,k,jp1) = g_field(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_field(i,k,j-1)*vel*(0.58333333+0.25*&
375 &sign(1.,vel))+g_field(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_field(i,k,j)*vel*(0.58333333+(-0.25)*&
376 &sign(1.,vel))+g_vel*(0.58333333*(field(i,k,j)+field(i,k,j-1))-0.083333333*(field(i,k,j+1)+field(i,k,j-2))+0.083333333*&
377 &(field(i,k,j+1)-field(i,k,j-2)-3.*(field(i,k,j)-field(i,k,j-1)))*sign(1.,vel))
378 fqy(i,k,jp1) = vel*(7./12.*(field(i,k,j)+field(i,k,j-1))-1./12.*(field(i,k,j+1)+field(i,k,j-2))+sign(1.,vel)*(1./12.)*&
379 &(field(i,k,j+1)-field(i,k,j-2)-3.*(field(i,k,j)-field(i,k,j-1))))
380 end do
381 end do
382 else if (j .eq. jde-1) then
383 do k = kts, ktf
384 do i = i_start, i_end
385 g_fqy(i,k,jp1) = 0.5*g_field(i,k,j-1)*rv(i,k,j)+0.5*g_field(i,k,j)*rv(i,k,j)+0.5*g_rv(i,k,j)*(field(i,k,j)+field(i,k,j-1))
386 fqy(i,k,jp1) = 0.5*rv(i,k,j)*(field(i,k,j)+field(i,k,j-1))
387 end do
388 end do
389 else if (j .eq. jde-2) then
390 do k = kts, ktf
391 do i = i_start, i_end
392 g_vel = g_rv(i,k,j)
393 vel = rv(i,k,j)
394 g_fqy(i,k,jp1) = g_field(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_field(i,k,j-1)*vel*(0.58333333+0.25*&
395 &sign(1.,vel))+g_field(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_field(i,k,j)*vel*(0.58333333+(-0.25)*&
396 &sign(1.,vel))+g_vel*(0.58333333*(field(i,k,j)+field(i,k,j-1))-0.083333333*(field(i,k,j+1)+field(i,k,j-2))+0.083333333*&
397 &(field(i,k,j+1)-field(i,k,j-2)-3.*(field(i,k,j)-field(i,k,j-1)))*sign(1.,vel))
398 fqy(i,k,jp1) = vel*(7./12.*(field(i,k,j)+field(i,k,j-1))-1./12.*(field(i,k,j+1)+field(i,k,j-2))+sign(1.,vel)*(1./12.)*&
399 &(field(i,k,j+1)-field(i,k,j-2)-3.*(field(i,k,j)-field(i,k,j-1))))
400 end do
401 end do
402 endif
403 if (j .gt. j_start) then
404 do k = kts, ktf
405 do i = i_start, i_end
406 mrdy = msft(i,j-1)*rdy
407 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
408 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
409 end do
410 end do
411 endif
412 jtmp = jp1
413 jp1 = jp0
414 jp0 = jtmp
415 end do j_loop_y_flux_5
416 i_start = its
417 i_end = min(ite,ide-1)
418 j_start = jts
419 j_end = min(jte,jde-1)
420 i_start_f = i_start
421 i_end_f = i_end+1
422 if (degrade_xs) then
423 i_start = max(ids+1,its)
424 i_start_f = i_start+2
425 endif
426 if (degrade_xe) then
427 i_end = min(ide-2,ite)
428 i_end_f = ide-3
429 endif
430 do j = j_start, j_end
431 do k = kts, ktf
432 do i = i_start_f, i_end_f
433 g_vel = g_ru(i,k,j)
434 vel = ru(i,k,j)
435 g_fqx(i,k) = g_field(i-3,k,j)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))+g_field(i-2,k,j)*vel*((-0.13333333)-&
436 &0.083333333*sign(1.,vel))+g_field(i-1,k,j)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))+g_field(i+2,k,j)*vel*(0.016666667-&
437 &0.016666667*sign(1.,vel))+g_field(i+1,k,j)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))+g_field(i,k,j)*vel*(0.61666667-&
438 &0.16666667*sign(1.,vel))+g_vel*(0.61666667*(field(i,k,j)+field(i-1,k,j))-0.13333333*(field(i+1,k,j)+field(i-2,k,j))+&
439 &0.016666667*(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))+&
440 &10.*(field(i,k,j)-field(i-1,k,j)))*sign(1.,vel))
441 fqx(i,k) = vel*(37./60.*(field(i,k,j)+field(i-1,k,j))-2./15.*(field(i+1,k,j)+field(i-2,k,j))+1./60.*(field(i+2,k,j)+&
442 &field(i-3,k,j))-sign(1.,vel)*(1./60.)*(field(i+2,k,j)-field(i-3,k,j)-5.*(field(i+1,k,j)-field(i-2,k,j))+10.*(field(i,k,j)-&
443 &field(i-1,k,j))))
444 end do
445 end do
446 if (degrade_xs) then
447 if (i_start .eq. ids+1) then
448 i = ids+1
449 do k = kts, ktf
450 g_fqx(i,k) = 0.5*g_field(i-1,k,j)*ru(i,k,j)+0.5*g_field(i,k,j)*ru(i,k,j)+0.5*g_ru(i,k,j)*(field(i,k,j)+field(i-1,k,j))
451 fqx(i,k) = 0.5*ru(i,k,j)*(field(i,k,j)+field(i-1,k,j))
452 end do
453 endif
454 i = ids+2
455 do k = kts, ktf
456 g_vel = g_ru(i,k,j)
457 vel = ru(i,k,j)
458 g_fqx(i,k) = g_field(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_field(i-1,k,j)*vel*(0.58333333+0.25*&
459 &sign(1.,vel))+g_field(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_field(i,k,j)*vel*(0.58333333+(-0.25)*&
460 &sign(1.,vel))+g_vel*(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*&
461 &(field(i+1,k,j)-field(i-2,k,j)-3.*(field(i,k,j)-field(i-1,k,j)))*sign(1.,vel))
462 fqx(i,k) = vel*(7./12.*(field(i,k,j)+field(i-1,k,j))-1./12.*(field(i+1,k,j)+field(i-2,k,j))+sign(1.,vel)*(1./12.)*(field(i+&
463 &1,k,j)-field(i-2,k,j)-3.*(field(i,k,j)-field(i-1,k,j))))
464 end do
465 endif
466 if (degrade_xe) then
467 if (i_end .eq. ide-2) then
468 i = ide-1
469 do k = kts, ktf
470 g_fqx(i,k) = 0.5*g_field(i-1,k,j)*ru(i,k,j)+0.5*g_field(i,k,j)*ru(i,k,j)+0.5*g_ru(i,k,j)*(field(i,k,j)+field(i-1,k,j))
471 fqx(i,k) = 0.5*ru(i,k,j)*(field(i,k,j)+field(i-1,k,j))
472 end do
473 endif
474 i = ide-2
475 do k = kts, ktf
476 g_vel = g_ru(i,k,j)
477 vel = ru(i,k,j)
478 g_fqx(i,k) = g_field(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_field(i-1,k,j)*vel*(0.58333333+0.25*&
479 &sign(1.,vel))+g_field(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_field(i,k,j)*vel*(0.58333333+(-0.25)*&
480 &sign(1.,vel))+g_vel*(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*&
481 &(field(i+1,k,j)-field(i-2,k,j)-3.*(field(i,k,j)-field(i-1,k,j)))*sign(1.,vel))
482 fqx(i,k) = vel*(7./12.*(field(i,k,j)+field(i-1,k,j))-1./12.*(field(i+1,k,j)+field(i-2,k,j))+sign(1.,vel)*(1./12.)*(field(i+&
483 &1,k,j)-field(i-2,k,j)-3.*(field(i,k,j)-field(i-1,k,j))))
484 end do
485 endif
486 do k = kts, ktf
487 do i = i_start, i_end
488 mrdx = msft(i,j)*rdx
489 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
490 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
491 end do
492 end do
493 end do
494 else if (horz_order .eq. 4) then horizontal_order_tesu
495 degrade_xs = .true.
496 degrade_xe = .true.
497 degrade_ys = .true.
498 degrade_ye = .true.
499 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
500 degrade_xs = .false.
501 endif
502 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
503 degrade_xe = .false.
504 endif
505 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
506 degrade_ys = .false.
507 endif
508 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
509 degrade_ye = .false.
510 endif
511 ktf = min(kte,kde-1)
512 i_start = its
513 i_end = min(ite,ide-1)
514 j_start = jts
515 j_end = min(jte,jde-1)
516 i_start_f = i_start
517 i_end_f = i_end+1
518 if (degrade_xs) then
519 i_start = ids+1
520 i_start_f = i_start+1
521 endif
522 if (degrade_xe) then
523 i_end = ide-2
524 i_end_f = ide-2
525 endif
526 do j = j_start, j_end
527 do k = kts, ktf
528 do i = i_start_f, i_end_f
529 g_fqx(i,k) = (-0.083333333)*g_field(i-2,k,j)*ru(i,k,j)+0.58333333*g_field(i-1,k,j)*ru(i,k,j)-0.083333333*g_field(i+1,k,j)*&
530 &ru(i,k,j)+0.58333333*g_field(i,k,j)*ru(i,k,j)+g_ru(i,k,j)*(0.58333333*(field(i,k,j)+field(i-1,k,j))-0.083333333*(field(i+&
531 &1,k,j)+field(i-2,k,j)))
532 fqx(i,k) = ru(i,k,j)*(7./12.*(field(i,k,j)+field(i-1,k,j))-1./12.*(field(i+1,k,j)+field(i-2,k,j)))
533 end do
534 end do
535 if (degrade_xs) then
536 do k = kts, ktf
537 g_fqx(i_start,k) = 0.5*g_field(i_start-1,k,j)*ru(i_start,k,j)+0.5*g_field(i_start,k,j)*ru(i_start,k,j)+0.5*g_ru(i_start,k,&
538 &j)*(field(i_start,k,j)+field(i_start-1,k,j))
539 fqx(i_start,k) = 0.5*ru(i_start,k,j)*(field(i_start,k,j)+field(i_start-1,k,j))
540 end do
541 endif
542 if (degrade_xe) then
543 do k = kts, ktf
544 g_fqx(i_end+1,k) = 0.5*g_field(i_end+1,k,j)*ru(i_end+1,k,j)+0.5*g_field(i_end,k,j)*ru(i_end+1,k,j)+0.5*g_ru(i_end+1,k,j)*&
545 &(field(i_end+1,k,j)+field(i_end,k,j))
546 fqx(i_end+1,k) = 0.5*ru(i_end+1,k,j)*(field(i_end+1,k,j)+field(i_end,k,j))
547 end do
548 endif
549 do k = kts, ktf
550 do i = i_start, i_end
551 mrdx = msft(i,j)*rdx
552 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
553 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
554 end do
555 end do
556 end do
557 i_start = its
558 i_end = min(ite,ide-1)
559 j_start = jts
560 j_end = min(jte,jde-1)
561 j_start_f = j_start
562 j_end_f = j_end+1
563 if (degrade_ys) then
564 j_start = jds+1
565 j_start_f = j_start+1
566 endif
567 if (degrade_ye) then
568 j_end = jde-2
569 j_end_f = jde-2
570 endif
571 jp1 = 2
572 jp0 = 1
573 do j = j_start, j_end+1
574 if (j .lt. j_start_f .and. degrade_ys) then
575 do k = kts, ktf
576 do i = i_start, i_end
577 g_fqy(i,k,jp1) = 0.5*g_field(i,k,j_start-1)*rv(i,k,j_start)+0.5*g_field(i,k,j_start)*rv(i,k,j_start)+0.5*g_rv(i,k,&
578 &j_start)*(field(i,k,j_start)+field(i,k,j_start-1))
579 fqy(i,k,jp1) = 0.5*rv(i,k,j_start)*(field(i,k,j_start)+field(i,k,j_start-1))
580 end do
581 end do
582 else if (j .gt. j_end_f .and. degrade_ye) then
583 do k = kts, ktf
584 do i = i_start, i_end
585 g_fqy(i,k,jp1) = 0.5*g_field(i,k,j_end+1)*rv(i,k,j_end+1)+0.5*g_field(i,k,j_end)*rv(i,k,j_end+1)+0.5*g_rv(i,k,j_end+1)*&
586 &(field(i,k,j_end+1)+field(i,k,j_end))
587 fqy(i,k,jp1) = 0.5*rv(i,k,j_end+1)*(field(i,k,j_end+1)+field(i,k,j_end))
588 end do
589 end do
590 else
591 do k = kts, ktf
592 do i = i_start, i_end
593 g_fqy(i,k,jp1) = (-0.083333333)*g_field(i,k,j-2)*rv(i,k,j)+0.58333333*g_field(i,k,j-1)*rv(i,k,j)-0.083333333*g_field(i,k,&
594 &j+1)*rv(i,k,j)+0.58333333*g_field(i,k,j)*rv(i,k,j)+g_rv(i,k,j)*(0.58333333*(field(i,k,j)+field(i,k,j-1))-0.083333333*&
595 &(field(i,k,j+1)+field(i,k,j-2)))
596 fqy(i,k,jp1) = rv(i,k,j)*(7./12.*(field(i,k,j)+field(i,k,j-1))-1./12.*(field(i,k,j+1)+field(i,k,j-2)))
597 end do
598 end do
599 endif
600 if (j .gt. j_start) then
601 do k = kts, ktf
602 do i = i_start, i_end
603 mrdy = msft(i,j-1)*rdy
604 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
605 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
606 end do
607 end do
608 endif
609 jtmp = jp1
610 jp1 = jp0
611 jp0 = jtmp
612 end do
613 else if (horz_order .eq. 3) then horizontal_order_tesu
614 degrade_xs = .true.
615 degrade_xe = .true.
616 degrade_ys = .true.
617 degrade_ye = .true.
618 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
619 degrade_xs = .false.
620 endif
621 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
622 degrade_xe = .false.
623 endif
624 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
625 degrade_ys = .false.
626 endif
627 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
628 degrade_ye = .false.
629 endif
630 ktf = min(kte,kde-1)
631 i_start = its
632 i_end = min(ite,ide-1)
633 j_start = jts
634 j_end = min(jte,jde-1)
635 i_start_f = i_start
636 i_end_f = i_end+1
637 if (degrade_xs) then
638 i_start = ids+1
639 i_start_f = i_start+1
640 endif
641 if (degrade_xe) then
642 i_end = ide-2
643 i_end_f = ide-2
644 endif
645 do j = j_start, j_end
646 do k = kts, ktf
647 do i = i_start_f, i_end_f
648 g_fqx(i,k) = g_field(i-2,k,j)*ru(i,k,j)*((-0.083333333)+(-0.083333333)*sign(1.,ru(i,k,j)))+g_field(i-1,k,j)*ru(i,k,j)*&
649 &(0.58333333+0.25*sign(1.,ru(i,k,j)))+g_field(i+1,k,j)*ru(i,k,j)*((-0.083333333)+0.083333333*sign(1.,ru(i,k,j)))+g_field(i,&
650 &k,j)*ru(i,k,j)*(0.58333333+(-0.25)*sign(1.,ru(i,k,j)))+g_ru(i,k,j)*(0.58333333*(field(i,k,j)+field(i-1,k,j))-0.083333333*&
651 &(field(i+1,k,j)+field(i-2,k,j))+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)))
652 fqx(i,k) = ru(i,k,j)*(7./12.*(field(i,k,j)+field(i-1,k,j))-1./12.*(field(i+1,k,j)+field(i-2,k,j))+sign(1.,ru(i,k,j))*(1./&
653 &12.)*(field(i+1,k,j)-field(i-2,k,j)-3.*(field(i,k,j)-field(i-1,k,j))))
654 end do
655 end do
656 if (degrade_xs) then
657 do k = kts, ktf
658 g_fqx(i_start,k) = 0.5*g_field(i_start-1,k,j)*ru(i_start,k,j)+0.5*g_field(i_start,k,j)*ru(i_start,k,j)+0.5*g_ru(i_start,k,&
659 &j)*(field(i_start,k,j)+field(i_start-1,k,j))
660 fqx(i_start,k) = 0.5*ru(i_start,k,j)*(field(i_start,k,j)+field(i_start-1,k,j))
661 end do
662 endif
663 if (degrade_xe) then
664 do k = kts, ktf
665 g_fqx(i_end+1,k) = 0.5*g_field(i_end+1,k,j)*ru(i_end+1,k,j)+0.5*g_field(i_end,k,j)*ru(i_end+1,k,j)+0.5*g_ru(i_end+1,k,j)*&
666 &(field(i_end+1,k,j)+field(i_end,k,j))
667 fqx(i_end+1,k) = 0.5*ru(i_end+1,k,j)*(field(i_end+1,k,j)+field(i_end,k,j))
668 end do
669 endif
670 do k = kts, ktf
671 do i = i_start, i_end
672 mrdx = msft(i,j)*rdx
673 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
674 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
675 end do
676 end do
677 end do
678 i_start = its
679 i_end = min(ite,ide-1)
680 j_start = jts
681 j_end = min(jte,jde-1)
682 j_start_f = j_start
683 j_end_f = j_end+1
684 if (degrade_ys) then
685 j_start = jds+1
686 j_start_f = j_start+1
687 endif
688 if (degrade_ye) then
689 j_end = jde-2
690 j_end_f = jde-2
691 endif
692 jp1 = 2
693 jp0 = 1
694 do j = j_start, j_end+1
695 if (j .lt. j_start_f .and. degrade_ys) then
696 do k = kts, ktf
697 do i = i_start, i_end
698 g_fqy(i,k,jp1) = 0.5*g_field(i,k,j_start-1)*rv(i,k,j_start)+0.5*g_field(i,k,j_start)*rv(i,k,j_start)+0.5*g_rv(i,k,&
699 &j_start)*(field(i,k,j_start)+field(i,k,j_start-1))
700 fqy(i,k,jp1) = 0.5*rv(i,k,j_start)*(field(i,k,j_start)+field(i,k,j_start-1))
701 end do
702 end do
703 else if (j .gt. j_end_f .and. degrade_ye) then
704 do k = kts, ktf
705 do i = i_start, i_end
706 g_fqy(i,k,jp1) = 0.5*g_field(i,k,j_end+1)*rv(i,k,j_end+1)+0.5*g_field(i,k,j_end)*rv(i,k,j_end+1)+0.5*g_rv(i,k,j_end+1)*&
707 &(field(i,k,j_end+1)+field(i,k,j_end))
708 fqy(i,k,jp1) = 0.5*rv(i,k,j_end+1)*(field(i,k,j_end+1)+field(i,k,j_end))
709 end do
710 end do
711 else
712 do k = kts, ktf
713 do i = i_start, i_end
714 g_fqy(i,k,jp1) = g_field(i,k,j-2)*rv(i,k,j)*((-0.083333333)+(-0.083333333)*sign(1.,rv(i,k,j)))+g_field(i,k,j-1)*rv(i,k,j)&
715 &*(0.58333333+0.25*sign(1.,rv(i,k,j)))+g_field(i,k,j+1)*rv(i,k,j)*((-0.083333333)+0.083333333*sign(1.,rv(i,k,j)))+&
716 &g_field(i,k,j)*rv(i,k,j)*(0.58333333+(-0.25)*sign(1.,rv(i,k,j)))+g_rv(i,k,j)*(0.58333333*(field(i,k,j)+field(i,k,j-1))-&
717 &0.083333333*(field(i,k,j+1)+field(i,k,j-2))+0.083333333*(field(i,k,j+1)-field(i,k,j-2)-3.*(field(i,k,j)-field(i,k,j-1)))&
718 &*sign(1.,rv(i,k,j)))
719 fqy(i,k,jp1) = rv(i,k,j)*(7./12.*(field(i,k,j)+field(i,k,j-1))-1./12.*(field(i,k,j+1)+field(i,k,j-2))+sign(1.,rv(i,k,j))*&
720 &(1./12.)*(field(i,k,j+1)-field(i,k,j-2)-3.*(field(i,k,j)-field(i,k,j-1))))
721 end do
722 end do
723 endif
724 if (j .gt. j_start) then
725 do k = kts, ktf
726 do i = i_start, i_end
727 mrdy = msft(i,j-1)*rdy
728 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
729 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
730 end do
731 end do
732 endif
733 jtmp = jp1
734 jp1 = jp0
735 jp0 = jtmp
736 end do
737 else if (horz_order .eq. 2) then horizontal_order_tesu
738 i_start = its
739 i_end = min(ite,ide-1)
740 j_start = jts
741 j_end = min(jte,jde-1)
742 if (config_flags%open_xs .or. specified) then
743 i_start = max(ids+1,its)
744 endif
745 if (config_flags%open_xe .or. specified) then
746 i_end = min(ide-2,ite)
747 endif
748 do j = j_start, j_end
749 do k = kts, ktf
750 do i = i_start, i_end
751 mrdx = msft(i,j)*rdx
752 g_tendency(i,k,j) = 0.5*g_field(i-1,k,j)*mrdx*ru(i,k,j)-0.5*g_field(i+1,k,j)*mrdx*ru(i+1,k,j)-0.5*g_field(i,k,j)*mrdx*&
753 &(ru(i+1,k,j)-ru(i,k,j))-0.5*g_ru(i+1,k,j)*mrdx*(field(i+1,k,j)+field(i,k,j))+0.5*g_ru(i,k,j)*mrdx*(field(i,k,j)+field(i-1,&
754 &k,j))+g_tendency(i,k,j)
755 tendency(i,k,j) = tendency(i,k,j)-mrdx*0.5*(ru(i+1,k,j)*(field(i+1,k,j)+field(i,k,j))-ru(i,k,j)*(field(i,k,j)+field(i-1,k,&
756 &j)))
757 end do
758 end do
759 end do
760 i_start = its
761 i_end = min(ite,ide-1)
762 if (config_flags%open_ys .or. specified) then
763 j_start = max(jds+1,jts)
764 endif
765 if (config_flags%open_ye .or. specified) then
766 j_end = min(jde-2,jte)
767 endif
768 do j = j_start, j_end
769 do k = kts, ktf
770 do i = i_start, i_end
771 mrdy = msft(i,j)*rdy
772 g_tendency(i,k,j) = 0.5*g_field(i,k,j-1)*mrdy*rv(i,k,j)-0.5*g_field(i,k,j+1)*mrdy*rv(i,k,j+1)-0.5*g_field(i,k,j)*mrdy*&
773 &(rv(i,k,j+1)-rv(i,k,j))-0.5*g_rv(i,k,j+1)*mrdy*(field(i,k,j+1)+field(i,k,j))+0.5*g_rv(i,k,j)*mrdy*(field(i,k,j)+field(i,k,&
774 &j-1))+g_tendency(i,k,j)
775 tendency(i,k,j) = tendency(i,k,j)-mrdy*0.5*(rv(i,k,j+1)*(field(i,k,j+1)+field(i,k,j))-rv(i,k,j)*(field(i,k,j)+field(i,k,j-&
776 &1)))
777 end do
778 end do
779 end do
780 else horizontal_order_tesu
781 write(unit=wrf_err_message,fmt=*) 'module_advect: advect_scalar_6a, h_order not known ',horz_order
782 endif horizontal_order_tesu
783 i_start = its
784 i_end = min(ite,ide-1)
785 j_start = jts
786 j_end = min(jte,jde-1)
787 if (config_flags%open_xs .and. its .eq. ids) then
788 do j = j_start, j_end
789 do k = kts, ktf
790 g_ub = 0.5*g_ru(its+1,k,j)*(0.5+sign(0.5,0.-0.5*(ru(its,k,j)+ru(its+1,k,j))))+0.5*g_ru(its,k,j)*(0.5+sign(0.5,0.-0.5*(ru(its,&
791 &k,j)+ru(its+1,k,j))))
792 ub = min(0.5*(ru(its,k,j)+ru(its+1,k,j)),0.)
793 g_tendency(its,k,j) = (-(g_field(its,k,j)*rdx*(ru(its+1,k,j)-ru(its,k,j))))-g_field_old(its+1,k,j)*rdx*ub+g_field_old(its,k,&
794 &j)*rdx*ub-g_ru(its+1,k,j)*rdx*field(its,k,j)+g_ru(its,k,j)*rdx*field(its,k,j)+g_tendency(its,k,j)-g_ub*rdx*(field_old(its+1,&
795 &k,j)-field_old(its,k,j))
796 tendency(its,k,j) = tendency(its,k,j)-rdx*(ub*(field_old(its+1,k,j)-field_old(its,k,j))+field(its,k,j)*(ru(its+1,k,j)-ru(its,&
797 &k,j)))
798 end do
799 end do
800 endif
801 if (config_flags%open_xe .and. ite .eq. ide) then
802 do j = j_start, j_end
803 do k = kts, ktf
804 g_ub = 0.5*g_ru(ite-1,k,j)*(0.5+sign(0.5,0.5*(ru(ite-1,k,j)+ru(ite,k,j))-0.))+0.5*g_ru(ite,k,j)*(0.5+sign(0.5,0.5*(ru(ite-1,&
805 &k,j)+ru(ite,k,j))-0.))
806 ub = max(0.5*(ru(ite-1,k,j)+ru(ite,k,j)),0.)
807 g_tendency(i_end,k,j) = (-(g_field(i_end,k,j)*rdx*(ru(ite,k,j)-ru(ite-1,k,j))))+g_field_old(i_end-1,k,j)*rdx*ub-&
808 &g_field_old(i_end,k,j)*rdx*ub+g_ru(ite-1,k,j)*rdx*field(i_end,k,j)-g_ru(ite,k,j)*rdx*field(i_end,k,j)+g_tendency(i_end,k,j)-&
809 &g_ub*rdx*(field_old(i_end,k,j)-field_old(i_end-1,k,j))
810 tendency(i_end,k,j) = tendency(i_end,k,j)-rdx*(ub*(field_old(i_end,k,j)-field_old(i_end-1,k,j))+field(i_end,k,j)*(ru(ite,k,j)&
811 &-ru(ite-1,k,j)))
812 end do
813 end do
814 endif
815 if (config_flags%open_ys .and. jts .eq. jds) then
816 do i = i_start, i_end
817 do k = kts, ktf
818 g_vb = 0.5*g_rv(i,k,jts+1)*(0.5+sign(0.5,0.-0.5*(rv(i,k,jts)+rv(i,k,jts+1))))+0.5*g_rv(i,k,jts)*(0.5+sign(0.5,0.-0.5*(rv(i,k,&
819 &jts)+rv(i,k,jts+1))))
820 vb = min(0.5*(rv(i,k,jts)+rv(i,k,jts+1)),0.)
821 g_tendency(i,k,jts) = (-(g_field(i,k,jts)*rdy*(rv(i,k,jts+1)-rv(i,k,jts))))-g_field_old(i,k,jts+1)*rdy*vb+g_field_old(i,k,&
822 &jts)*rdy*vb-g_rv(i,k,jts+1)*rdy*field(i,k,jts)+g_rv(i,k,jts)*rdy*field(i,k,jts)+g_tendency(i,k,jts)-g_vb*rdy*(field_old(i,k,&
823 &jts+1)-field_old(i,k,jts))
824 tendency(i,k,jts) = tendency(i,k,jts)-rdy*(vb*(field_old(i,k,jts+1)-field_old(i,k,jts))+field(i,k,jts)*(rv(i,k,jts+1)-rv(i,k,&
825 &jts)))
826 end do
827 end do
828 endif
829 if (config_flags%open_ye .and. jte .eq. jde) then
830 do i = i_start, i_end
831 do k = kts, ktf
832 g_vb = 0.5*g_rv(i,k,jte-1)*(0.5+sign(0.5,0.5*(rv(i,k,jte-1)+rv(i,k,jte))-0.))+0.5*g_rv(i,k,jte)*(0.5+sign(0.5,0.5*(rv(i,k,&
833 &jte-1)+rv(i,k,jte))-0.))
834 vb = max(0.5*(rv(i,k,jte-1)+rv(i,k,jte)),0.)
835 g_tendency(i,k,j_end) = (-(g_field(i,k,j_end)*rdy*(rv(i,k,jte)-rv(i,k,jte-1))))+g_field_old(i,k,j_end-1)*rdy*vb-&
836 &g_field_old(i,k,j_end)*rdy*vb+g_rv(i,k,jte-1)*rdy*field(i,k,j_end)-g_rv(i,k,jte)*rdy*field(i,k,j_end)+g_tendency(i,k,j_end)-&
837 &g_vb*rdy*(field_old(i,k,j_end)-field_old(i,k,j_end-1))
838 tendency(i,k,j_end) = tendency(i,k,j_end)-rdy*(vb*(field_old(i,k,j_end)-field_old(i,k,j_end-1))+field(i,k,j_end)*(rv(i,k,jte)&
839 &-rv(i,k,jte-1)))
840 end do
841 end do
842 endif
843 i_start = its
844 i_end = min(ite,ide-1)
845 j_start = jts
846 j_end = min(jte,jde-1)
847 do i = i_start, i_end
848 g_vflux(i,kts) = 0.
849 vflux(i,kts) = 0.
850 g_vflux(i,kte) = 0.
851 vflux(i,kte) = 0.
852 end do
853 vert_order_tesu: if (vert_order .eq. 6) then
854 do j = j_start, j_end
855 do k = kts+3, ktf-2
856 do i = i_start, i_end
857 g_vel = g_rom(i,k,j)
858 vel = rom(i,k,j)
859 g_vflux(i,k) = 0.016666667*g_field(i,k-3,j)*vel-0.13333333*g_field(i,k-2,j)*vel+0.61666667*g_field(i,k-1,j)*vel+&
860 &0.016666667*g_field(i,k+2,j)*vel-0.13333333*g_field(i,k+1,j)*vel+0.61666667*g_field(i,k,j)*vel+g_vel*(0.61666667*(field(i,&
861 &k,j)+field(i,k-1,j))-0.13333333*(field(i,k+1,j)+field(i,k-2,j))+0.016666667*(field(i,k+2,j)+field(i,k-3,j)))
862 vflux(i,k) = vel*(37./60.*(field(i,k,j)+field(i,k-1,j))-2./15.*(field(i,k+1,j)+field(i,k-2,j))+1./60.*(field(i,k+2,j)+&
863 &field(i,k-3,j)))
864 end do
865 end do
866 do i = i_start, i_end
867 k = kts+1
868 g_vflux(i,k) = g_field(i,k-1,j)*rom(i,k,j)*fzp(k)+g_field(i,k,j)*rom(i,k,j)*fzm(k)+g_rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*&
869 &field(i,k-1,j))
870 vflux(i,k) = rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
871 k = kts+2
872 g_vel = g_rom(i,k,j)
873 vel = rom(i,k,j)
874 g_vflux(i,k) = (-0.083333333)*g_field(i,k-2,j)*vel+0.58333333*g_field(i,k-1,j)*vel-0.083333333*g_field(i,k+1,j)*vel+&
875 &0.58333333*g_field(i,k,j)*vel+g_vel*(0.58333333*(field(i,k,j)+field(i,k-1,j))-0.083333333*(field(i,k+1,j)+field(i,k-2,j)))
876 vflux(i,k) = vel*(7./12.*(field(i,k,j)+field(i,k-1,j))-1./12.*(field(i,k+1,j)+field(i,k-2,j)))
877 k = ktf-1
878 g_vel = g_rom(i,k,j)
879 vel = rom(i,k,j)
880 g_vflux(i,k) = (-0.083333333)*g_field(i,k-2,j)*vel+0.58333333*g_field(i,k-1,j)*vel-0.083333333*g_field(i,k+1,j)*vel+&
881 &0.58333333*g_field(i,k,j)*vel+g_vel*(0.58333333*(field(i,k,j)+field(i,k-1,j))-0.083333333*(field(i,k+1,j)+field(i,k-2,j)))
882 vflux(i,k) = vel*(7./12.*(field(i,k,j)+field(i,k-1,j))-1./12.*(field(i,k+1,j)+field(i,k-2,j)))
883 k = ktf
884 g_vflux(i,k) = g_field(i,k-1,j)*rom(i,k,j)*fzp(k)+g_field(i,k,j)*rom(i,k,j)*fzm(k)+g_rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*&
885 &field(i,k-1,j))
886 vflux(i,k) = rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
887 end do
888 do k = kts, ktf
889 do i = i_start, i_end
890 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
891 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
892 end do
893 end do
894 end do
895 else if (vert_order .eq. 5) then vert_order_tesu
896 do j = j_start, j_end
897 do k = kts+3, ktf-2
898 do i = i_start, i_end
899 g_vel = g_rom(i,k,j)
900 vel = rom(i,k,j)
901 g_vflux(i,k) = g_field(i,k-3,j)*vel*(0.016666667-(-0.016666667)*sign(1.,-vel))+g_field(i,k-2,j)*vel*((-0.13333333)-&
902 &0.083333333*sign(1.,-vel))+g_field(i,k-1,j)*vel*(0.61666667-(-0.16666667)*sign(1.,-vel))+g_field(i,k+2,j)*vel*&
903 &(0.016666667-0.016666667*sign(1.,-vel))+g_field(i,k+1,j)*vel*((-0.13333333)-(-0.083333333)*sign(1.,-vel))+g_field(i,k,j)*&
904 &vel*(0.61666667-0.16666667*sign(1.,-vel))+g_vel*(0.61666667*(field(i,k,j)+field(i,k-1,j))-0.13333333*(field(i,k+1,j)+&
905 &field(i,k-2,j))+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)-&
906 &field(i,k-2,j))+10.*(field(i,k,j)-field(i,k-1,j)))*sign(1.,-vel))
907 vflux(i,k) = vel*(37./60.*(field(i,k,j)+field(i,k-1,j))-2./15.*(field(i,k+1,j)+field(i,k-2,j))+1./60.*(field(i,k+2,j)+&
908 &field(i,k-3,j))-sign(1.,-vel)*(1./60.)*(field(i,k+2,j)-field(i,k-3,j)-5.*(field(i,k+1,j)-field(i,k-2,j))+10.*(field(i,k,j)&
909 &-field(i,k-1,j))))
910 end do
911 end do
912 do i = i_start, i_end
913 k = kts+1
914 g_vflux(i,k) = g_field(i,k-1,j)*rom(i,k,j)*fzp(k)+g_field(i,k,j)*rom(i,k,j)*fzm(k)+g_rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*&
915 &field(i,k-1,j))
916 vflux(i,k) = rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
917 k = kts+2
918 g_vel = g_rom(i,k,j)
919 vel = rom(i,k,j)
920 g_vflux(i,k) = g_field(i,k-2,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))+g_field(i,k-1,j)*vel*(0.58333333+0.25*&
921 &sign(1.,-vel))+g_field(i,k+1,j)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))+g_field(i,k,j)*vel*(0.58333333+(-0.25)*&
922 &sign(1.,-vel))+g_vel*(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*&
923 &(field(i,k+1,j)-field(i,k-2,j)-3.*(field(i,k,j)-field(i,k-1,j)))*sign(1.,-vel))
924 vflux(i,k) = vel*(7./12.*(field(i,k,j)+field(i,k-1,j))-1./12.*(field(i,k+1,j)+field(i,k-2,j))+sign(1.,-vel)*(1./12.)*&
925 &(field(i,k+1,j)-field(i,k-2,j)-3.*(field(i,k,j)-field(i,k-1,j))))
926 k = ktf-1
927 g_vel = g_rom(i,k,j)
928 vel = rom(i,k,j)
929 g_vflux(i,k) = g_field(i,k-2,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))+g_field(i,k-1,j)*vel*(0.58333333+0.25*&
930 &sign(1.,-vel))+g_field(i,k+1,j)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))+g_field(i,k,j)*vel*(0.58333333+(-0.25)*&
931 &sign(1.,-vel))+g_vel*(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*&
932 &(field(i,k+1,j)-field(i,k-2,j)-3.*(field(i,k,j)-field(i,k-1,j)))*sign(1.,-vel))
933 vflux(i,k) = vel*(7./12.*(field(i,k,j)+field(i,k-1,j))-1./12.*(field(i,k+1,j)+field(i,k-2,j))+sign(1.,-vel)*(1./12.)*&
934 &(field(i,k+1,j)-field(i,k-2,j)-3.*(field(i,k,j)-field(i,k-1,j))))
935 k = ktf
936 g_vflux(i,k) = g_field(i,k-1,j)*rom(i,k,j)*fzp(k)+g_field(i,k,j)*rom(i,k,j)*fzm(k)+g_rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*&
937 &field(i,k-1,j))
938 vflux(i,k) = rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
939 end do
940 do k = kts, ktf
941 do i = i_start, i_end
942 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
943 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
944 end do
945 end do
946 end do
947 else if (vert_order .eq. 4) then vert_order_tesu
948 do j = j_start, j_end
949 do k = kts+2, ktf-1
950 do i = i_start, i_end
951 g_vel = g_rom(i,k,j)
952 vel = rom(i,k,j)
953 g_vflux(i,k) = (-0.083333333)*g_field(i,k-2,j)*vel+0.58333333*g_field(i,k-1,j)*vel-0.083333333*g_field(i,k+1,j)*vel+&
954 &0.58333333*g_field(i,k,j)*vel+g_vel*(0.58333333*(field(i,k,j)+field(i,k-1,j))-0.083333333*(field(i,k+1,j)+field(i,k-2,j)))
955 vflux(i,k) = vel*(7./12.*(field(i,k,j)+field(i,k-1,j))-1./12.*(field(i,k+1,j)+field(i,k-2,j)))
956 end do
957 end do
958 do i = i_start, i_end
959 k = kts+1
960 g_vflux(i,k) = g_field(i,k-1,j)*rom(i,k,j)*fzp(k)+g_field(i,k,j)*rom(i,k,j)*fzm(k)+g_rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*&
961 &field(i,k-1,j))
962 vflux(i,k) = rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
963 k = ktf
964 g_vflux(i,k) = g_field(i,k-1,j)*rom(i,k,j)*fzp(k)+g_field(i,k,j)*rom(i,k,j)*fzm(k)+g_rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*&
965 &field(i,k-1,j))
966 vflux(i,k) = rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
967 end do
968 do k = kts, ktf
969 do i = i_start, i_end
970 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
971 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
972 end do
973 end do
974 end do
975 else if (vert_order .eq. 3) then vert_order_tesu
976 do j = j_start, j_end
977 do k = kts+2, ktf-1
978 do i = i_start, i_end
979 g_vel = g_rom(i,k,j)
980 vel = rom(i,k,j)
981 g_vflux(i,k) = g_field(i,k-2,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))+g_field(i,k-1,j)*vel*(0.58333333+0.25*&
982 &sign(1.,-vel))+g_field(i,k+1,j)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))+g_field(i,k,j)*vel*(0.58333333+(-0.25)*&
983 &sign(1.,-vel))+g_vel*(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*&
984 &(field(i,k+1,j)-field(i,k-2,j)-3.*(field(i,k,j)-field(i,k-1,j)))*sign(1.,-vel))
985 vflux(i,k) = vel*(7./12.*(field(i,k,j)+field(i,k-1,j))-1./12.*(field(i,k+1,j)+field(i,k-2,j))+sign(1.,-vel)*(1./12.)*&
986 &(field(i,k+1,j)-field(i,k-2,j)-3.*(field(i,k,j)-field(i,k-1,j))))
987 end do
988 end do
989 do i = i_start, i_end
990 k = kts+1
991 g_vflux(i,k) = g_field(i,k-1,j)*rom(i,k,j)*fzp(k)+g_field(i,k,j)*rom(i,k,j)*fzm(k)+g_rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*&
992 &field(i,k-1,j))
993 vflux(i,k) = rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
994 k = ktf
995 g_vflux(i,k) = g_field(i,k-1,j)*rom(i,k,j)*fzp(k)+g_field(i,k,j)*rom(i,k,j)*fzm(k)+g_rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*&
996 &field(i,k-1,j))
997 vflux(i,k) = rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
998 end do
999 do k = kts, ktf
1000 do i = i_start, i_end
1001 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
1002 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
1003 end do
1004 end do
1005 end do
1006 else if (vert_order .eq. 2) then vert_order_tesu
1007 do j = j_start, j_end
1008 do k = kts+1, ktf
1009 do i = i_start, i_end
1010 g_vflux(i,k) = g_field(i,k-1,j)*rom(i,k,j)*fzp(k)+g_field(i,k,j)*rom(i,k,j)*fzm(k)+g_rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)&
1011 &*field(i,k-1,j))
1012 vflux(i,k) = rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
1013 end do
1014 end do
1015 do k = kts, ktf
1016 do i = i_start, i_end
1017 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
1018 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
1019 end do
1020 end do
1021 end do
1022 else vert_order_tesu
1023 write(unit=wrf_err_message,fmt=*) ' advect_scalar_6a, v_order not known ',vert_order
1024 endif vert_order_tesu
1025
1026 end subroutine g_advect_scalar
1027
1028
1029 subroutine g_advect_u( u, g_u, u_old, g_u_old, tendency, g_tendency, ru, g_ru, rv, g_rv, rom, g_rom, mut, g_mut, config_flags, &
1030 &msfu, fzm, fzp, rdx, rdy, rdzw, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1031 !******************************************************************
1032 !******************************************************************
1033 !** This routine was generated by Automatic differentiation. **
1034 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1035 !******************************************************************
1036 !******************************************************************
1037 !==============================================
1038 ! all entries are defined explicitly
1039 !==============================================
1040 implicit none
1041
1042 !==============================================
1043 ! declare arguments
1044 !==============================================
1045 type (grid_config_rec_type), intent(in) :: config_flags
1046 integer, intent(in) :: kme
1047 integer, intent(in) :: kms
1048 real, intent(in) :: fzm(kms:kme)
1049 real, intent(in) :: fzp(kms:kme)
1050 integer, intent(in) :: ime
1051 integer, intent(in) :: ims
1052 integer, intent(in) :: jme
1053 integer, intent(in) :: jms
1054 real, intent(in) :: g_mut(ims:ime,jms:jme)
1055 real, intent(in) :: g_rom(ims:ime,kms:kme,jms:jme)
1056 real, intent(in) :: g_ru(ims:ime,kms:kme,jms:jme)
1057 real, intent(in) :: g_rv(ims:ime,kms:kme,jms:jme)
1058 real, intent(inout) :: g_tendency(ims:ime,kms:kme,jms:jme)
1059 real, intent(in) :: g_u(ims:ime,kms:kme,jms:jme)
1060 real, intent(in) :: g_u_old(ims:ime,kms:kme,jms:jme)
1061 integer, intent(in) :: ide
1062 integer, intent(in) :: ids
1063 integer, intent(in) :: ite
1064 integer, intent(in) :: its
1065 integer, intent(in) :: jde
1066 integer, intent(in) :: jds
1067 integer, intent(in) :: jte
1068 integer, intent(in) :: jts
1069 integer, intent(in) :: kde
1070 integer, intent(in) :: kte
1071 integer, intent(in) :: kts
1072 real, intent(in) :: msfu(ims:ime,jms:jme)
1073 real, intent(in) :: mut(ims:ime,jms:jme)
1074 real, intent(in) :: rdx
1075 real, intent(in) :: rdy
1076 real, intent(in) :: rdzw(kms:kme)
1077 real, intent(in) :: rom(ims:ime,kms:kme,jms:jme)
1078 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
1079 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
1080 real, intent(inout) :: tendency(ims:ime,kms:kme,jms:jme)
1081 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
1082 real, intent(in) :: u_old(ims:ime,kms:kme,jms:jme)
1083
1084 !==============================================
1085 ! declare local variables
1086 !==============================================
1087 logical degrade_xe
1088 logical degrade_xs
1089 logical degrade_ye
1090 logical degrade_ys
1091 real dvm
1092 real dvp
1093 real fqx(its-1:ite+1,kts:kte)
1094 real fqy(its:ite,kts:kte,2)
1095 real g_dvm
1096 real g_dvp
1097 real g_fqx(its-1:ite+1,kts:kte)
1098 real g_fqy(its:ite,kts:kte,2)
1099 real g_ub
1100 real g_vb
1101 real g_vel
1102 real g_vflux(its:ite,kts:kte)
1103 real g_vw
1104 integer horz_order
1105 integer i
1106 integer i_end
1107 integer i_end_f
1108 integer i_start
1109 integer i_start_f
1110 integer im
1111 integer imax
1112 integer imin
1113 integer ip
1114 integer j
1115 integer j_end
1116 integer j_end_f
1117 integer j_start
1118 integer j_start_f
1119 integer jp0
1120 integer jp1
1121 integer jtmp
1122 integer k
1123 integer ktf
1124 real mrdx
1125 real mrdy
1126 logical specified
1127 real ub
1128 real vb
1129 real vel
1130 integer vert_order
1131 real vflux(its:ite,kts:kte)
1132 real vw
1133
1134 !----------------------------------------------
1135 ! TANGENT LINEAR AND FUNCTION STATEMENTS
1136 !----------------------------------------------
1137 specified = .false.
1138 if (config_flags%specified .or. config_flags%nested) then
1139 specified = .true.
1140 endif
1141 horz_order = config_flags%h_mom_adv_order
1142 vert_order = config_flags%v_mom_adv_order
1143 ktf = min(kte,kde-1)
1144 horizontal_order_tesu: if (horz_order .eq. 6) then
1145 degrade_xs = .true.
1146 degrade_xe = .true.
1147 degrade_ys = .true.
1148 degrade_ye = .true.
1149 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
1150 degrade_xs = .false.
1151 endif
1152 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
1153 degrade_xe = .false.
1154 endif
1155 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
1156 degrade_ys = .false.
1157 endif
1158 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-3) then
1159 degrade_ye = .false.
1160 endif
1161 i_start = its
1162 i_end = ite
1163 if (config_flags%open_xs .or. specified) then
1164 i_start = max(ids+1,its)
1165 endif
1166 if (config_flags%open_xe .or. specified) then
1167 i_end = min(ide-1,ite)
1168 endif
1169 j_start = jts
1170 j_end = min(jte,jde-1)
1171 j_start_f = j_start
1172 j_end_f = j_end+1
1173 if (degrade_ys) then
1174 j_start = max(jts,jds+1)
1175 j_start_f = jds+3
1176 endif
1177 if (degrade_ye) then
1178 j_end = min(jte,jde-2)
1179 j_end_f = jde-3
1180 endif
1181 jp1 = 2
1182 jp0 = 1
1183 j_loop_y_flux_6: do j = j_start, j_end+1
1184 if (j .ge. j_start_f .and. j .le. j_end_f) then
1185 do k = kts, ktf
1186 do i = i_start, i_end
1187 g_vel = 0.5*g_rv(i-1,k,j)+0.5*g_rv(i,k,j)
1188 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
1189 g_fqy(i,k,jp1) = 0.016666667*g_u(i,k,j-3)*vel-0.13333333*g_u(i,k,j-2)*vel+0.61666667*g_u(i,k,j-1)*vel+0.016666667*g_u(i,&
1190 &k,j+2)*vel-0.13333333*g_u(i,k,j+1)*vel+0.61666667*g_u(i,k,j)*vel+g_vel*(0.61666667*(u(i,k,j)+u(i,k,j-1))-0.13333333*&
1191 &(u(i,k,j+1)+u(i,k,j-2))+0.016666667*(u(i,k,j+2)+u(i,k,j-3)))
1192 fqy(i,k,jp1) = vel*(37./60.*(u(i,k,j)+u(i,k,j-1))-2./15.*(u(i,k,j+1)+u(i,k,j-2))+1./60.*(u(i,k,j+2)+u(i,k,j-3)))
1193 end do
1194 end do
1195 else if (j .eq. jds+1) then
1196 do k = kts, ktf
1197 do i = i_start, i_end
1198 g_fqy(i,k,jp1) = 0.25*g_rv(i-1,k,j)*(u(i,k,j)+u(i,k,j-1))+0.25*g_rv(i,k,j)*(u(i,k,j)+u(i,k,j-1))+0.25*g_u(i,k,j-1)*(rv(i,&
1199 &k,j)+rv(i-1,k,j))+0.25*g_u(i,k,j)*(rv(i,k,j)+rv(i-1,k,j))
1200 fqy(i,k,jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))*(u(i,k,j)+u(i,k,j-1))
1201 end do
1202 end do
1203 else if (j .eq. jds+2) then
1204 do k = kts, ktf
1205 do i = i_start, i_end
1206 g_vel = 0.5*g_rv(i-1,k,j)+0.5*g_rv(i,k,j)
1207 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
1208 g_fqy(i,k,jp1) = (-0.083333333)*g_u(i,k,j-2)*vel+0.58333333*g_u(i,k,j-1)*vel-0.083333333*g_u(i,k,j+1)*vel+0.58333333*&
1209 &g_u(i,k,j)*vel+g_vel*(0.58333333*(u(i,k,j)+u(i,k,j-1))-0.083333333*(u(i,k,j+1)+u(i,k,j-2)))
1210 fqy(i,k,jp1) = vel*(7./12.*(u(i,k,j)+u(i,k,j-1))-1./12.*(u(i,k,j+1)+u(i,k,j-2)))
1211 end do
1212 end do
1213 else if (j .eq. jde-1) then
1214 do k = kts, ktf
1215 do i = i_start, i_end
1216 g_fqy(i,k,jp1) = 0.25*g_rv(i-1,k,j)*(u(i,k,j)+u(i,k,j-1))+0.25*g_rv(i,k,j)*(u(i,k,j)+u(i,k,j-1))+0.25*g_u(i,k,j-1)*(rv(i,&
1217 &k,j)+rv(i-1,k,j))+0.25*g_u(i,k,j)*(rv(i,k,j)+rv(i-1,k,j))
1218 fqy(i,k,jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))*(u(i,k,j)+u(i,k,j-1))
1219 end do
1220 end do
1221 else if (j .eq. jde-2) then
1222 do k = kts, ktf
1223 do i = i_start, i_end
1224 g_vel = 0.5*g_rv(i-1,k,j)+0.5*g_rv(i,k,j)
1225 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
1226 g_fqy(i,k,jp1) = (-0.083333333)*g_u(i,k,j-2)*vel+0.58333333*g_u(i,k,j-1)*vel-0.083333333*g_u(i,k,j+1)*vel+0.58333333*&
1227 &g_u(i,k,j)*vel+g_vel*(0.58333333*(u(i,k,j)+u(i,k,j-1))-0.083333333*(u(i,k,j+1)+u(i,k,j-2)))
1228 fqy(i,k,jp1) = vel*(7./12.*(u(i,k,j)+u(i,k,j-1))-1./12.*(u(i,k,j+1)+u(i,k,j-2)))
1229 end do
1230 end do
1231 endif
1232 if (j .gt. j_start) then
1233 do k = kts, ktf
1234 do i = i_start, i_end
1235 mrdy = msfu(i,j-1)*rdy
1236 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
1237 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
1238 end do
1239 end do
1240 endif
1241 jtmp = jp1
1242 jp1 = jp0
1243 jp0 = jtmp
1244 end do j_loop_y_flux_6
1245 i_start = its
1246 i_end = ite
1247 j_start = jts
1248 j_end = min(jte,jde-1)
1249 i_start_f = i_start
1250 i_end_f = i_end+1
1251 if (degrade_xs) then
1252 i_start = max(ids+1,its)
1253 i_start_f = ids+3
1254 endif
1255 if (degrade_xe) then
1256 i_end = min(ide-1,ite)
1257 i_end_f = ide-2
1258 endif
1259 do j = j_start, j_end
1260 do k = kts, ktf
1261 do i = i_start_f, i_end_f
1262 g_vel = 0.5*g_ru(i-1,k,j)+0.5*g_ru(i,k,j)
1263 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
1264 g_fqx(i,k) = 0.016666667*g_u(i-3,k,j)*vel-0.13333333*g_u(i-2,k,j)*vel+0.61666667*g_u(i-1,k,j)*vel+0.016666667*g_u(i+2,k,j)*&
1265 &vel-0.13333333*g_u(i+1,k,j)*vel+0.61666667*g_u(i,k,j)*vel+g_vel*(0.61666667*(u(i,k,j)+u(i-1,k,j))-0.13333333*(u(i+1,k,j)+&
1266 &u(i-2,k,j))+0.016666667*(u(i+2,k,j)+u(i-3,k,j)))
1267 fqx(i,k) = vel*(37./60.*(u(i,k,j)+u(i-1,k,j))-2./15.*(u(i+1,k,j)+u(i-2,k,j))+1./60.*(u(i+2,k,j)+u(i-3,k,j)))
1268 end do
1269 end do
1270 if (degrade_xs) then
1271 if (i_start .eq. ids+1) then
1272 i = ids+1
1273 do k = kts, ktf
1274 g_ub = g_u(i-1,k,j)
1275 ub = u(i-1,k,j)
1276 if (specified .and. u(i,k,j) .lt. 0.) then
1277 g_ub = g_u(i,k,j)
1278 ub = u(i,k,j)
1279 endif
1280 g_fqx(i,k) = 0.25*g_ru(i-1,k,j)*(u(i,k,j)+ub)+0.25*g_ru(i,k,j)*(u(i,k,j)+ub)+0.25*g_u(i,k,j)*(ru(i,k,j)+ru(i-1,k,j))+&
1281 &0.25*g_ub*(ru(i,k,j)+ru(i-1,k,j))
1282 fqx(i,k) = 0.25*(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+ub)
1283 end do
1284 endif
1285 i = ids+2
1286 do k = kts, ktf
1287 g_vel = 0.5*g_ru(i-1,k,j)+0.5*g_ru(i,k,j)
1288 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
1289 g_fqx(i,k) = (-0.083333333)*g_u(i-2,k,j)*vel+0.58333333*g_u(i-1,k,j)*vel-0.083333333*g_u(i+1,k,j)*vel+0.58333333*g_u(i,k,j)&
1290 &*vel+g_vel*(0.58333333*(u(i,k,j)+u(i-1,k,j))-0.083333333*(u(i+1,k,j)+u(i-2,k,j)))
1291 fqx(i,k) = vel*(7./12.*(u(i,k,j)+u(i-1,k,j))-1./12.*(u(i+1,k,j)+u(i-2,k,j)))
1292 end do
1293 endif
1294 if (degrade_xe) then
1295 if (i_end .eq. ide-1) then
1296 i = ide
1297 do k = kts, ktf
1298 g_ub = g_u(i,k,j)
1299 ub = u(i,k,j)
1300 if (specified .and. u(i-1,k,j) .gt. 0.) then
1301 g_ub = g_u(i-1,k,j)
1302 ub = u(i-1,k,j)
1303 endif
1304 g_fqx(i,k) = 0.25*g_ru(i-1,k,j)*(u(i-1,k,j)+ub)+0.25*g_ru(i,k,j)*(u(i-1,k,j)+ub)+0.25*g_u(i-1,k,j)*(ru(i,k,j)+ru(i-1,k,j)&
1305 &)+0.25*g_ub*(ru(i,k,j)+ru(i-1,k,j))
1306 fqx(i,k) = 0.25*(ru(i,k,j)+ru(i-1,k,j))*(u(i-1,k,j)+ub)
1307 end do
1308 endif
1309 do k = kts, ktf
1310 i = ide-1
1311 g_vel = 0.5*g_ru(i-1,k,j)+0.5*g_ru(i,k,j)
1312 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
1313 g_fqx(i,k) = (-0.083333333)*g_u(i-2,k,j)*vel+0.58333333*g_u(i-1,k,j)*vel-0.083333333*g_u(i+1,k,j)*vel+0.58333333*g_u(i,k,j)&
1314 &*vel+g_vel*(0.58333333*(u(i,k,j)+u(i-1,k,j))-0.083333333*(u(i+1,k,j)+u(i-2,k,j)))
1315 fqx(i,k) = vel*(7./12.*(u(i,k,j)+u(i-1,k,j))-1./12.*(u(i+1,k,j)+u(i-2,k,j)))
1316 end do
1317 endif
1318 do k = kts, ktf
1319 do i = i_start, i_end
1320 mrdx = msfu(i,j)*rdx
1321 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
1322 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
1323 end do
1324 end do
1325 end do
1326 else if (horz_order .eq. 5) then horizontal_order_tesu
1327 degrade_xs = .true.
1328 degrade_xe = .true.
1329 degrade_ys = .true.
1330 degrade_ye = .true.
1331 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
1332 degrade_xs = .false.
1333 endif
1334 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
1335 degrade_xe = .false.
1336 endif
1337 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
1338 degrade_ys = .false.
1339 endif
1340 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-3) then
1341 degrade_ye = .false.
1342 endif
1343 i_start = its
1344 i_end = ite
1345 if (config_flags%open_xs .or. specified) then
1346 i_start = max(ids+1,its)
1347 endif
1348 if (config_flags%open_xe .or. specified) then
1349 i_end = min(ide-1,ite)
1350 endif
1351 j_start = jts
1352 j_end = min(jte,jde-1)
1353 j_start_f = j_start
1354 j_end_f = j_end+1
1355 if (degrade_ys) then
1356 j_start = max(jts,jds+1)
1357 j_start_f = jds+3
1358 endif
1359 if (degrade_ye) then
1360 j_end = min(jte,jde-2)
1361 j_end_f = jde-3
1362 endif
1363 jp1 = 2
1364 jp0 = 1
1365 j_loop_y_flux_5: do j = j_start, j_end+1
1366 if (j .ge. j_start_f .and. j .le. j_end_f) then
1367 do k = kts, ktf
1368 do i = i_start, i_end
1369 g_vel = 0.5*g_rv(i-1,k,j)+0.5*g_rv(i,k,j)
1370 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
1371 g_fqy(i,k,jp1) = g_u(i,k,j-3)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))+g_u(i,k,j-2)*vel*((-0.13333333)-0.083333333*&
1372 &sign(1.,vel))+g_u(i,k,j-1)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))+g_u(i,k,j+2)*vel*(0.016666667-0.016666667*&
1373 &sign(1.,vel))+g_u(i,k,j+1)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))+g_u(i,k,j)*vel*(0.61666667-0.16666667*&
1374 &sign(1.,vel))+g_vel*(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)+u(i,k,&
1375 &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))
1376 fqy(i,k,jp1) = vel*(37./60.*(u(i,k,j)+u(i,k,j-1))-2./15.*(u(i,k,j+1)+u(i,k,j-2))+1./60.*(u(i,k,j+2)+u(i,k,j-3))-sign(1.,&
1377 &vel)*(1./60.)*(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))))
1378 end do
1379 end do
1380 else if (j .eq. jds+1) then
1381 do k = kts, ktf
1382 do i = i_start, i_end
1383 g_fqy(i,k,jp1) = 0.25*g_rv(i-1,k,j)*(u(i,k,j)+u(i,k,j-1))+0.25*g_rv(i,k,j)*(u(i,k,j)+u(i,k,j-1))+0.25*g_u(i,k,j-1)*(rv(i,&
1384 &k,j)+rv(i-1,k,j))+0.25*g_u(i,k,j)*(rv(i,k,j)+rv(i-1,k,j))
1385 fqy(i,k,jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))*(u(i,k,j)+u(i,k,j-1))
1386 end do
1387 end do
1388 else if (j .eq. jds+2) then
1389 do k = kts, ktf
1390 do i = i_start, i_end
1391 g_vel = 0.5*g_rv(i-1,k,j)+0.5*g_rv(i,k,j)
1392 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
1393 g_fqy(i,k,jp1) = g_u(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_u(i,k,j-1)*vel*(0.58333333+0.25*sign(1.,&
1394 &vel))+g_u(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_u(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,vel))+g_vel*&
1395 &(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+1)-u(i,k,j-2)-3.*(u(i,k,j)-&
1396 &u(i,k,j-1)))*sign(1.,vel))
1397 fqy(i,k,jp1) = vel*(7./12.*(u(i,k,j)+u(i,k,j-1))-1./12.*(u(i,k,j+1)+u(i,k,j-2))+sign(1.,vel)*(1./12.)*(u(i,k,j+1)-u(i,k,&
1398 &j-2)-3.*(u(i,k,j)-u(i,k,j-1))))
1399 end do
1400 end do
1401 else if (j .eq. jde-1) then
1402 do k = kts, ktf
1403 do i = i_start, i_end
1404 g_fqy(i,k,jp1) = 0.25*g_rv(i-1,k,j)*(u(i,k,j)+u(i,k,j-1))+0.25*g_rv(i,k,j)*(u(i,k,j)+u(i,k,j-1))+0.25*g_u(i,k,j-1)*(rv(i,&
1405 &k,j)+rv(i-1,k,j))+0.25*g_u(i,k,j)*(rv(i,k,j)+rv(i-1,k,j))
1406 fqy(i,k,jp1) = 0.25*(rv(i,k,j)+rv(i-1,k,j))*(u(i,k,j)+u(i,k,j-1))
1407 end do
1408 end do
1409 else if (j .eq. jde-2) then
1410 do k = kts, ktf
1411 do i = i_start, i_end
1412 g_vel = 0.5*g_rv(i-1,k,j)+0.5*g_rv(i,k,j)
1413 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
1414 g_fqy(i,k,jp1) = g_u(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_u(i,k,j-1)*vel*(0.58333333+0.25*sign(1.,&
1415 &vel))+g_u(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_u(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,vel))+g_vel*&
1416 &(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+1)-u(i,k,j-2)-3.*(u(i,k,j)-&
1417 &u(i,k,j-1)))*sign(1.,vel))
1418 fqy(i,k,jp1) = vel*(7./12.*(u(i,k,j)+u(i,k,j-1))-1./12.*(u(i,k,j+1)+u(i,k,j-2))+sign(1.,vel)*(1./12.)*(u(i,k,j+1)-u(i,k,&
1419 &j-2)-3.*(u(i,k,j)-u(i,k,j-1))))
1420 end do
1421 end do
1422 endif
1423 if (j .gt. j_start) then
1424 do k = kts, ktf
1425 do i = i_start, i_end
1426 mrdy = msfu(i,j-1)*rdy
1427 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
1428 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
1429 end do
1430 end do
1431 endif
1432 jtmp = jp1
1433 jp1 = jp0
1434 jp0 = jtmp
1435 end do j_loop_y_flux_5
1436 i_start = its
1437 i_end = ite
1438 j_start = jts
1439 j_end = min(jte,jde-1)
1440 i_start_f = i_start
1441 i_end_f = i_end+1
1442 if (degrade_xs) then
1443 i_start = max(ids+1,its)
1444 i_start_f = ids+3
1445 endif
1446 if (degrade_xe) then
1447 i_end = min(ide-1,ite)
1448 i_end_f = ide-2
1449 endif
1450 do j = j_start, j_end
1451 do k = kts, ktf
1452 do i = i_start_f, i_end_f
1453 g_vel = 0.5*g_ru(i-1,k,j)+0.5*g_ru(i,k,j)
1454 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
1455 g_fqx(i,k) = g_u(i-3,k,j)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))+g_u(i-2,k,j)*vel*((-0.13333333)-0.083333333*&
1456 &sign(1.,vel))+g_u(i-1,k,j)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))+g_u(i+2,k,j)*vel*(0.016666667-0.016666667*sign(1.,&
1457 &vel))+g_u(i+1,k,j)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))+g_u(i,k,j)*vel*(0.61666667-0.16666667*sign(1.,vel))+&
1458 &g_vel*(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-3,k,j))-&
1459 &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))
1460 fqx(i,k) = vel*(37./60.*(u(i,k,j)+u(i-1,k,j))-2./15.*(u(i+1,k,j)+u(i-2,k,j))+1./60.*(u(i+2,k,j)+u(i-3,k,j))-sign(1.,vel)*&
1461 &(1./60.)*(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))))
1462 end do
1463 end do
1464 if (degrade_xs) then
1465 if (i_start .eq. ids+1) then
1466 i = ids+1
1467 do k = kts, ktf
1468 g_ub = g_u(i-1,k,j)
1469 ub = u(i-1,k,j)
1470 if (specified .and. u(i,k,j) .lt. 0.) then
1471 g_ub = g_u(i,k,j)
1472 ub = u(i,k,j)
1473 endif
1474 g_fqx(i,k) = 0.25*g_ru(i-1,k,j)*(u(i,k,j)+ub)+0.25*g_ru(i,k,j)*(u(i,k,j)+ub)+0.25*g_u(i,k,j)*(ru(i,k,j)+ru(i-1,k,j))+&
1475 &0.25*g_ub*(ru(i,k,j)+ru(i-1,k,j))
1476 fqx(i,k) = 0.25*(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+ub)
1477 end do
1478 endif
1479 i = ids+2
1480 do k = kts, ktf
1481 g_vel = 0.5*g_ru(i-1,k,j)+0.5*g_ru(i,k,j)
1482 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
1483 g_fqx(i,k) = g_u(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_u(i-1,k,j)*vel*(0.58333333+0.25*sign(1.,vel))+&
1484 &g_u(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_u(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,vel))+g_vel*&
1485 &(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-2,k,j)-3.*(u(i,k,j)-u(i-&
1486 &1,k,j)))*sign(1.,vel))
1487 fqx(i,k) = vel*(7./12.*(u(i,k,j)+u(i-1,k,j))-1./12.*(u(i+1,k,j)+u(i-2,k,j))+sign(1.,vel)*(1./12.)*(u(i+1,k,j)-u(i-2,k,j)-&
1488 &3.*(u(i,k,j)-u(i-1,k,j))))
1489 end do
1490 endif
1491 if (degrade_xe) then
1492 if (i_end .eq. ide-1) then
1493 i = ide
1494 do k = kts, ktf
1495 g_ub = g_u(i,k,j)
1496 ub = u(i,k,j)
1497 if (specified .and. u(i-1,k,j) .gt. 0.) then
1498 g_ub = g_u(i-1,k,j)
1499 ub = u(i-1,k,j)
1500 endif
1501 g_fqx(i,k) = 0.25*g_ru(i-1,k,j)*(u(i-1,k,j)+ub)+0.25*g_ru(i,k,j)*(u(i-1,k,j)+ub)+0.25*g_u(i-1,k,j)*(ru(i,k,j)+ru(i-1,k,j)&
1502 &)+0.25*g_ub*(ru(i,k,j)+ru(i-1,k,j))
1503 fqx(i,k) = 0.25*(ru(i,k,j)+ru(i-1,k,j))*(u(i-1,k,j)+ub)
1504 end do
1505 endif
1506 do k = kts, ktf
1507 i = ide-1
1508 g_vel = 0.5*g_ru(i-1,k,j)+0.5*g_ru(i,k,j)
1509 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
1510 g_fqx(i,k) = g_u(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_u(i-1,k,j)*vel*(0.58333333+0.25*sign(1.,vel))+&
1511 &g_u(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_u(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,vel))+g_vel*&
1512 &(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-2,k,j)-3.*(u(i,k,j)-u(i-&
1513 &1,k,j)))*sign(1.,vel))
1514 fqx(i,k) = vel*(7./12.*(u(i,k,j)+u(i-1,k,j))-1./12.*(u(i+1,k,j)+u(i-2,k,j))+sign(1.,vel)*(1./12.)*(u(i+1,k,j)-u(i-2,k,j)-&
1515 &3.*(u(i,k,j)-u(i-1,k,j))))
1516 end do
1517 endif
1518 do k = kts, ktf
1519 do i = i_start, i_end
1520 mrdx = msfu(i,j)*rdx
1521 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
1522 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
1523 end do
1524 end do
1525 end do
1526 else if (horz_order .eq. 4) then horizontal_order_tesu
1527 degrade_xs = .true.
1528 degrade_xe = .true.
1529 degrade_ys = .true.
1530 degrade_ye = .true.
1531 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
1532 degrade_xs = .false.
1533 endif
1534 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-1) then
1535 degrade_xe = .false.
1536 endif
1537 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
1538 degrade_ys = .false.
1539 endif
1540 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
1541 degrade_ye = .false.
1542 endif
1543 i_start = its
1544 i_end = ite
1545 j_start = jts
1546 j_end = min(jte,jde-1)
1547 i_start_f = i_start
1548 i_end_f = i_end+1
1549 if (degrade_xs) then
1550 i_start = ids+1
1551 i_start_f = i_start+1
1552 endif
1553 if (degrade_xe) then
1554 i_end = ide-1
1555 i_end_f = ide-1
1556 endif
1557 do j = j_start, j_end
1558 do k = kts, ktf
1559 do i = i_start_f, i_end_f
1560 g_vel = 0.5*g_ru(i-1,k,j)+0.5*g_ru(i,k,j)
1561 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
1562 g_fqx(i,k) = (-0.083333333)*g_u(i-2,k,j)*vel+0.58333333*g_u(i-1,k,j)*vel-0.083333333*g_u(i+1,k,j)*vel+0.58333333*g_u(i,k,j)&
1563 &*vel+g_vel*(0.58333333*(u(i,k,j)+u(i-1,k,j))-0.083333333*(u(i+1,k,j)+u(i-2,k,j)))
1564 fqx(i,k) = vel*(7./12.*(u(i,k,j)+u(i-1,k,j))-1./12.*(u(i+1,k,j)+u(i-2,k,j)))
1565 end do
1566 end do
1567 if (degrade_xs) then
1568 i = i_start
1569 do k = kts, ktf
1570 g_ub = g_u(i-1,k,j)
1571 ub = u(i-1,k,j)
1572 if (specified .and. u(i,k,j) .lt. 0.) then
1573 g_ub = g_u(i,k,j)
1574 ub = u(i,k,j)
1575 endif
1576 g_fqx(i,k) = 0.25*g_ru(i-1,k,j)*(u(i,k,j)+ub)+0.25*g_ru(i,k,j)*(u(i,k,j)+ub)+0.25*g_u(i,k,j)*(ru(i,k,j)+ru(i-1,k,j))+0.25*&
1577 &g_ub*(ru(i,k,j)+ru(i-1,k,j))
1578 fqx(i,k) = 0.25*(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+ub)
1579 end do
1580 endif
1581 if (degrade_xe) then
1582 i = i_end+1
1583 do k = kts, ktf
1584 g_ub = g_u(i,k,j)
1585 ub = u(i,k,j)
1586 if (specified .and. u(i-1,k,j) .gt. 0.) then
1587 g_ub = g_u(i-1,k,j)
1588 ub = u(i-1,k,j)
1589 endif
1590 g_fqx(i,k) = 0.25*g_ru(i-1,k,j)*(u(i-1,k,j)+ub)+0.25*g_ru(i,k,j)*(u(i-1,k,j)+ub)+0.25*g_u(i-1,k,j)*(ru(i,k,j)+ru(i-1,k,j))+&
1591 &0.25*g_ub*(ru(i,k,j)+ru(i-1,k,j))
1592 fqx(i,k) = 0.25*(ru(i,k,j)+ru(i-1,k,j))*(u(i-1,k,j)+ub)
1593 end do
1594 endif
1595 do k = kts, ktf
1596 do i = i_start, i_end
1597 mrdx = msfu(i,j)*rdx
1598 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
1599 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
1600 end do
1601 end do
1602 end do
1603 i_start = its
1604 i_end = ite
1605 if (config_flags%open_xs .or. specified) then
1606 i_start = max(ids+1,its)
1607 endif
1608 if (config_flags%open_xe .or. specified) then
1609 i_end = min(ide-1,ite)
1610 endif
1611 j_start = jts
1612 j_end = min(jte,jde-1)
1613 j_start_f = j_start
1614 j_end_f = j_end+1
1615 if (degrade_ys) then
1616 j_start = jds+1
1617 j_start_f = j_start+1
1618 endif
1619 if (degrade_ye) then
1620 j_end = jde-2
1621 j_end_f = jde-2
1622 endif
1623 jp1 = 2
1624 jp0 = 1
1625 do j = j_start, j_end+1
1626 if (j .lt. j_start_f .and. degrade_ys) then
1627 do k = kts, ktf
1628 do i = i_start, i_end
1629 g_fqy(i,k,jp1) = 0.25*g_rv(i-1,k,j_start)*(u(i,k,j_start)+u(i,k,j_start-1))+0.25*g_rv(i,k,j_start)*(u(i,k,j_start)+u(i,k,&
1630 &j_start-1))+0.25*g_u(i,k,j_start-1)*(rv(i,k,j_start)+rv(i-1,k,j_start))+0.25*g_u(i,k,j_start)*(rv(i,k,j_start)+rv(i-1,k,j_start))
1631 fqy(i,k,jp1) = 0.25*(rv(i,k,j_start)+rv(i-1,k,j_start))*(u(i,k,j_start)+u(i,k,j_start-1))
1632 end do
1633 end do
1634 else if (j .gt. j_end_f .and. degrade_ye) then
1635 do k = kts, ktf
1636 do i = i_start, i_end
1637 g_fqy(i,k,jp1) = 0.25*g_rv(i-1,k,j_end+1)*(u(i,k,j_end+1)+u(i,k,j_end))+0.25*g_rv(i,k,j_end+1)*(u(i,k,j_end+1)+u(i,k,&
1638 &j_end))+0.25*g_u(i,k,j_end+1)*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))+0.25*g_u(i,k,j_end)*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))
1639 fqy(i,k,jp1) = 0.25*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))*(u(i,k,j_end+1)+u(i,k,j_end))
1640 end do
1641 end do
1642 else
1643 do k = kts, ktf
1644 do i = i_start, i_end
1645 g_vel = 0.5*g_rv(i-1,k,j)+0.5*g_rv(i,k,j)
1646 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
1647 g_fqy(i,k,jp1) = (-0.083333333)*g_u(i,k,j-2)*vel+0.58333333*g_u(i,k,j-1)*vel-0.083333333*g_u(i,k,j+1)*vel+0.58333333*&
1648 &g_u(i,k,j)*vel+g_vel*(0.58333333*(u(i,k,j)+u(i,k,j-1))-0.083333333*(u(i,k,j+1)+u(i,k,j-2)))
1649 fqy(i,k,jp1) = vel*(7./12.*(u(i,k,j)+u(i,k,j-1))-1./12.*(u(i,k,j+1)+u(i,k,j-2)))
1650 end do
1651 end do
1652 endif
1653 if (j .gt. j_start) then
1654 do k = kts, ktf
1655 do i = i_start, i_end
1656 mrdy = msfu(i,j-1)*rdy
1657 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
1658 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
1659 end do
1660 end do
1661 endif
1662 jtmp = jp1
1663 jp1 = jp0
1664 jp0 = jtmp
1665 end do
1666 else if (horz_order .eq. 3) then horizontal_order_tesu
1667 degrade_xs = .true.
1668 degrade_xe = .true.
1669 degrade_ys = .true.
1670 degrade_ye = .true.
1671 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
1672 degrade_xs = .false.
1673 endif
1674 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-1) then
1675 degrade_xe = .false.
1676 endif
1677 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
1678 degrade_ys = .false.
1679 endif
1680 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
1681 degrade_ye = .false.
1682 endif
1683 i_start = its
1684 i_end = ite
1685 j_start = jts
1686 j_end = min(jte,jde-1)
1687 i_start_f = i_start
1688 i_end_f = i_end+1
1689 if (degrade_xs) then
1690 i_start = ids+1
1691 i_start_f = i_start+1
1692 endif
1693 if (degrade_xe) then
1694 i_end = ide-1
1695 i_end_f = ide-1
1696 endif
1697 do j = j_start, j_end
1698 do k = kts, ktf
1699 do i = i_start_f, i_end_f
1700 g_vel = 0.5*g_ru(i-1,k,j)+0.5*g_ru(i,k,j)
1701 vel = 0.5*(ru(i,k,j)+ru(i-1,k,j))
1702 g_fqx(i,k) = g_u(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_u(i-1,k,j)*vel*(0.58333333+0.25*sign(1.,vel))+&
1703 &g_u(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_u(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,vel))+g_vel*&
1704 &(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-2,k,j)-3.*(u(i,k,j)-u(i-&
1705 &1,k,j)))*sign(1.,vel))
1706 fqx(i,k) = vel*(7./12.*(u(i,k,j)+u(i-1,k,j))-1./12.*(u(i+1,k,j)+u(i-2,k,j))+sign(1.,vel)*(1./12.)*(u(i+1,k,j)-u(i-2,k,j)-&
1707 &3.*(u(i,k,j)-u(i-1,k,j))))
1708 end do
1709 end do
1710 if (degrade_xs) then
1711 i = i_start
1712 do k = kts, ktf
1713 g_ub = g_u(i-1,k,j)
1714 ub = u(i-1,k,j)
1715 if (specified .and. u(i,k,j) .lt. 0.) then
1716 g_ub = g_u(i,k,j)
1717 ub = u(i,k,j)
1718 endif
1719 g_fqx(i,k) = 0.25*g_ru(i-1,k,j)*(u(i,k,j)+ub)+0.25*g_ru(i,k,j)*(u(i,k,j)+ub)+0.25*g_u(i,k,j)*(ru(i,k,j)+ru(i-1,k,j))+0.25*&
1720 &g_ub*(ru(i,k,j)+ru(i-1,k,j))
1721 fqx(i,k) = 0.25*(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+ub)
1722 end do
1723 endif
1724 if (degrade_xe) then
1725 i = i_end+1
1726 do k = kts, ktf
1727 g_ub = g_u(i,k,j)
1728 ub = u(i,k,j)
1729 if (specified .and. u(i-1,k,j) .gt. 0.) then
1730 g_ub = g_u(i-1,k,j)
1731 ub = u(i-1,k,j)
1732 endif
1733 g_fqx(i,k) = 0.25*g_ru(i-1,k,j)*(u(i-1,k,j)+ub)+0.25*g_ru(i,k,j)*(u(i-1,k,j)+ub)+0.25*g_u(i-1,k,j)*(ru(i,k,j)+ru(i-1,k,j))+&
1734 &0.25*g_ub*(ru(i,k,j)+ru(i-1,k,j))
1735 fqx(i,k) = 0.25*(ru(i,k,j)+ru(i-1,k,j))*(u(i-1,k,j)+ub)
1736 end do
1737 endif
1738 do k = kts, ktf
1739 do i = i_start, i_end
1740 mrdx = msfu(i,j)*rdx
1741 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
1742 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
1743 end do
1744 end do
1745 end do
1746 i_start = its
1747 i_end = ite
1748 if (config_flags%open_xs .or. specified) then
1749 i_start = max(ids+1,its)
1750 endif
1751 if (config_flags%open_xe .or. specified) then
1752 i_end = min(ide-1,ite)
1753 endif
1754 j_start = jts
1755 j_end = min(jte,jde-1)
1756 j_start_f = j_start
1757 j_end_f = j_end+1
1758 if (degrade_ys) then
1759 j_start = jds+1
1760 j_start_f = j_start+1
1761 endif
1762 if (degrade_ye) then
1763 j_end = jde-2
1764 j_end_f = jde-2
1765 endif
1766 jp1 = 2
1767 jp0 = 1
1768 do j = j_start, j_end+1
1769 if (j .lt. j_start_f .and. degrade_ys) then
1770 do k = kts, ktf
1771 do i = i_start, i_end
1772 g_fqy(i,k,jp1) = 0.25*g_rv(i-1,k,j_start)*(u(i,k,j_start)+u(i,k,j_start-1))+0.25*g_rv(i,k,j_start)*(u(i,k,j_start)+u(i,k,&
1773 &j_start-1))+0.25*g_u(i,k,j_start-1)*(rv(i,k,j_start)+rv(i-1,k,j_start))+0.25*g_u(i,k,j_start)*(rv(i,k,j_start)+rv(i-1,k,j_start))
1774 fqy(i,k,jp1) = 0.25*(rv(i,k,j_start)+rv(i-1,k,j_start))*(u(i,k,j_start)+u(i,k,j_start-1))
1775 end do
1776 end do
1777 else if (j .gt. j_end_f .and. degrade_ye) then
1778 do k = kts, ktf
1779 do i = i_start, i_end
1780 g_fqy(i,k,jp1) = 0.25*g_rv(i-1,k,j_end+1)*(u(i,k,j_end+1)+u(i,k,j_end))+0.25*g_rv(i,k,j_end+1)*(u(i,k,j_end+1)+u(i,k,&
1781 &j_end))+0.25*g_u(i,k,j_end+1)*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))+0.25*g_u(i,k,j_end)*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))
1782 fqy(i,k,jp1) = 0.25*(rv(i,k,j_end+1)+rv(i-1,k,j_end+1))*(u(i,k,j_end+1)+u(i,k,j_end))
1783 end do
1784 end do
1785 else
1786 do k = kts, ktf
1787 do i = i_start, i_end
1788 g_vel = 0.5*g_rv(i-1,k,j)+0.5*g_rv(i,k,j)
1789 vel = 0.5*(rv(i,k,j)+rv(i-1,k,j))
1790 g_fqy(i,k,jp1) = g_u(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_u(i,k,j-1)*vel*(0.58333333+0.25*sign(1.,&
1791 &vel))+g_u(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_u(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,vel))+g_vel*&
1792 &(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+1)-u(i,k,j-2)-3.*(u(i,k,j)-&
1793 &u(i,k,j-1)))*sign(1.,vel))
1794 fqy(i,k,jp1) = vel*(7./12.*(u(i,k,j)+u(i,k,j-1))-1./12.*(u(i,k,j+1)+u(i,k,j-2))+sign(1.,vel)*(1./12.)*(u(i,k,j+1)-u(i,k,&
1795 &j-2)-3.*(u(i,k,j)-u(i,k,j-1))))
1796 end do
1797 end do
1798 endif
1799 if (j .gt. j_start) then
1800 do k = kts, ktf
1801 do i = i_start, i_end
1802 mrdy = msfu(i,j-1)*rdy
1803 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
1804 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
1805 end do
1806 end do
1807 endif
1808 jtmp = jp1
1809 jp1 = jp0
1810 jp0 = jtmp
1811 end do
1812 else if (horz_order .eq. 2) then horizontal_order_tesu
1813 i_start = its
1814 i_end = ite
1815 j_start = jts
1816 j_end = min(jte,jde-1)
1817 if (config_flags%open_xs) then
1818 i_start = max(ids+1,its)
1819 endif
1820 if (config_flags%open_xe) then
1821 i_end = min(ide-1,ite)
1822 endif
1823 if (specified) then
1824 i_start = max(ids+2,its)
1825 endif
1826 if (specified) then
1827 i_end = min(ide-2,ite)
1828 endif
1829 do j = j_start, j_end
1830 do k = kts, ktf
1831 do i = i_start, i_end
1832 mrdx = msfu(i,j)*rdx
1833 g_tendency(i,k,j) = 0.25*g_ru(i-1,k,j)*mrdx*(u(i,k,j)+u(i-1,k,j))-0.25*g_ru(i+1,k,j)*mrdx*(u(i+1,k,j)+u(i,k,j))-0.25*&
1834 &g_ru(i,k,j)*mrdx*(u(i+1,k,j)+u(i,k,j)-(u(i,k,j)+u(i-1,k,j)))+g_tendency(i,k,j)+0.25*g_u(i-1,k,j)*mrdx*(ru(i,k,j)+ru(i-1,k,&
1835 &j))-0.25*g_u(i+1,k,j)*mrdx*(ru(i+1,k,j)+ru(i,k,j))-0.25*g_u(i,k,j)*mrdx*(ru(i+1,k,j)+ru(i,k,j)-(ru(i,k,j)+ru(i-1,k,j)))
1836 tendency(i,k,j) = tendency(i,k,j)-mrdx*0.25*((ru(i+1,k,j)+ru(i,k,j))*(u(i+1,k,j)+u(i,k,j))-(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,&
1837 &j)+u(i-1,k,j)))
1838 end do
1839 end do
1840 end do
1841 if (specified .and. its .le. ids+1) then
1842 do j = j_start, j_end
1843 do k = kts, ktf
1844 i = ids+1
1845 mrdx = msfu(i,j)*rdx
1846 g_ub = g_u(i-1,k,j)
1847 ub = u(i-1,k,j)
1848 if (u(i,k,j) .lt. 0.) then
1849 g_ub = g_u(i,k,j)
1850 ub = u(i,k,j)
1851 endif
1852 g_tendency(i,k,j) = 0.25*g_ru(i-1,k,j)*mrdx*(u(i,k,j)+ub)-0.25*g_ru(i+1,k,j)*mrdx*(u(i+1,k,j)+u(i,k,j))-0.25*g_ru(i,k,j)*&
1853 &mrdx*(u(i+1,k,j)+u(i,k,j)-(u(i,k,j)+ub))+g_tendency(i,k,j)-0.25*g_u(i+1,k,j)*mrdx*(ru(i+1,k,j)+ru(i,k,j))-0.25*g_u(i,k,j)*&
1854 &mrdx*(ru(i+1,k,j)+ru(i,k,j)-(ru(i,k,j)+ru(i-1,k,j)))+0.25*g_ub*mrdx*(ru(i,k,j)+ru(i-1,k,j))
1855 tendency(i,k,j) = tendency(i,k,j)-mrdx*0.25*((ru(i+1,k,j)+ru(i,k,j))*(u(i+1,k,j)+u(i,k,j))-(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,&
1856 &j)+ub))
1857 end do
1858 end do
1859 endif
1860 if (specified .and. ite .ge. ide-1) then
1861 do j = j_start, j_end
1862 do k = kts, ktf
1863 i = ide-1
1864 mrdx = msfu(i,j)*rdx
1865 g_ub = g_u(i+1,k,j)
1866 ub = u(i+1,k,j)
1867 if (u(i,k,j) .gt. 0.) then
1868 g_ub = g_u(i,k,j)
1869 ub = u(i,k,j)
1870 endif
1871 g_tendency(i,k,j) = 0.25*g_ru(i-1,k,j)*mrdx*(u(i,k,j)+u(i-1,k,j))-0.25*g_ru(i+1,k,j)*mrdx*(ub+u(i,k,j))-0.25*g_ru(i,k,j)*&
1872 &mrdx*(ub+u(i,k,j)-(u(i,k,j)+u(i-1,k,j)))+g_tendency(i,k,j)+0.25*g_u(i-1,k,j)*mrdx*(ru(i,k,j)+ru(i-1,k,j))-0.25*g_u(i,k,j)*&
1873 &mrdx*(ru(i+1,k,j)+ru(i,k,j)-(ru(i,k,j)+ru(i-1,k,j)))-0.25*g_ub*mrdx*(ru(i+1,k,j)+ru(i,k,j))
1874 tendency(i,k,j) = tendency(i,k,j)-mrdx*0.25*((ru(i+1,k,j)+ru(i,k,j))*(ub+u(i,k,j))-(ru(i,k,j)+ru(i-1,k,j))*(u(i,k,j)+u(i-1,&
1875 &k,j)))
1876 end do
1877 end do
1878 endif
1879 if (config_flags%open_ys .or. specified) then
1880 j_start = max(jds+1,jts)
1881 endif
1882 if (config_flags%open_ye .or. specified) then
1883 j_end = min(jde-2,jte)
1884 endif
1885 do j = j_start, j_end
1886 do k = kts, ktf
1887 do i = i_start, i_end
1888 mrdy = msfu(i,j)*rdy
1889 g_tendency(i,k,j) = (-(0.25*g_rv(i-1,k,j+1)*mrdy*(u(i,k,j+1)+u(i,k,j))))-0.25*g_rv(i,k,j+1)*mrdy*(u(i,k,j+1)+u(i,k,j))+&
1890 &0.25*g_rv(i-1,k,j)*mrdy*(u(i,k,j)+u(i,k,j-1))+0.25*g_rv(i,k,j)*mrdy*(u(i,k,j)+u(i,k,j-1))+g_tendency(i,k,j)+0.25*g_u(i,k,&
1891 &j-1)*mrdy*(rv(i,k,j)+rv(i-1,k,j))-0.25*g_u(i,k,j+1)*mrdy*(rv(i,k,j+1)+rv(i-1,k,j+1))-0.25*g_u(i,k,j)*mrdy*(rv(i,k,j+1)+&
1892 &rv(i-1,k,j+1)-(rv(i,k,j)+rv(i-1,k,j)))
1893 tendency(i,k,j) = tendency(i,k,j)-mrdy*0.25*((rv(i,k,j+1)+rv(i-1,k,j+1))*(u(i,k,j+1)+u(i,k,j))-(rv(i,k,j)+rv(i-1,k,j))*&
1894 &(u(i,k,j)+u(i,k,j-1)))
1895 end do
1896 end do
1897 end do
1898 else horizontal_order_tesu
1899 write(unit=wrf_err_message,fmt=*) 'module_advect: advect_u_6a: h_order not known ',horz_order
1900 endif horizontal_order_tesu
1901 if (config_flags%open_xs .and. its .eq. ids) then
1902 j_start = jts
1903 j_end = min(jte,jde-1)
1904 do j = j_start, j_end
1905 do k = kts, ktf
1906 g_ub = (-(g_mut(its,j)*(0.5+sign(0.5,0.-(ru(its,k,j)-cb*mut(its,j))))*cb))+g_ru(its,k,j)*(0.5+sign(0.5,0.-(ru(its,k,j)-cb*&
1907 &mut(its,j))))
1908 ub = min(ru(its,k,j)-cb*mut(its,j),0.)
1909 g_tendency(its,k,j) = g_tendency(its,k,j)-g_u_old(its+1,k,j)*rdx*ub+g_u_old(its,k,j)*rdx*ub-g_ub*rdx*(u_old(its+1,k,j)-&
1910 &u_old(its,k,j))
1911 tendency(its,k,j) = tendency(its,k,j)-rdx*ub*(u_old(its+1,k,j)-u_old(its,k,j))
1912 end do
1913 end do
1914 endif
1915 if (config_flags%open_xe .and. ite .eq. ide) then
1916 j_start = jts
1917 j_end = min(jte,jde-1)
1918 do j = j_start, j_end
1919 do k = kts, ktf
1920 g_ub = g_mut(ite-1,j)*(0.5+sign(0.5,ru(ite,k,j)+cb*mut(ite-1,j)-0.))*cb+g_ru(ite,k,j)*(0.5+sign(0.5,ru(ite,k,j)+cb*mut(ite-1,&
1921 &j)-0.))
1922 ub = max(ru(ite,k,j)+cb*mut(ite-1,j),0.)
1923 g_tendency(ite,k,j) = g_tendency(ite,k,j)+g_u_old(ite-1,k,j)*rdx*ub-g_u_old(ite,k,j)*rdx*ub-g_ub*rdx*(u_old(ite,k,j)-&
1924 &u_old(ite-1,k,j))
1925 tendency(ite,k,j) = tendency(ite,k,j)-rdx*ub*(u_old(ite,k,j)-u_old(ite-1,k,j))
1926 end do
1927 end do
1928 endif
1929 i_start = its
1930 i_end = min(ite,ide)
1931 imin = ids
1932 imax = ide-1
1933 if (config_flags%open_xs) then
1934 i_start = max(ids+1,its)
1935 imin = ids
1936 endif
1937 if (config_flags%open_xe) then
1938 i_end = min(ite,ide-1)
1939 imax = ide-1
1940 endif
1941 if (config_flags%open_ys .and. jts .eq. jds) then
1942 do i = i_start, i_end
1943 mrdy = msfu(i,jts)*rdy
1944 ip = min(imax,i)
1945 im = max(imin,i-1)
1946 do k = kts, ktf
1947 g_vw = 0.5*g_rv(im,k,jts)+0.5*g_rv(ip,k,jts)
1948 vw = 0.5*(rv(ip,k,jts)+rv(im,k,jts))
1949 g_vb = g_vw*(0.5+sign(0.5,0.-vw))
1950 vb = min(vw,0.)
1951 g_dvm = g_rv(ip,k,jts+1)-g_rv(ip,k,jts)
1952 dvm = rv(ip,k,jts+1)-rv(ip,k,jts)
1953 g_dvp = g_rv(im,k,jts+1)-g_rv(im,k,jts)
1954 dvp = rv(im,k,jts+1)-rv(im,k,jts)
1955 g_tendency(i,k,jts) = (-(0.5*g_dvm*mrdy*u(i,k,jts)))-0.5*g_dvp*mrdy*u(i,k,jts)+g_tendency(i,k,jts)-0.5*g_u(i,k,jts)*mrdy*&
1956 &(dvm+dvp)-g_u_old(i,k,jts+1)*mrdy*vb+g_u_old(i,k,jts)*mrdy*vb-g_vb*mrdy*(u_old(i,k,jts+1)-u_old(i,k,jts))
1957 tendency(i,k,jts) = tendency(i,k,jts)-mrdy*(vb*(u_old(i,k,jts+1)-u_old(i,k,jts))+0.5*u(i,k,jts)*(dvm+dvp))
1958 end do
1959 end do
1960 endif
1961 if (config_flags%open_ye .and. jte .eq. jde) then
1962 do i = i_start, i_end
1963 mrdy = msfu(i,jte-1)*rdy
1964 ip = min(imax,i)
1965 im = max(imin,i-1)
1966 do k = kts, ktf
1967 g_vw = 0.5*g_rv(im,k,jte)+0.5*g_rv(ip,k,jte)
1968 vw = 0.5*(rv(ip,k,jte)+rv(im,k,jte))
1969 g_vb = g_vw*(0.5+sign(0.5,vw-0.))
1970 vb = max(vw,0.)
1971 g_dvm = (-g_rv(ip,k,jte-1))+g_rv(ip,k,jte)
1972 dvm = rv(ip,k,jte)-rv(ip,k,jte-1)
1973 g_dvp = (-g_rv(im,k,jte-1))+g_rv(im,k,jte)
1974 dvp = rv(im,k,jte)-rv(im,k,jte-1)
1975 g_tendency(i,k,jte-1) = (-(0.5*g_dvm*mrdy*u(i,k,jte-1)))-0.5*g_dvp*mrdy*u(i,k,jte-1)+g_tendency(i,k,jte-1)-0.5*g_u(i,k,jte-1)&
1976 &*mrdy*(dvm+dvp)+g_u_old(i,k,jte-2)*mrdy*vb-g_u_old(i,k,jte-1)*mrdy*vb-g_vb*mrdy*(u_old(i,k,jte-1)-u_old(i,k,jte-2))
1977 tendency(i,k,jte-1) = tendency(i,k,jte-1)-mrdy*(vb*(u_old(i,k,jte-1)-u_old(i,k,jte-2))+0.5*u(i,k,jte-1)*(dvm+dvp))
1978 end do
1979 end do
1980 endif
1981 i_start = its
1982 i_end = ite
1983 j_start = jts
1984 j_end = min(jte,jde-1)
1985 if (config_flags%open_ys .or. specified) then
1986 i_start = max(ids+1,its)
1987 endif
1988 if (config_flags%open_ye .or. specified) then
1989 i_end = min(ide-1,ite)
1990 endif
1991 do i = i_start, i_end
1992 g_vflux(i,kts) = 0.
1993 vflux(i,kts) = 0.
1994 g_vflux(i,kte) = 0.
1995 vflux(i,kte) = 0.
1996 end do
1997 vert_order_tesu: if (vert_order .eq. 6) then
1998 do j = j_start, j_end
1999 do k = kts+3, ktf-2
2000 do i = i_start, i_end
2001 g_vel = 0.5*g_rom(i-1,k,j)+0.5*g_rom(i,k,j)
2002 vel = 0.5*(rom(i-1,k,j)+rom(i,k,j))
2003 g_vflux(i,k) = 0.016666667*g_u(i,k-3,j)*vel-0.13333333*g_u(i,k-2,j)*vel+0.61666667*g_u(i,k-1,j)*vel+0.016666667*g_u(i,k+2,&
2004 &j)*vel-0.13333333*g_u(i,k+1,j)*vel+0.61666667*g_u(i,k,j)*vel+g_vel*(0.61666667*(u(i,k,j)+u(i,k-1,j))-0.13333333*(u(i,k+1,&
2005 &j)+u(i,k-2,j))+0.016666667*(u(i,k+2,j)+u(i,k-3,j)))
2006 vflux(i,k) = vel*(37./60.*(u(i,k,j)+u(i,k-1,j))-2./15.*(u(i,k+1,j)+u(i,k-2,j))+1./60.*(u(i,k+2,j)+u(i,k-3,j)))
2007 end do
2008 end do
2009 do i = i_start, i_end
2010 k = kts+1
2011 g_vflux(i,k) = 0.5*g_rom(i-1,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+&
2012 &0.5*g_u(i,k-1,j)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)+0.5*g_u(i,k,j)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2013 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i-1,k,j))*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2014 k = kts+2
2015 g_vel = 0.5*g_rom(i-1,k,j)+0.5*g_rom(i,k,j)
2016 vel = 0.5*(rom(i,k,j)+rom(i-1,k,j))
2017 g_vflux(i,k) = (-0.083333333)*g_u(i,k-2,j)*vel+0.58333333*g_u(i,k-1,j)*vel-0.083333333*g_u(i,k+1,j)*vel+0.58333333*g_u(i,k,j)&
2018 &*vel+g_vel*(0.58333333*(u(i,k,j)+u(i,k-1,j))-0.083333333*(u(i,k+1,j)+u(i,k-2,j)))
2019 vflux(i,k) = vel*(7./12.*(u(i,k,j)+u(i,k-1,j))-1./12.*(u(i,k+1,j)+u(i,k-2,j)))
2020 k = ktf-1
2021 g_vel = 0.5*g_rom(i-1,k,j)+0.5*g_rom(i,k,j)
2022 vel = 0.5*(rom(i,k,j)+rom(i-1,k,j))
2023 g_vflux(i,k) = (-0.083333333)*g_u(i,k-2,j)*vel+0.58333333*g_u(i,k-1,j)*vel-0.083333333*g_u(i,k+1,j)*vel+0.58333333*g_u(i,k,j)&
2024 &*vel+g_vel*(0.58333333*(u(i,k,j)+u(i,k-1,j))-0.083333333*(u(i,k+1,j)+u(i,k-2,j)))
2025 vflux(i,k) = vel*(7./12.*(u(i,k,j)+u(i,k-1,j))-1./12.*(u(i,k+1,j)+u(i,k-2,j)))
2026 k = ktf
2027 g_vflux(i,k) = 0.5*g_rom(i-1,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+&
2028 &0.5*g_u(i,k-1,j)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)+0.5*g_u(i,k,j)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2029 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i-1,k,j))*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2030 end do
2031 do k = kts, ktf
2032 do i = i_start, i_end
2033 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
2034 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
2035 end do
2036 end do
2037 end do
2038 else if (vert_order .eq. 5) then vert_order_tesu
2039 do j = j_start, j_end
2040 do k = kts+3, ktf-2
2041 do i = i_start, i_end
2042 g_vel = 0.5*g_rom(i-1,k,j)+0.5*g_rom(i,k,j)
2043 vel = 0.5*(rom(i-1,k,j)+rom(i,k,j))
2044 g_vflux(i,k) = g_u(i,k-3,j)*vel*(0.016666667-(-0.016666667)*sign(1.,-vel))+g_u(i,k-2,j)*vel*((-0.13333333)-0.083333333*&
2045 &sign(1.,-vel))+g_u(i,k-1,j)*vel*(0.61666667-(-0.16666667)*sign(1.,-vel))+g_u(i,k+2,j)*vel*(0.016666667-0.016666667*&
2046 &sign(1.,-vel))+g_u(i,k+1,j)*vel*((-0.13333333)-(-0.083333333)*sign(1.,-vel))+g_u(i,k,j)*vel*(0.61666667-0.16666667*&
2047 &sign(1.,-vel))+g_vel*(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)+u(i,k-3,&
2048 &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))
2049 vflux(i,k) = vel*(37./60.*(u(i,k,j)+u(i,k-1,j))-2./15.*(u(i,k+1,j)+u(i,k-2,j))+1./60.*(u(i,k+2,j)+u(i,k-3,j))-sign(1.,-vel)&
2050 &*(1./60.)*(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))))
2051 end do
2052 end do
2053 do i = i_start, i_end
2054 k = kts+1
2055 g_vflux(i,k) = 0.5*g_rom(i-1,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+&
2056 &0.5*g_u(i,k-1,j)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)+0.5*g_u(i,k,j)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2057 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i-1,k,j))*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2058 k = kts+2
2059 g_vel = 0.5*g_rom(i-1,k,j)+0.5*g_rom(i,k,j)
2060 vel = 0.5*(rom(i,k,j)+rom(i-1,k,j))
2061 g_vflux(i,k) = g_u(i,k-2,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))+g_u(i,k-1,j)*vel*(0.58333333+0.25*sign(1.,-vel)&
2062 &)+g_u(i,k+1,j)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))+g_u(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,-vel))+g_vel*&
2063 &(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,k-2,j)-3.*(u(i,k,j)-u(i,k-&
2064 &1,j)))*sign(1.,-vel))
2065 vflux(i,k) = vel*(7./12.*(u(i,k,j)+u(i,k-1,j))-1./12.*(u(i,k+1,j)+u(i,k-2,j))+sign(1.,-vel)*(1./12.)*(u(i,k+1,j)-u(i,k-2,j)-&
2066 &3.*(u(i,k,j)-u(i,k-1,j))))
2067 k = ktf-1
2068 g_vel = 0.5*g_rom(i-1,k,j)+0.5*g_rom(i,k,j)
2069 vel = 0.5*(rom(i,k,j)+rom(i-1,k,j))
2070 g_vflux(i,k) = g_u(i,k-2,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))+g_u(i,k-1,j)*vel*(0.58333333+0.25*sign(1.,-vel)&
2071 &)+g_u(i,k+1,j)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))+g_u(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,-vel))+g_vel*&
2072 &(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,k-2,j)-3.*(u(i,k,j)-u(i,k-&
2073 &1,j)))*sign(1.,-vel))
2074 vflux(i,k) = vel*(7./12.*(u(i,k,j)+u(i,k-1,j))-1./12.*(u(i,k+1,j)+u(i,k-2,j))+sign(1.,-vel)*(1./12.)*(u(i,k+1,j)-u(i,k-2,j)-&
2075 &3.*(u(i,k,j)-u(i,k-1,j))))
2076 k = ktf
2077 g_vflux(i,k) = 0.5*g_rom(i-1,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+&
2078 &0.5*g_u(i,k-1,j)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)+0.5*g_u(i,k,j)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2079 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i-1,k,j))*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2080 end do
2081 do k = kts, ktf
2082 do i = i_start, i_end
2083 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
2084 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
2085 end do
2086 end do
2087 end do
2088 else if (vert_order .eq. 4) then vert_order_tesu
2089 do j = j_start, j_end
2090 do k = kts+2, ktf-1
2091 do i = i_start, i_end
2092 g_vel = 0.5*g_rom(i-1,k,j)+0.5*g_rom(i,k,j)
2093 vel = 0.5*(rom(i-1,k,j)+rom(i,k,j))
2094 g_vflux(i,k) = (-0.083333333)*g_u(i,k-2,j)*vel+0.58333333*g_u(i,k-1,j)*vel-0.083333333*g_u(i,k+1,j)*vel+0.58333333*g_u(i,k,&
2095 &j)*vel+g_vel*(0.58333333*(u(i,k,j)+u(i,k-1,j))-0.083333333*(u(i,k+1,j)+u(i,k-2,j)))
2096 vflux(i,k) = vel*(7./12.*(u(i,k,j)+u(i,k-1,j))-1./12.*(u(i,k+1,j)+u(i,k-2,j)))
2097 end do
2098 end do
2099 do i = i_start, i_end
2100 k = kts+1
2101 g_vflux(i,k) = 0.5*g_rom(i-1,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+&
2102 &0.5*g_u(i,k-1,j)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)+0.5*g_u(i,k,j)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2103 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i-1,k,j))*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2104 k = ktf
2105 g_vflux(i,k) = 0.5*g_rom(i-1,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+&
2106 &0.5*g_u(i,k-1,j)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)+0.5*g_u(i,k,j)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2107 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i-1,k,j))*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2108 end do
2109 do k = kts, ktf
2110 do i = i_start, i_end
2111 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
2112 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
2113 end do
2114 end do
2115 end do
2116 else if (vert_order .eq. 3) then vert_order_tesu
2117 do j = j_start, j_end
2118 do k = kts+2, ktf-1
2119 do i = i_start, i_end
2120 g_vel = 0.5*g_rom(i-1,k,j)+0.5*g_rom(i,k,j)
2121 vel = 0.5*(rom(i-1,k,j)+rom(i,k,j))
2122 g_vflux(i,k) = g_u(i,k-2,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))+g_u(i,k-1,j)*vel*(0.58333333+0.25*sign(1.,-&
2123 &vel))+g_u(i,k+1,j)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))+g_u(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,-vel))+g_vel*&
2124 &(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,k-2,j)-3.*(u(i,k,j)-u(i,&
2125 &k-1,j)))*sign(1.,-vel))
2126 vflux(i,k) = vel*(7./12.*(u(i,k,j)+u(i,k-1,j))-1./12.*(u(i,k+1,j)+u(i,k-2,j))+sign(1.,-vel)*(1./12.)*(u(i,k+1,j)-u(i,k-2,j)&
2127 &-3.*(u(i,k,j)-u(i,k-1,j))))
2128 end do
2129 end do
2130 do i = i_start, i_end
2131 k = kts+1
2132 g_vflux(i,k) = 0.5*g_rom(i-1,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+&
2133 &0.5*g_u(i,k-1,j)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)+0.5*g_u(i,k,j)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2134 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i-1,k,j))*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2135 k = ktf
2136 g_vflux(i,k) = 0.5*g_rom(i-1,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+&
2137 &0.5*g_u(i,k-1,j)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)+0.5*g_u(i,k,j)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2138 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i-1,k,j))*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2139 end do
2140 do k = kts, ktf
2141 do i = i_start, i_end
2142 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
2143 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
2144 end do
2145 end do
2146 end do
2147 else if (vert_order .eq. 2) then vert_order_tesu
2148 do j = j_start, j_end
2149 do k = kts+1, ktf
2150 do i = i_start, i_end
2151 g_vflux(i,k) = 0.5*g_rom(i-1,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))+&
2152 &0.5*g_u(i,k-1,j)*(rom(i,k,j)+rom(i-1,k,j))*fzp(k)+0.5*g_u(i,k,j)*(rom(i,k,j)+rom(i-1,k,j))*fzm(k)
2153 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i-1,k,j))*(fzm(k)*u(i,k,j)+fzp(k)*u(i,k-1,j))
2154 end do
2155 end do
2156 do k = kts, ktf
2157 do i = i_start, i_end
2158 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
2159 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
2160 end do
2161 end do
2162 end do
2163 endif vert_order_tesu
2164
2165 end subroutine g_advect_u
2166
2167
2168 subroutine g_advect_v( v, g_v, v_old, g_v_old, tendency, g_tendency, ru, g_ru, rv, g_rv, rom, g_rom, mut, g_mut, config_flags, &
2169 &msfv, fzm, fzp, rdx, rdy, rdzw, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
2170 !******************************************************************
2171 !******************************************************************
2172 !** This routine was generated by Automatic differentiation. **
2173 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
2174 !******************************************************************
2175 !******************************************************************
2176 !==============================================
2177 ! all entries are defined explicitly
2178 !==============================================
2179 implicit none
2180
2181 !==============================================
2182 ! declare arguments
2183 !==============================================
2184 type (grid_config_rec_type), intent(in) :: config_flags
2185 integer, intent(in) :: kme
2186 integer, intent(in) :: kms
2187 real, intent(in) :: fzm(kms:kme)
2188 real, intent(in) :: fzp(kms:kme)
2189 integer, intent(in) :: ime
2190 integer, intent(in) :: ims
2191 integer, intent(in) :: jme
2192 integer, intent(in) :: jms
2193 real, intent(in) :: g_mut(ims:ime,jms:jme)
2194 real, intent(in) :: g_rom(ims:ime,kms:kme,jms:jme)
2195 real, intent(in) :: g_ru(ims:ime,kms:kme,jms:jme)
2196 real, intent(in) :: g_rv(ims:ime,kms:kme,jms:jme)
2197 real, intent(inout) :: g_tendency(ims:ime,kms:kme,jms:jme)
2198 real, intent(in) :: g_v(ims:ime,kms:kme,jms:jme)
2199 real, intent(in) :: g_v_old(ims:ime,kms:kme,jms:jme)
2200 integer, intent(in) :: ide
2201 integer, intent(in) :: ids
2202 integer, intent(in) :: ite
2203 integer, intent(in) :: its
2204 integer, intent(in) :: jde
2205 integer, intent(in) :: jds
2206 integer, intent(in) :: jte
2207 integer, intent(in) :: jts
2208 integer, intent(in) :: kde
2209 integer, intent(in) :: kte
2210 integer, intent(in) :: kts
2211 real, intent(in) :: msfv(ims:ime,jms:jme)
2212 real, intent(in) :: mut(ims:ime,jms:jme)
2213 real, intent(in) :: rdx
2214 real, intent(in) :: rdy
2215 real, intent(in) :: rdzw(kms:kme)
2216 real, intent(in) :: rom(ims:ime,kms:kme,jms:jme)
2217 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
2218 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
2219 real, intent(inout) :: tendency(ims:ime,kms:kme,jms:jme)
2220 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
2221 real, intent(in) :: v_old(ims:ime,kms:kme,jms:jme)
2222
2223 !==============================================
2224 ! declare local variables
2225 !==============================================
2226 logical degrade_xe
2227 logical degrade_xs
2228 logical degrade_ye
2229 logical degrade_ys
2230 real dum
2231 real dup
2232 real fqx(its:ite+1,kts:kte)
2233 real fqy(its:ite,kts:kte,2)
2234 real g_dum
2235 real g_dup
2236 real g_fqx(its:ite+1,kts:kte)
2237 real g_fqy(its:ite,kts:kte,2)
2238 real g_ub
2239 real g_uw
2240 real g_vb
2241 real g_vel
2242 real g_vflux(its:ite,kts:kte)
2243 integer horz_order
2244 integer i
2245 integer i_end
2246 integer i_end_f
2247 integer i_start
2248 integer i_start_f
2249 integer j
2250 integer j_end
2251 integer j_end_f
2252 integer j_start
2253 integer j_start_f
2254 integer jm
2255 integer jmax
2256 integer jmin
2257 integer jp
2258 integer jp0
2259 integer jp1
2260 integer jtmp
2261 integer k
2262 integer ktf
2263 real mrdx
2264 real mrdy
2265 logical specified
2266 real ub
2267 real uw
2268 real vb
2269 real vel
2270 integer vert_order
2271 real vflux(its:ite,kts:kte)
2272
2273 !----------------------------------------------
2274 ! TANGENT LINEAR AND FUNCTION STATEMENTS
2275 !----------------------------------------------
2276 specified = .false.
2277 if (config_flags%specified .or. config_flags%nested) then
2278 specified = .true.
2279 endif
2280 ktf = min(kte,kde-1)
2281 horz_order = config_flags%h_mom_adv_order
2282 vert_order = config_flags%v_mom_adv_order
2283 horizontal_order_tesu: if (horz_order .eq. 6) then
2284 degrade_xs = .true.
2285 degrade_xe = .true.
2286 degrade_ys = .true.
2287 degrade_ye = .true.
2288 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
2289 degrade_xs = .false.
2290 endif
2291 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-3) then
2292 degrade_xe = .false.
2293 endif
2294 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
2295 degrade_ys = .false.
2296 endif
2297 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
2298 degrade_ye = .false.
2299 endif
2300 ktf = min(kte,kde-1)
2301 i_start = its
2302 i_end = min(ite,ide-1)
2303 j_start = jts
2304 j_end = jte
2305 j_start_f = j_start
2306 j_end_f = j_end+1
2307 if (degrade_ys) then
2308 j_start = max(jts,jds+1)
2309 j_start_f = jds+3
2310 endif
2311 if (degrade_ye) then
2312 j_end = min(jte,jde-1)
2313 j_end_f = jde-2
2314 endif
2315 jp1 = 2
2316 jp0 = 1
2317 j_loop_y_flux_6: do j = j_start, j_end+1
2318 if (j .ge. j_start_f .and. j .le. j_end_f) then
2319 do k = kts, ktf
2320 do i = i_start, i_end
2321 g_vel = 0.5*g_rv(i,k,j-1)+0.5*g_rv(i,k,j)
2322 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
2323 g_fqy(i,k,jp1) = 0.016666667*g_v(i,k,j-3)*vel-0.13333333*g_v(i,k,j-2)*vel+0.61666667*g_v(i,k,j-1)*vel+0.016666667*g_v(i,&
2324 &k,j+2)*vel-0.13333333*g_v(i,k,j+1)*vel+0.61666667*g_v(i,k,j)*vel+g_vel*(0.61666667*(v(i,k,j)+v(i,k,j-1))-0.13333333*&
2325 &(v(i,k,j+1)+v(i,k,j-2))+0.016666667*(v(i,k,j+2)+v(i,k,j-3)))
2326 fqy(i,k,jp1) = vel*(37./60.*(v(i,k,j)+v(i,k,j-1))-2./15.*(v(i,k,j+1)+v(i,k,j-2))+1./60.*(v(i,k,j+2)+v(i,k,j-3)))
2327 end do
2328 end do
2329 else if (j .eq. jds+1) then
2330 do k = kts, ktf
2331 do i = i_start, i_end
2332 g_vb = g_v(i,k,j-1)
2333 vb = v(i,k,j-1)
2334 if (specified .and. v(i,k,j) .lt. 0.) then
2335 g_vb = g_v(i,k,j)
2336 vb = v(i,k,j)
2337 endif
2338 g_fqy(i,k,jp1) = 0.25*g_rv(i,k,j-1)*(v(i,k,j)+vb)+0.25*g_rv(i,k,j)*(v(i,k,j)+vb)+0.25*g_v(i,k,j)*(rv(i,k,j)+rv(i,k,j-1))+&
2339 &0.25*g_vb*(rv(i,k,j)+rv(i,k,j-1))
2340 fqy(i,k,jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))*(v(i,k,j)+vb)
2341 end do
2342 end do
2343 else if (j .eq. jds+2) then
2344 do k = kts, ktf
2345 do i = i_start, i_end
2346 g_vel = 0.5*g_rv(i,k,j-1)+0.5*g_rv(i,k,j)
2347 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
2348 g_fqy(i,k,jp1) = (-0.083333333)*g_v(i,k,j-2)*vel+0.58333333*g_v(i,k,j-1)*vel-0.083333333*g_v(i,k,j+1)*vel+0.58333333*&
2349 &g_v(i,k,j)*vel+g_vel*(0.58333333*(v(i,k,j)+v(i,k,j-1))-0.083333333*(v(i,k,j+1)+v(i,k,j-2)))
2350 fqy(i,k,jp1) = vel*(7./12.*(v(i,k,j)+v(i,k,j-1))-1./12.*(v(i,k,j+1)+v(i,k,j-2)))
2351 end do
2352 end do
2353 else if (j .eq. jde) then
2354 do k = kts, ktf
2355 do i = i_start, i_end
2356 g_vb = g_v(i,k,j)
2357 vb = v(i,k,j)
2358 if (specified .and. v(i,k,j-1) .gt. 0.) then
2359 g_vb = g_v(i,k,j-1)
2360 vb = v(i,k,j-1)
2361 endif
2362 g_fqy(i,k,jp1) = 0.25*g_rv(i,k,j-1)*(vb+v(i,k,j-1))+0.25*g_rv(i,k,j)*(vb+v(i,k,j-1))+0.25*g_v(i,k,j-1)*(rv(i,k,j)+rv(i,k,&
2363 &j-1))+0.25*g_vb*(rv(i,k,j)+rv(i,k,j-1))
2364 fqy(i,k,jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))*(vb+v(i,k,j-1))
2365 end do
2366 end do
2367 else if (j .eq. jde-1) then
2368 do k = kts, ktf
2369 do i = i_start, i_end
2370 g_vel = 0.5*g_rv(i,k,j-1)+0.5*g_rv(i,k,j)
2371 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
2372 g_fqy(i,k,jp1) = (-0.083333333)*g_v(i,k,j-2)*vel+0.58333333*g_v(i,k,j-1)*vel-0.083333333*g_v(i,k,j+1)*vel+0.58333333*&
2373 &g_v(i,k,j)*vel+g_vel*(0.58333333*(v(i,k,j)+v(i,k,j-1))-0.083333333*(v(i,k,j+1)+v(i,k,j-2)))
2374 fqy(i,k,jp1) = vel*(7./12.*(v(i,k,j)+v(i,k,j-1))-1./12.*(v(i,k,j+1)+v(i,k,j-2)))
2375 end do
2376 end do
2377 endif
2378 if (j .gt. j_start) then
2379 do k = kts, ktf
2380 do i = i_start, i_end
2381 mrdy = msfv(i,j-1)*rdy
2382 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
2383 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
2384 end do
2385 end do
2386 endif
2387 jtmp = jp1
2388 jp1 = jp0
2389 jp0 = jtmp
2390 end do j_loop_y_flux_6
2391 i_start = its
2392 i_end = min(ite,ide-1)
2393 j_start = jts
2394 j_end = jte
2395 if (config_flags%open_ys .or. specified) then
2396 j_start = max(jds+1,jts)
2397 endif
2398 if (config_flags%open_ye .or. specified) then
2399 j_end = min(jde-1,jte)
2400 endif
2401 i_start_f = i_start
2402 i_end_f = i_end+1
2403 if (degrade_xs) then
2404 i_start = max(ids+1,its)
2405 i_start_f = i_start+2
2406 endif
2407 if (degrade_xe) then
2408 i_end = min(ide-2,ite)
2409 i_end_f = ide-3
2410 endif
2411 do j = j_start, j_end
2412 do k = kts, ktf
2413 do i = i_start_f, i_end_f
2414 g_vel = 0.5*g_ru(i,k,j-1)+0.5*g_ru(i,k,j)
2415 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
2416 g_fqx(i,k) = 0.016666667*g_v(i-3,k,j)*vel-0.13333333*g_v(i-2,k,j)*vel+0.61666667*g_v(i-1,k,j)*vel+0.016666667*g_v(i+2,k,j)*&
2417 &vel-0.13333333*g_v(i+1,k,j)*vel+0.61666667*g_v(i,k,j)*vel+g_vel*(0.61666667*(v(i,k,j)+v(i-1,k,j))-0.13333333*(v(i+1,k,j)+&
2418 &v(i-2,k,j))+0.016666667*(v(i+2,k,j)+v(i-3,k,j)))
2419 fqx(i,k) = vel*(37./60.*(v(i,k,j)+v(i-1,k,j))-2./15.*(v(i+1,k,j)+v(i-2,k,j))+1./60.*(v(i+2,k,j)+v(i-3,k,j)))
2420 end do
2421 end do
2422 if (degrade_xs) then
2423 if (i_start .eq. ids+1) then
2424 i = ids+1
2425 do k = kts, ktf
2426 g_fqx(i,k) = 0.25*g_ru(i,k,j-1)*(v(i,k,j)+v(i-1,k,j))+0.25*g_ru(i,k,j)*(v(i,k,j)+v(i-1,k,j))+0.25*g_v(i-1,k,j)*(ru(i,k,j)&
2427 &+ru(i,k,j-1))+0.25*g_v(i,k,j)*(ru(i,k,j)+ru(i,k,j-1))
2428 fqx(i,k) = 0.25*(ru(i,k,j)+ru(i,k,j-1))*(v(i,k,j)+v(i-1,k,j))
2429 end do
2430 endif
2431 i = ids+2
2432 do k = kts, ktf
2433 g_vel = 0.5*g_ru(i,k,j-1)+0.5*g_ru(i,k,j)
2434 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
2435 g_fqx(i,k) = (-0.083333333)*g_v(i-2,k,j)*vel+0.58333333*g_v(i-1,k,j)*vel-0.083333333*g_v(i+1,k,j)*vel+0.58333333*g_v(i,k,j)&
2436 &*vel+g_vel*(0.58333333*(v(i,k,j)+v(i-1,k,j))-0.083333333*(v(i+1,k,j)+v(i-2,k,j)))
2437 fqx(i,k) = vel*(7./12.*(v(i,k,j)+v(i-1,k,j))-1./12.*(v(i+1,k,j)+v(i-2,k,j)))
2438 end do
2439 endif
2440 if (degrade_xe) then
2441 if (i_end .eq. ide-2) then
2442 i = ide-1
2443 do k = kts, ktf
2444 g_fqx(i,k) = 0.25*g_ru(i_end+1,k,j-1)*(v(i_end+1,k,j)+v(i_end,k,j))+0.25*g_ru(i_end+1,k,j)*(v(i_end+1,k,j)+v(i_end,k,j))+&
2445 &0.25*g_v(i_end+1,k,j)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))+0.25*g_v(i_end,k,j)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))
2446 fqx(i,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))*(v(i_end+1,k,j)+v(i_end,k,j))
2447 end do
2448 endif
2449 i = ide-2
2450 do k = kts, ktf
2451 g_vel = 0.5*g_ru(i,k,j-1)+0.5*g_ru(i,k,j)
2452 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
2453 g_fqx(i,k) = (-0.083333333)*g_v(i-2,k,j)*vel+0.58333333*g_v(i-1,k,j)*vel-0.083333333*g_v(i+1,k,j)*vel+0.58333333*g_v(i,k,j)&
2454 &*vel+g_vel*(0.58333333*(v(i,k,j)+v(i-1,k,j))-0.083333333*(v(i+1,k,j)+v(i-2,k,j)))
2455 fqx(i,k) = vel*(7./12.*(v(i,k,j)+v(i-1,k,j))-1./12.*(v(i+1,k,j)+v(i-2,k,j)))
2456 end do
2457 endif
2458 do k = kts, ktf
2459 do i = i_start, i_end
2460 mrdx = msfv(i,j)*rdx
2461 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
2462 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
2463 end do
2464 end do
2465 end do
2466 else if (horz_order .eq. 5) then horizontal_order_tesu
2467 degrade_xs = .true.
2468 degrade_xe = .true.
2469 degrade_ys = .true.
2470 degrade_ye = .true.
2471 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
2472 degrade_xs = .false.
2473 endif
2474 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-3) then
2475 degrade_xe = .false.
2476 endif
2477 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
2478 degrade_ys = .false.
2479 endif
2480 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
2481 degrade_ye = .false.
2482 endif
2483 i_start = its
2484 i_end = min(ite,ide-1)
2485 j_start = jts
2486 j_end = jte
2487 j_start_f = j_start
2488 j_end_f = j_end+1
2489 if (degrade_ys) then
2490 j_start = max(jts,jds+1)
2491 j_start_f = jds+3
2492 endif
2493 if (degrade_ye) then
2494 j_end = min(jte,jde-1)
2495 j_end_f = jde-2
2496 endif
2497 jp1 = 2
2498 jp0 = 1
2499 j_loop_y_flux_5: do j = j_start, j_end+1
2500 if (j .ge. j_start_f .and. j .le. j_end_f) then
2501 do k = kts, ktf
2502 do i = i_start, i_end
2503 g_vel = 0.5*g_rv(i,k,j-1)+0.5*g_rv(i,k,j)
2504 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
2505 g_fqy(i,k,jp1) = g_v(i,k,j-3)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))+g_v(i,k,j-2)*vel*((-0.13333333)-0.083333333*&
2506 &sign(1.,vel))+g_v(i,k,j-1)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))+g_v(i,k,j+2)*vel*(0.016666667-0.016666667*&
2507 &sign(1.,vel))+g_v(i,k,j+1)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))+g_v(i,k,j)*vel*(0.61666667-0.16666667*&
2508 &sign(1.,vel))+g_vel*(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)+v(i,k,&
2509 &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))
2510 fqy(i,k,jp1) = vel*(37./60.*(v(i,k,j)+v(i,k,j-1))-2./15.*(v(i,k,j+1)+v(i,k,j-2))+1./60.*(v(i,k,j+2)+v(i,k,j-3))-sign(1.,&
2511 &vel)*(1./60.)*(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))))
2512 end do
2513 end do
2514 else if (j .eq. jds+1) then
2515 do k = kts, ktf
2516 do i = i_start, i_end
2517 g_vb = g_v(i,k,j-1)
2518 vb = v(i,k,j-1)
2519 if (specified .and. v(i,k,j) .lt. 0.) then
2520 g_vb = g_v(i,k,j)
2521 vb = v(i,k,j)
2522 endif
2523 g_fqy(i,k,jp1) = 0.25*g_rv(i,k,j-1)*(v(i,k,j)+vb)+0.25*g_rv(i,k,j)*(v(i,k,j)+vb)+0.25*g_v(i,k,j)*(rv(i,k,j)+rv(i,k,j-1))+&
2524 &0.25*g_vb*(rv(i,k,j)+rv(i,k,j-1))
2525 fqy(i,k,jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))*(v(i,k,j)+vb)
2526 end do
2527 end do
2528 else if (j .eq. jds+2) then
2529 do k = kts, ktf
2530 do i = i_start, i_end
2531 g_vel = 0.5*g_rv(i,k,j-1)+0.5*g_rv(i,k,j)
2532 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
2533 g_fqy(i,k,jp1) = g_v(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_v(i,k,j-1)*vel*(0.58333333+0.25*sign(1.,&
2534 &vel))+g_v(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_v(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,vel))+g_vel*&
2535 &(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+1)-v(i,k,j-2)-3.*(v(i,k,j)-&
2536 &v(i,k,j-1)))*sign(1.,vel))
2537 fqy(i,k,jp1) = vel*(7./12.*(v(i,k,j)+v(i,k,j-1))-1./12.*(v(i,k,j+1)+v(i,k,j-2))+sign(1.,vel)*(1./12.)*(v(i,k,j+1)-v(i,k,&
2538 &j-2)-3.*(v(i,k,j)-v(i,k,j-1))))
2539 end do
2540 end do
2541 else if (j .eq. jde) then
2542 do k = kts, ktf
2543 do i = i_start, i_end
2544 g_vb = g_v(i,k,j)
2545 vb = v(i,k,j)
2546 if (specified .and. v(i,k,j-1) .gt. 0.) then
2547 g_vb = g_v(i,k,j-1)
2548 vb = v(i,k,j-1)
2549 endif
2550 g_fqy(i,k,jp1) = 0.25*g_rv(i,k,j-1)*(vb+v(i,k,j-1))+0.25*g_rv(i,k,j)*(vb+v(i,k,j-1))+0.25*g_v(i,k,j-1)*(rv(i,k,j)+rv(i,k,&
2551 &j-1))+0.25*g_vb*(rv(i,k,j)+rv(i,k,j-1))
2552 fqy(i,k,jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))*(vb+v(i,k,j-1))
2553 end do
2554 end do
2555 else if (j .eq. jde-1) then
2556 do k = kts, ktf
2557 do i = i_start, i_end
2558 g_vel = 0.5*g_rv(i,k,j-1)+0.5*g_rv(i,k,j)
2559 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
2560 g_fqy(i,k,jp1) = g_v(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_v(i,k,j-1)*vel*(0.58333333+0.25*sign(1.,&
2561 &vel))+g_v(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_v(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,vel))+g_vel*&
2562 &(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+1)-v(i,k,j-2)-3.*(v(i,k,j)-&
2563 &v(i,k,j-1)))*sign(1.,vel))
2564 fqy(i,k,jp1) = vel*(7./12.*(v(i,k,j)+v(i,k,j-1))-1./12.*(v(i,k,j+1)+v(i,k,j-2))+sign(1.,vel)*(1./12.)*(v(i,k,j+1)-v(i,k,&
2565 &j-2)-3.*(v(i,k,j)-v(i,k,j-1))))
2566 end do
2567 end do
2568 endif
2569 if (j .gt. j_start) then
2570 do k = kts, ktf
2571 do i = i_start, i_end
2572 mrdy = msfv(i,j-1)*rdy
2573 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
2574 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
2575 end do
2576 end do
2577 endif
2578 jtmp = jp1
2579 jp1 = jp0
2580 jp0 = jtmp
2581 end do j_loop_y_flux_5
2582 i_start = its
2583 i_end = min(ite,ide-1)
2584 j_start = jts
2585 j_end = jte
2586 if (config_flags%open_ys .or. specified) then
2587 j_start = max(jds+1,jts)
2588 endif
2589 if (config_flags%open_ye .or. specified) then
2590 j_end = min(jde-1,jte)
2591 endif
2592 i_start_f = i_start
2593 i_end_f = i_end+1
2594 if (degrade_xs) then
2595 i_start = max(ids+1,its)
2596 i_start_f = i_start+2
2597 endif
2598 if (degrade_xe) then
2599 i_end = min(ide-2,ite)
2600 i_end_f = ide-3
2601 endif
2602 do j = j_start, j_end
2603 do k = kts, ktf
2604 do i = i_start_f, i_end_f
2605 g_vel = 0.5*g_ru(i,k,j-1)+0.5*g_ru(i,k,j)
2606 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
2607 g_fqx(i,k) = g_v(i-3,k,j)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))+g_v(i-2,k,j)*vel*((-0.13333333)-0.083333333*&
2608 &sign(1.,vel))+g_v(i-1,k,j)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))+g_v(i+2,k,j)*vel*(0.016666667-0.016666667*sign(1.,&
2609 &vel))+g_v(i+1,k,j)*vel*((-0.13333333)-(-0.083333333)*sign(1.,vel))+g_v(i,k,j)*vel*(0.61666667-0.16666667*sign(1.,vel))+&
2610 &g_vel*(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-3,k,j))-&
2611 &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))
2612 fqx(i,k) = vel*(37./60.*(v(i,k,j)+v(i-1,k,j))-2./15.*(v(i+1,k,j)+v(i-2,k,j))+1./60.*(v(i+2,k,j)+v(i-3,k,j))-sign(1.,vel)*&
2613 &(1./60.)*(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))))
2614 end do
2615 end do
2616 if (degrade_xs) then
2617 if (i_start .eq. ids+1) then
2618 i = ids+1
2619 do k = kts, ktf
2620 g_fqx(i,k) = 0.25*g_ru(i,k,j-1)*(v(i,k,j)+v(i-1,k,j))+0.25*g_ru(i,k,j)*(v(i,k,j)+v(i-1,k,j))+0.25*g_v(i-1,k,j)*(ru(i,k,j)&
2621 &+ru(i,k,j-1))+0.25*g_v(i,k,j)*(ru(i,k,j)+ru(i,k,j-1))
2622 fqx(i,k) = 0.25*(ru(i,k,j)+ru(i,k,j-1))*(v(i,k,j)+v(i-1,k,j))
2623 end do
2624 endif
2625 i = ids+2
2626 do k = kts, ktf
2627 g_vel = 0.5*g_ru(i,k,j-1)+0.5*g_ru(i,k,j)
2628 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
2629 g_fqx(i,k) = g_v(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_v(i-1,k,j)*vel*(0.58333333+0.25*sign(1.,vel))+&
2630 &g_v(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_v(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,vel))+g_vel*&
2631 &(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-2,k,j)-3.*(v(i,k,j)-v(i-&
2632 &1,k,j)))*sign(1.,vel))
2633 fqx(i,k) = vel*(7./12.*(v(i,k,j)+v(i-1,k,j))-1./12.*(v(i+1,k,j)+v(i-2,k,j))+sign(1.,vel)*(1./12.)*(v(i+1,k,j)-v(i-2,k,j)-&
2634 &3.*(v(i,k,j)-v(i-1,k,j))))
2635 end do
2636 endif
2637 if (degrade_xe) then
2638 if (i_end .eq. ide-2) then
2639 i = ide-1
2640 do k = kts, ktf
2641 g_fqx(i,k) = 0.25*g_ru(i_end+1,k,j-1)*(v(i_end+1,k,j)+v(i_end,k,j))+0.25*g_ru(i_end+1,k,j)*(v(i_end+1,k,j)+v(i_end,k,j))+&
2642 &0.25*g_v(i_end+1,k,j)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))+0.25*g_v(i_end,k,j)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))
2643 fqx(i,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))*(v(i_end+1,k,j)+v(i_end,k,j))
2644 end do
2645 endif
2646 i = ide-2
2647 do k = kts, ktf
2648 g_vel = 0.5*g_ru(i,k,j-1)+0.5*g_ru(i,k,j)
2649 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
2650 g_fqx(i,k) = g_v(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_v(i-1,k,j)*vel*(0.58333333+0.25*sign(1.,vel))+&
2651 &g_v(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_v(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,vel))+g_vel*&
2652 &(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-2,k,j)-3.*(v(i,k,j)-v(i-&
2653 &1,k,j)))*sign(1.,vel))
2654 fqx(i,k) = vel*(7./12.*(v(i,k,j)+v(i-1,k,j))-1./12.*(v(i+1,k,j)+v(i-2,k,j))+sign(1.,vel)*(1./12.)*(v(i+1,k,j)-v(i-2,k,j)-&
2655 &3.*(v(i,k,j)-v(i-1,k,j))))
2656 end do
2657 endif
2658 do k = kts, ktf
2659 do i = i_start, i_end
2660 mrdx = msfv(i,j)*rdx
2661 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
2662 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
2663 end do
2664 end do
2665 end do
2666 else if (horz_order .eq. 4) then horizontal_order_tesu
2667 degrade_xs = .true.
2668 degrade_xe = .true.
2669 degrade_ys = .true.
2670 degrade_ye = .true.
2671 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
2672 degrade_xs = .false.
2673 endif
2674 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
2675 degrade_xe = .false.
2676 endif
2677 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
2678 degrade_ys = .false.
2679 endif
2680 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-1) then
2681 degrade_ye = .false.
2682 endif
2683 ktf = min(kte,kde-1)
2684 i_start = its
2685 i_end = min(ite,ide-1)
2686 j_start = jts
2687 j_end = jte
2688 if (degrade_ys) then
2689 j_start = jds+1
2690 endif
2691 if (degrade_ye) then
2692 j_end = jde-1
2693 endif
2694 jp0 = 1
2695 jp1 = 2
2696 do j = j_start, j_end+1
2697 if (j .eq. j_start .and. degrade_ys) then
2698 do k = kts, ktf
2699 do i = i_start, i_end
2700 g_vb = g_v(i,k,j-1)
2701 vb = v(i,k,j-1)
2702 if (specified .and. v(i,k,j) .lt. 0.) then
2703 g_vb = g_v(i,k,j)
2704 vb = v(i,k,j)
2705 endif
2706 g_fqy(i,k,jp1) = 0.25*g_rv(i,k,j-1)*(v(i,k,j)+vb)+0.25*g_rv(i,k,j)*(v(i,k,j)+vb)+0.25*g_v(i,k,j)*(rv(i,k,j)+rv(i,k,j-1))+&
2707 &0.25*g_vb*(rv(i,k,j)+rv(i,k,j-1))
2708 fqy(i,k,jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))*(v(i,k,j)+vb)
2709 end do
2710 end do
2711 else if (j .eq. j_end+1 .and. degrade_ye) then
2712 do k = kts, ktf
2713 do i = i_start, i_end
2714 g_vb = g_v(i,k,j)
2715 vb = v(i,k,j)
2716 if (specified .and. v(i,k,j-1) .gt. 0.) then
2717 g_vb = g_v(i,k,j-1)
2718 vb = v(i,k,j-1)
2719 endif
2720 g_fqy(i,k,jp1) = 0.25*g_rv(i,k,j-1)*(vb+v(i,k,j-1))+0.25*g_rv(i,k,j)*(vb+v(i,k,j-1))+0.25*g_v(i,k,j-1)*(rv(i,k,j)+rv(i,k,&
2721 &j-1))+0.25*g_vb*(rv(i,k,j)+rv(i,k,j-1))
2722 fqy(i,k,jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))*(vb+v(i,k,j-1))
2723 end do
2724 end do
2725 else
2726 do k = kts, ktf
2727 do i = i_start, i_end
2728 g_vel = 0.5*g_rv(i,k,j-1)+0.5*g_rv(i,k,j)
2729 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
2730 g_fqy(i,k,jp1) = (-0.083333333)*g_v(i,k,j-2)*vel+0.58333333*g_v(i,k,j-1)*vel-0.083333333*g_v(i,k,j+1)*vel+0.58333333*&
2731 &g_v(i,k,j)*vel+g_vel*(0.58333333*(v(i,k,j)+v(i,k,j-1))-0.083333333*(v(i,k,j+1)+v(i,k,j-2)))
2732 fqy(i,k,jp1) = vel*(7./12.*(v(i,k,j)+v(i,k,j-1))-1./12.*(v(i,k,j+1)+v(i,k,j-2)))
2733 end do
2734 end do
2735 endif
2736 if (j .gt. j_start) then
2737 do k = kts, ktf
2738 do i = i_start, i_end
2739 mrdy = msfv(i,j-1)*rdy
2740 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
2741 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
2742 end do
2743 end do
2744 endif
2745 jtmp = jp1
2746 jp1 = jp0
2747 jp0 = jtmp
2748 end do
2749 i_start = its
2750 i_end = min(ite,ide-1)
2751 j_start = jts
2752 j_end = jte
2753 if (config_flags%open_ys .or. specified) then
2754 j_start = max(jds+1,jts)
2755 endif
2756 if (config_flags%open_ye .or. specified) then
2757 j_end = min(jde-1,jte)
2758 endif
2759 i_start_f = i_start
2760 i_end_f = i_end+1
2761 if (degrade_xs) then
2762 i_start = ids+1
2763 i_start_f = i_start+1
2764 endif
2765 if (degrade_xe) then
2766 i_end = ide-2
2767 i_end_f = ide-2
2768 endif
2769 do j = j_start, j_end
2770 do k = kts, ktf
2771 do i = i_start_f, i_end_f
2772 g_vel = 0.5*g_ru(i,k,j-1)+0.5*g_ru(i,k,j)
2773 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
2774 g_fqx(i,k) = (-0.083333333)*g_v(i-2,k,j)*vel+0.58333333*g_v(i-1,k,j)*vel-0.083333333*g_v(i+1,k,j)*vel+0.58333333*g_v(i,k,j)&
2775 &*vel+g_vel*(0.58333333*(v(i,k,j)+v(i-1,k,j))-0.083333333*(v(i+1,k,j)+v(i-2,k,j)))
2776 fqx(i,k) = vel*(7./12.*(v(i,k,j)+v(i-1,k,j))-1./12.*(v(i+1,k,j)+v(i-2,k,j)))
2777 end do
2778 end do
2779 if (degrade_xs) then
2780 do k = kts, ktf
2781 g_fqx(i_start,k) = 0.25*g_ru(i_start,k,j-1)*(v(i_start,k,j)+v(i_start-1,k,j))+0.25*g_ru(i_start,k,j)*(v(i_start,k,j)+&
2782 &v(i_start-1,k,j))+0.25*g_v(i_start-1,k,j)*(ru(i_start,k,j)+ru(i_start,k,j-1))+0.25*g_v(i_start,k,j)*(ru(i_start,k,j)+&
2783 &ru(i_start,k,j-1))
2784 fqx(i_start,k) = 0.25*(ru(i_start,k,j)+ru(i_start,k,j-1))*(v(i_start,k,j)+v(i_start-1,k,j))
2785 end do
2786 endif
2787 if (degrade_xe) then
2788 do k = kts, ktf
2789 g_fqx(i_end+1,k) = 0.25*g_ru(i_end+1,k,j-1)*(v(i_end+1,k,j)+v(i_end,k,j))+0.25*g_ru(i_end+1,k,j)*(v(i_end+1,k,j)+v(i_end,k,&
2790 &j))+0.25*g_v(i_end+1,k,j)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))+0.25*g_v(i_end,k,j)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))
2791 fqx(i_end+1,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))*(v(i_end+1,k,j)+v(i_end,k,j))
2792 end do
2793 endif
2794 do k = kts, ktf
2795 do i = i_start, i_end
2796 mrdx = msfv(i,j)*rdx
2797 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
2798 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
2799 end do
2800 end do
2801 end do
2802 else if (horz_order .eq. 3) then horizontal_order_tesu
2803 degrade_xs = .true.
2804 degrade_xe = .true.
2805 degrade_ys = .true.
2806 degrade_ye = .true.
2807 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
2808 degrade_xs = .false.
2809 endif
2810 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
2811 degrade_xe = .false.
2812 endif
2813 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
2814 degrade_ys = .false.
2815 endif
2816 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-1) then
2817 degrade_ye = .false.
2818 endif
2819 ktf = min(kte,kde-1)
2820 i_start = its
2821 i_end = min(ite,ide-1)
2822 j_start = jts
2823 j_end = jte
2824 if (degrade_ys) then
2825 j_start = jds+1
2826 endif
2827 if (degrade_ye) then
2828 j_end = jde-1
2829 endif
2830 jp0 = 1
2831 jp1 = 2
2832 do j = j_start, j_end+1
2833 if (j .eq. j_start .and. degrade_ys) then
2834 do k = kts, ktf
2835 do i = i_start, i_end
2836 g_vb = g_v(i,k,j-1)
2837 vb = v(i,k,j-1)
2838 if (specified .and. v(i,k,j) .lt. 0.) then
2839 g_vb = g_v(i,k,j)
2840 vb = v(i,k,j)
2841 endif
2842 g_fqy(i,k,jp1) = 0.25*g_rv(i,k,j-1)*(v(i,k,j)+vb)+0.25*g_rv(i,k,j)*(v(i,k,j)+vb)+0.25*g_v(i,k,j)*(rv(i,k,j)+rv(i,k,j-1))+&
2843 &0.25*g_vb*(rv(i,k,j)+rv(i,k,j-1))
2844 fqy(i,k,jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))*(v(i,k,j)+vb)
2845 end do
2846 end do
2847 else if (j .eq. j_end+1 .and. degrade_ye) then
2848 do k = kts, ktf
2849 do i = i_start, i_end
2850 g_vb = g_v(i,k,j)
2851 vb = v(i,k,j)
2852 if (specified .and. v(i,k,j-1) .gt. 0.) then
2853 g_vb = g_v(i,k,j-1)
2854 vb = v(i,k,j-1)
2855 endif
2856 g_fqy(i,k,jp1) = 0.25*g_rv(i,k,j-1)*(vb+v(i,k,j-1))+0.25*g_rv(i,k,j)*(vb+v(i,k,j-1))+0.25*g_v(i,k,j-1)*(rv(i,k,j)+rv(i,k,&
2857 &j-1))+0.25*g_vb*(rv(i,k,j)+rv(i,k,j-1))
2858 fqy(i,k,jp1) = 0.25*(rv(i,k,j)+rv(i,k,j-1))*(vb+v(i,k,j-1))
2859 end do
2860 end do
2861 else
2862 do k = kts, ktf
2863 do i = i_start, i_end
2864 g_vel = 0.5*g_rv(i,k,j-1)+0.5*g_rv(i,k,j)
2865 vel = 0.5*(rv(i,k,j)+rv(i,k,j-1))
2866 g_fqy(i,k,jp1) = g_v(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_v(i,k,j-1)*vel*(0.58333333+0.25*sign(1.,&
2867 &vel))+g_v(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_v(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,vel))+g_vel*&
2868 &(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+1)-v(i,k,j-2)-3.*(v(i,k,j)-&
2869 &v(i,k,j-1)))*sign(1.,vel))
2870 fqy(i,k,jp1) = vel*(7./12.*(v(i,k,j)+v(i,k,j-1))-1./12.*(v(i,k,j+1)+v(i,k,j-2))+sign(1.,vel)*(1./12.)*(v(i,k,j+1)-v(i,k,&
2871 &j-2)-3.*(v(i,k,j)-v(i,k,j-1))))
2872 end do
2873 end do
2874 endif
2875 if (j .gt. j_start) then
2876 do k = kts, ktf
2877 do i = i_start, i_end
2878 mrdy = msfv(i,j-1)*rdy
2879 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
2880 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
2881 end do
2882 end do
2883 endif
2884 jtmp = jp1
2885 jp1 = jp0
2886 jp0 = jtmp
2887 end do
2888 i_start = its
2889 i_end = min(ite,ide-1)
2890 j_start = jts
2891 j_end = jte
2892 if (config_flags%open_ys .or. specified) then
2893 j_start = max(jds+1,jts)
2894 endif
2895 if (config_flags%open_ye .or. specified) then
2896 j_end = min(jde-1,jte)
2897 endif
2898 i_start_f = i_start
2899 i_end_f = i_end+1
2900 if (degrade_xs) then
2901 i_start = ids+1
2902 i_start_f = i_start+1
2903 endif
2904 if (degrade_xe) then
2905 i_end = ide-2
2906 i_end_f = ide-2
2907 endif
2908 do j = j_start, j_end
2909 do k = kts, ktf
2910 do i = i_start_f, i_end_f
2911 g_vel = 0.5*g_ru(i,k,j-1)+0.5*g_ru(i,k,j)
2912 vel = 0.5*(ru(i,k,j)+ru(i,k,j-1))
2913 g_fqx(i,k) = g_v(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_v(i-1,k,j)*vel*(0.58333333+0.25*sign(1.,vel))+&
2914 &g_v(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_v(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,vel))+g_vel*&
2915 &(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-2,k,j)-3.*(v(i,k,j)-v(i-&
2916 &1,k,j)))*sign(1.,vel))
2917 fqx(i,k) = vel*(7./12.*(v(i,k,j)+v(i-1,k,j))-1./12.*(v(i+1,k,j)+v(i-2,k,j))+sign(1.,vel)*(1./12.)*(v(i+1,k,j)-v(i-2,k,j)-&
2918 &3.*(v(i,k,j)-v(i-1,k,j))))
2919 end do
2920 end do
2921 if (degrade_xs) then
2922 do k = kts, ktf
2923 g_fqx(i_start,k) = 0.25*g_ru(i_start,k,j-1)*(v(i_start,k,j)+v(i_start-1,k,j))+0.25*g_ru(i_start,k,j)*(v(i_start,k,j)+&
2924 &v(i_start-1,k,j))+0.25*g_v(i_start-1,k,j)*(ru(i_start,k,j)+ru(i_start,k,j-1))+0.25*g_v(i_start,k,j)*(ru(i_start,k,j)+&
2925 &ru(i_start,k,j-1))
2926 fqx(i_start,k) = 0.25*(ru(i_start,k,j)+ru(i_start,k,j-1))*(v(i_start,k,j)+v(i_start-1,k,j))
2927 end do
2928 endif
2929 if (degrade_xe) then
2930 do k = kts, ktf
2931 g_fqx(i_end+1,k) = 0.25*g_ru(i_end+1,k,j-1)*(v(i_end+1,k,j)+v(i_end,k,j))+0.25*g_ru(i_end+1,k,j)*(v(i_end+1,k,j)+v(i_end,k,&
2932 &j))+0.25*g_v(i_end+1,k,j)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))+0.25*g_v(i_end,k,j)*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))
2933 fqx(i_end+1,k) = 0.25*(ru(i_end+1,k,j)+ru(i_end+1,k,j-1))*(v(i_end+1,k,j)+v(i_end,k,j))
2934 end do
2935 endif
2936 do k = kts, ktf
2937 do i = i_start, i_end
2938 mrdx = msfv(i,j)*rdx
2939 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
2940 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
2941 end do
2942 end do
2943 end do
2944 else if (horz_order .eq. 2) then horizontal_order_tesu
2945 i_start = its
2946 i_end = min(ite,ide-1)
2947 j_start = jts
2948 j_end = jte
2949 if (config_flags%open_ys) then
2950 j_start = max(jds+1,jts)
2951 endif
2952 if (config_flags%open_ye) then
2953 j_end = min(jde-1,jte)
2954 endif
2955 if (specified) then
2956 j_start = max(jds+2,jts)
2957 endif
2958 if (specified) then
2959 j_end = min(jde-2,jte)
2960 endif
2961 do j = j_start, j_end
2962 do k = kts, ktf
2963 do i = i_start, i_end
2964 mrdy = msfv(i,j)*rdy
2965 g_tendency(i,k,j) = 0.25*g_rv(i,k,j-1)*mrdy*(v(i,k,j)+v(i,k,j-1))-0.25*g_rv(i,k,j+1)*mrdy*(v(i,k,j+1)+v(i,k,j))-0.25*&
2966 &g_rv(i,k,j)*mrdy*(v(i,k,j+1)+v(i,k,j)-(v(i,k,j)+v(i,k,j-1)))+g_tendency(i,k,j)+0.25*g_v(i,k,j-1)*mrdy*(rv(i,k,j)+rv(i,k,j-&
2967 &1))-0.25*g_v(i,k,j+1)*mrdy*(rv(i,k,j+1)+rv(i,k,j))-0.25*g_v(i,k,j)*mrdy*(rv(i,k,j+1)+rv(i,k,j)-(rv(i,k,j)+rv(i,k,j-1)))
2968 tendency(i,k,j) = tendency(i,k,j)-mrdy*0.25*((rv(i,k,j+1)+rv(i,k,j))*(v(i,k,j+1)+v(i,k,j))-(rv(i,k,j)+rv(i,k,j-1))*(v(i,k,&
2969 &j)+v(i,k,j-1)))
2970 end do
2971 end do
2972 end do
2973 if (specified .and. jts .le. jds+1) then
2974 j = jds+1
2975 do k = kts, ktf
2976 do i = i_start, i_end
2977 mrdy = msfv(i,j)*rdy
2978 g_vb = g_v(i,k,j-1)
2979 vb = v(i,k,j-1)
2980 if (v(i,k,j) .lt. 0.) then
2981 g_vb = g_v(i,k,j)
2982 vb = v(i,k,j)
2983 endif
2984 g_tendency(i,k,j) = 0.25*g_rv(i,k,j-1)*mrdy*(v(i,k,j)+vb)-0.25*g_rv(i,k,j+1)*mrdy*(v(i,k,j+1)+v(i,k,j))-0.25*g_rv(i,k,j)*&
2985 &mrdy*(v(i,k,j+1)+v(i,k,j)-(v(i,k,j)+vb))+g_tendency(i,k,j)-0.25*g_v(i,k,j+1)*mrdy*(rv(i,k,j+1)+rv(i,k,j))-0.25*g_v(i,k,j)*&
2986 &mrdy*(rv(i,k,j+1)+rv(i,k,j)-(rv(i,k,j)+rv(i,k,j-1)))+0.25*g_vb*mrdy*(rv(i,k,j)+rv(i,k,j-1))
2987 tendency(i,k,j) = tendency(i,k,j)-mrdy*0.25*((rv(i,k,j+1)+rv(i,k,j))*(v(i,k,j+1)+v(i,k,j))-(rv(i,k,j)+rv(i,k,j-1))*(v(i,k,&
2988 &j)+vb))
2989 end do
2990 end do
2991 endif
2992 if (specified .and. jte .ge. jde-1) then
2993 j = jde-1
2994 do k = kts, ktf
2995 do i = i_start, i_end
2996 mrdy = msfv(i,j)*rdy
2997 g_vb = g_v(i,k,j+1)
2998 vb = v(i,k,j+1)
2999 if (v(i,k,j) .gt. 0.) then
3000 g_vb = g_v(i,k,j)
3001 vb = v(i,k,j)
3002 endif
3003 g_tendency(i,k,j) = 0.25*g_rv(i,k,j-1)*mrdy*(v(i,k,j)+v(i,k,j-1))-0.25*g_rv(i,k,j+1)*mrdy*(vb+v(i,k,j))-0.25*g_rv(i,k,j)*&
3004 &mrdy*(vb+v(i,k,j)-(v(i,k,j)+v(i,k,j-1)))+g_tendency(i,k,j)+0.25*g_v(i,k,j-1)*mrdy*(rv(i,k,j)+rv(i,k,j-1))-0.25*g_v(i,k,j)*&
3005 &mrdy*(rv(i,k,j+1)+rv(i,k,j)-(rv(i,k,j)+rv(i,k,j-1)))-0.25*g_vb*mrdy*(rv(i,k,j+1)+rv(i,k,j))
3006 tendency(i,k,j) = tendency(i,k,j)-mrdy*0.25*((rv(i,k,j+1)+rv(i,k,j))*(vb+v(i,k,j))-(rv(i,k,j)+rv(i,k,j-1))*(v(i,k,j)+v(i,k,&
3007 &j-1)))
3008 end do
3009 end do
3010 endif
3011 if (config_flags%open_xs .or. specified) then
3012 i_start = max(ids+1,its)
3013 endif
3014 if (config_flags%open_xe .or. specified) then
3015 i_end = min(ide-2,ite)
3016 endif
3017 do j = j_start, j_end
3018 do k = kts, ktf
3019 do i = i_start, i_end
3020 mrdx = msfv(i,j)*rdx
3021 g_tendency(i,k,j) = (-(0.25*g_ru(i+1,k,j-1)*mrdx*(v(i+1,k,j)+v(i,k,j))))+0.25*g_ru(i,k,j-1)*mrdx*(v(i,k,j)+v(i-1,k,j))-&
3022 &0.25*g_ru(i+1,k,j)*mrdx*(v(i+1,k,j)+v(i,k,j))+0.25*g_ru(i,k,j)*mrdx*(v(i,k,j)+v(i-1,k,j))+g_tendency(i,k,j)+0.25*g_v(i-1,&
3023 &k,j)*mrdx*(ru(i,k,j)+ru(i,k,j-1))-0.25*g_v(i+1,k,j)*mrdx*(ru(i+1,k,j)+ru(i+1,k,j-1))-0.25*g_v(i,k,j)*mrdx*(ru(i+1,k,j)+&
3024 &ru(i+1,k,j-1)-(ru(i,k,j)+ru(i,k,j-1)))
3025 tendency(i,k,j) = tendency(i,k,j)-mrdx*0.25*((ru(i+1,k,j)+ru(i+1,k,j-1))*(v(i+1,k,j)+v(i,k,j))-(ru(i,k,j)+ru(i,k,j-1))*&
3026 &(v(i,k,j)+v(i-1,k,j)))
3027 end do
3028 end do
3029 end do
3030 else horizontal_order_tesu
3031 write(unit=wrf_err_message,fmt=*) 'module_advect: advect_v_6a: h_order not known ',horz_order
3032 endif horizontal_order_tesu
3033 if (config_flags%open_ys .and. jts .eq. jds) then
3034 i_start = its
3035 i_end = min(ite,ide-1)
3036 do i = i_start, i_end
3037 do k = kts, ktf
3038 g_vb = (-(g_mut(i,jts)*(0.5+sign(0.5,0.-(rv(i,k,jts)-cb*mut(i,jts))))*cb))+g_rv(i,k,jts)*(0.5+sign(0.5,0.-(rv(i,k,jts)-cb*&
3039 &mut(i,jts))))
3040 vb = min(rv(i,k,jts)-cb*mut(i,jts),0.)
3041 g_tendency(i,k,jts) = g_tendency(i,k,jts)-g_v_old(i,k,jts+1)*rdy*vb+g_v_old(i,k,jts)*rdy*vb-g_vb*rdy*(v_old(i,k,jts+1)-&
3042 &v_old(i,k,jts))
3043 tendency(i,k,jts) = tendency(i,k,jts)-rdy*vb*(v_old(i,k,jts+1)-v_old(i,k,jts))
3044 end do
3045 end do
3046 endif
3047 if (config_flags%open_ye .and. jte .eq. jde) then
3048 i_start = its
3049 i_end = min(ite,ide-1)
3050 do i = i_start, i_end
3051 do k = kts, ktf
3052 g_vb = g_mut(i,jte-1)*(0.5+sign(0.5,rv(i,k,jte)+cb*mut(i,jte-1)-0.))*cb+g_rv(i,k,jte)*(0.5+sign(0.5,rv(i,k,jte)+cb*mut(i,jte-&
3053 &1)-0.))
3054 vb = max(rv(i,k,jte)+cb*mut(i,jte-1),0.)
3055 g_tendency(i,k,jte) = g_tendency(i,k,jte)+g_v_old(i,k,jte-1)*rdy*vb-g_v_old(i,k,jte)*rdy*vb-g_vb*rdy*(v_old(i,k,jte)-v_old(i,&
3056 &k,jte-1))
3057 tendency(i,k,jte) = tendency(i,k,jte)-rdy*vb*(v_old(i,k,jte)-v_old(i,k,jte-1))
3058 end do
3059 end do
3060 endif
3061 j_start = jts
3062 j_end = min(jte,jde)
3063 jmin = jds
3064 jmax = jde-1
3065 if (config_flags%open_ys) then
3066 j_start = max(jds+1,jts)
3067 jmin = jds
3068 endif
3069 if (config_flags%open_ye) then
3070 j_end = min(jte,jde-1)
3071 jmax = jde-1
3072 endif
3073 if (config_flags%open_xs .and. its .eq. ids) then
3074 do j = j_start, j_end
3075 mrdx = msfv(its,j)*rdx
3076 jp = min(jmax,j)
3077 jm = max(jmin,j-1)
3078 do k = kts, ktf
3079 g_uw = 0.5*g_ru(its,k,jm)+0.5*g_ru(its,k,jp)
3080 uw = 0.5*(ru(its,k,jp)+ru(its,k,jm))
3081 g_ub = g_uw*(0.5+sign(0.5,0.-uw))
3082 ub = min(uw,0.)
3083 g_dup = g_ru(its+1,k,jp)-g_ru(its,k,jp)
3084 dup = ru(its+1,k,jp)-ru(its,k,jp)
3085 g_dum = g_ru(its+1,k,jm)-g_ru(its,k,jm)
3086 dum = ru(its+1,k,jm)-ru(its,k,jm)
3087 g_tendency(its,k,j) = (-(0.5*g_dum*mrdx*v(its,k,j)))-0.5*g_dup*mrdx*v(its,k,j)+g_tendency(its,k,j)-g_ub*mrdx*(v_old(its+1,k,&
3088 &j)-v_old(its,k,j))-0.5*g_v(its,k,j)*mrdx*(dup+dum)-g_v_old(its+1,k,j)*mrdx*ub+g_v_old(its,k,j)*mrdx*ub
3089 tendency(its,k,j) = tendency(its,k,j)-mrdx*(ub*(v_old(its+1,k,j)-v_old(its,k,j))+0.5*v(its,k,j)*(dup+dum))
3090 end do
3091 end do
3092 endif
3093 if (config_flags%open_xe .and. ite .eq. ide) then
3094 do j = j_start, j_end
3095 mrdx = msfv(ite-1,j)*rdx
3096 jp = min(jmax,j)
3097 jm = max(jmin,j-1)
3098 do k = kts, ktf
3099 g_uw = 0.5*g_ru(ite,k,jm)+0.5*g_ru(ite,k,jp)
3100 uw = 0.5*(ru(ite,k,jp)+ru(ite,k,jm))
3101 g_ub = g_uw*(0.5+sign(0.5,uw-0.))
3102 ub = max(uw,0.)
3103 g_dup = (-g_ru(ite-1,k,jp))+g_ru(ite,k,jp)
3104 dup = ru(ite,k,jp)-ru(ite-1,k,jp)
3105 g_dum = (-g_ru(ite-1,k,jm))+g_ru(ite,k,jm)
3106 dum = ru(ite,k,jm)-ru(ite-1,k,jm)
3107 g_tendency(ite-1,k,j) = (-(0.5*g_dum*mrdx*v(ite-1,k,j)))-0.5*g_dup*mrdx*v(ite-1,k,j)+g_tendency(ite-1,k,j)-g_ub*mrdx*&
3108 &(v_old(ite-1,k,j)-v_old(ite-2,k,j))-0.5*g_v(ite-1,k,j)*mrdx*(dup+dum)+g_v_old(ite-2,k,j)*mrdx*ub-g_v_old(ite-1,k,j)*mrdx*ub
3109 tendency(ite-1,k,j) = tendency(ite-1,k,j)-mrdx*(ub*(v_old(ite-1,k,j)-v_old(ite-2,k,j))+0.5*v(ite-1,k,j)*(dup+dum))
3110 end do
3111 end do
3112 endif
3113 i_start = its
3114 i_end = min(ite,ide-1)
3115 j_start = jts
3116 j_end = jte
3117 do i = i_start, i_end
3118 g_vflux(i,kts) = 0.
3119 vflux(i,kts) = 0.
3120 g_vflux(i,kte) = 0.
3121 vflux(i,kte) = 0.
3122 end do
3123 if (config_flags%open_ys .or. specified) then
3124 j_start = max(jds+1,jts)
3125 endif
3126 if (config_flags%open_ye .or. specified) then
3127 j_end = min(jde-1,jte)
3128 endif
3129 vert_order_tesu: if (vert_order .eq. 6) then
3130 do j = j_start, j_end
3131 do k = kts+3, ktf-2
3132 do i = i_start, i_end
3133 g_vel = 0.5*g_rom(i,k,j-1)+0.5*g_rom(i,k,j)
3134 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3135 g_vflux(i,k) = 0.016666667*g_v(i,k-3,j)*vel-0.13333333*g_v(i,k-2,j)*vel+0.61666667*g_v(i,k-1,j)*vel+0.016666667*g_v(i,k+2,&
3136 &j)*vel-0.13333333*g_v(i,k+1,j)*vel+0.61666667*g_v(i,k,j)*vel+g_vel*(0.61666667*(v(i,k,j)+v(i,k-1,j))-0.13333333*(v(i,k+1,&
3137 &j)+v(i,k-2,j))+0.016666667*(v(i,k+2,j)+v(i,k-3,j)))
3138 vflux(i,k) = vel*(37./60.*(v(i,k,j)+v(i,k-1,j))-2./15.*(v(i,k+1,j)+v(i,k-2,j))+1./60.*(v(i,k+2,j)+v(i,k-3,j)))
3139 end do
3140 end do
3141 do i = i_start, i_end
3142 k = kts+1
3143 g_vflux(i,k) = 0.5*g_rom(i,k,j-1)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+&
3144 &0.5*g_v(i,k-1,j)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)+0.5*g_v(i,k,j)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3145 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i,k,j-1))*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3146 k = kts+2
3147 g_vel = 0.5*g_rom(i,k,j-1)+0.5*g_rom(i,k,j)
3148 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3149 g_vflux(i,k) = (-0.083333333)*g_v(i,k-2,j)*vel+0.58333333*g_v(i,k-1,j)*vel-0.083333333*g_v(i,k+1,j)*vel+0.58333333*g_v(i,k,j)&
3150 &*vel+g_vel*(0.58333333*(v(i,k,j)+v(i,k-1,j))-0.083333333*(v(i,k+1,j)+v(i,k-2,j)))
3151 vflux(i,k) = vel*(7./12.*(v(i,k,j)+v(i,k-1,j))-1./12.*(v(i,k+1,j)+v(i,k-2,j)))
3152 k = ktf-1
3153 g_vel = 0.5*g_rom(i,k,j-1)+0.5*g_rom(i,k,j)
3154 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3155 g_vflux(i,k) = (-0.083333333)*g_v(i,k-2,j)*vel+0.58333333*g_v(i,k-1,j)*vel-0.083333333*g_v(i,k+1,j)*vel+0.58333333*g_v(i,k,j)&
3156 &*vel+g_vel*(0.58333333*(v(i,k,j)+v(i,k-1,j))-0.083333333*(v(i,k+1,j)+v(i,k-2,j)))
3157 vflux(i,k) = vel*(7./12.*(v(i,k,j)+v(i,k-1,j))-1./12.*(v(i,k+1,j)+v(i,k-2,j)))
3158 k = ktf
3159 g_vflux(i,k) = 0.5*g_rom(i,k,j-1)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+&
3160 &0.5*g_v(i,k-1,j)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)+0.5*g_v(i,k,j)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3161 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i,k,j-1))*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3162 end do
3163 do k = kts, ktf
3164 do i = i_start, i_end
3165 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
3166 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
3167 end do
3168 end do
3169 end do
3170 else if (vert_order .eq. 5) then vert_order_tesu
3171 do j = j_start, j_end
3172 do k = kts+3, ktf-2
3173 do i = i_start, i_end
3174 g_vel = 0.5*g_rom(i,k,j-1)+0.5*g_rom(i,k,j)
3175 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3176 g_vflux(i,k) = g_v(i,k-3,j)*vel*(0.016666667-(-0.016666667)*sign(1.,-vel))+g_v(i,k-2,j)*vel*((-0.13333333)-0.083333333*&
3177 &sign(1.,-vel))+g_v(i,k-1,j)*vel*(0.61666667-(-0.16666667)*sign(1.,-vel))+g_v(i,k+2,j)*vel*(0.016666667-0.016666667*&
3178 &sign(1.,-vel))+g_v(i,k+1,j)*vel*((-0.13333333)-(-0.083333333)*sign(1.,-vel))+g_v(i,k,j)*vel*(0.61666667-0.16666667*&
3179 &sign(1.,-vel))+g_vel*(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)+v(i,k-3,&
3180 &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))
3181 vflux(i,k) = vel*(37./60.*(v(i,k,j)+v(i,k-1,j))-2./15.*(v(i,k+1,j)+v(i,k-2,j))+1./60.*(v(i,k+2,j)+v(i,k-3,j))-sign(1.,-vel)&
3182 &*(1./60.)*(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))))
3183 end do
3184 end do
3185 do i = i_start, i_end
3186 k = kts+1
3187 g_vflux(i,k) = 0.5*g_rom(i,k,j-1)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+&
3188 &0.5*g_v(i,k-1,j)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)+0.5*g_v(i,k,j)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3189 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i,k,j-1))*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3190 k = kts+2
3191 g_vel = 0.5*g_rom(i,k,j-1)+0.5*g_rom(i,k,j)
3192 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3193 g_vflux(i,k) = g_v(i,k-2,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))+g_v(i,k-1,j)*vel*(0.58333333+0.25*sign(1.,-vel)&
3194 &)+g_v(i,k+1,j)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))+g_v(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,-vel))+g_vel*&
3195 &(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,k-2,j)-3.*(v(i,k,j)-v(i,k-&
3196 &1,j)))*sign(1.,-vel))
3197 vflux(i,k) = vel*(7./12.*(v(i,k,j)+v(i,k-1,j))-1./12.*(v(i,k+1,j)+v(i,k-2,j))+sign(1.,-vel)*(1./12.)*(v(i,k+1,j)-v(i,k-2,j)-&
3198 &3.*(v(i,k,j)-v(i,k-1,j))))
3199 k = ktf-1
3200 g_vel = 0.5*g_rom(i,k,j-1)+0.5*g_rom(i,k,j)
3201 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3202 g_vflux(i,k) = g_v(i,k-2,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))+g_v(i,k-1,j)*vel*(0.58333333+0.25*sign(1.,-vel)&
3203 &)+g_v(i,k+1,j)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))+g_v(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,-vel))+g_vel*&
3204 &(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,k-2,j)-3.*(v(i,k,j)-v(i,k-&
3205 &1,j)))*sign(1.,-vel))
3206 vflux(i,k) = vel*(7./12.*(v(i,k,j)+v(i,k-1,j))-1./12.*(v(i,k+1,j)+v(i,k-2,j))+sign(1.,-vel)*(1./12.)*(v(i,k+1,j)-v(i,k-2,j)-&
3207 &3.*(v(i,k,j)-v(i,k-1,j))))
3208 k = ktf
3209 g_vflux(i,k) = 0.5*g_rom(i,k,j-1)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+&
3210 &0.5*g_v(i,k-1,j)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)+0.5*g_v(i,k,j)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3211 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i,k,j-1))*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3212 end do
3213 do k = kts, ktf
3214 do i = i_start, i_end
3215 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
3216 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
3217 end do
3218 end do
3219 end do
3220 else if (vert_order .eq. 4) then vert_order_tesu
3221 do j = j_start, j_end
3222 do k = kts+2, ktf-1
3223 do i = i_start, i_end
3224 g_vel = 0.5*g_rom(i,k,j-1)+0.5*g_rom(i,k,j)
3225 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3226 g_vflux(i,k) = (-0.083333333)*g_v(i,k-2,j)*vel+0.58333333*g_v(i,k-1,j)*vel-0.083333333*g_v(i,k+1,j)*vel+0.58333333*g_v(i,k,&
3227 &j)*vel+g_vel*(0.58333333*(v(i,k,j)+v(i,k-1,j))-0.083333333*(v(i,k+1,j)+v(i,k-2,j)))
3228 vflux(i,k) = vel*(7./12.*(v(i,k,j)+v(i,k-1,j))-1./12.*(v(i,k+1,j)+v(i,k-2,j)))
3229 end do
3230 end do
3231 do i = i_start, i_end
3232 k = kts+1
3233 g_vflux(i,k) = 0.5*g_rom(i,k,j-1)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+&
3234 &0.5*g_v(i,k-1,j)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)+0.5*g_v(i,k,j)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3235 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i,k,j-1))*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3236 k = ktf
3237 g_vflux(i,k) = 0.5*g_rom(i,k,j-1)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+&
3238 &0.5*g_v(i,k-1,j)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)+0.5*g_v(i,k,j)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3239 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i,k,j-1))*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3240 end do
3241 do k = kts, ktf
3242 do i = i_start, i_end
3243 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
3244 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
3245 end do
3246 end do
3247 end do
3248 else if (vert_order .eq. 3) then vert_order_tesu
3249 do j = j_start, j_end
3250 do k = kts+2, ktf-1
3251 do i = i_start, i_end
3252 g_vel = 0.5*g_rom(i,k,j-1)+0.5*g_rom(i,k,j)
3253 vel = 0.5*(rom(i,k,j)+rom(i,k,j-1))
3254 g_vflux(i,k) = g_v(i,k-2,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))+g_v(i,k-1,j)*vel*(0.58333333+0.25*sign(1.,-&
3255 &vel))+g_v(i,k+1,j)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))+g_v(i,k,j)*vel*(0.58333333+(-0.25)*sign(1.,-vel))+g_vel*&
3256 &(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,k-2,j)-3.*(v(i,k,j)-v(i,&
3257 &k-1,j)))*sign(1.,-vel))
3258 vflux(i,k) = vel*(7./12.*(v(i,k,j)+v(i,k-1,j))-1./12.*(v(i,k+1,j)+v(i,k-2,j))+sign(1.,-vel)*(1./12.)*(v(i,k+1,j)-v(i,k-2,j)&
3259 &-3.*(v(i,k,j)-v(i,k-1,j))))
3260 end do
3261 end do
3262 do i = i_start, i_end
3263 k = kts+1
3264 g_vflux(i,k) = 0.5*g_rom(i,k,j-1)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+&
3265 &0.5*g_v(i,k-1,j)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)+0.5*g_v(i,k,j)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3266 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i,k,j-1))*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3267 k = ktf
3268 g_vflux(i,k) = 0.5*g_rom(i,k,j-1)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+&
3269 &0.5*g_v(i,k-1,j)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)+0.5*g_v(i,k,j)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3270 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i,k,j-1))*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3271 end do
3272 do k = kts, ktf
3273 do i = i_start, i_end
3274 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
3275 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
3276 end do
3277 end do
3278 end do
3279 else if (vert_order .eq. 2) then vert_order_tesu
3280 do j = j_start, j_end
3281 do k = kts+1, ktf
3282 do i = i_start, i_end
3283 g_vflux(i,k) = 0.5*g_rom(i,k,j-1)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+0.5*g_rom(i,k,j)*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))+&
3284 &0.5*g_v(i,k-1,j)*(rom(i,k,j)+rom(i,k,j-1))*fzp(k)+0.5*g_v(i,k,j)*(rom(i,k,j)+rom(i,k,j-1))*fzm(k)
3285 vflux(i,k) = 0.5*(rom(i,k,j)+rom(i,k,j-1))*(fzm(k)*v(i,k,j)+fzp(k)*v(i,k-1,j))
3286 end do
3287 end do
3288 do k = kts, ktf
3289 do i = i_start, i_end
3290 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzw(k)+g_vflux(i,k)*rdzw(k)
3291 tendency(i,k,j) = tendency(i,k,j)-rdzw(k)*(vflux(i,k+1)-vflux(i,k))
3292 end do
3293 end do
3294 end do
3295 endif vert_order_tesu
3296
3297 end subroutine g_advect_v
3298
3299
3300 subroutine g_advect_w( w, g_w, w_old, g_w_old, tendency, g_tendency, ru, g_ru, rv, g_rv, rom, g_rom, config_flags, msft, fzm, fzp, &
3301 &rdx, rdy, rdzu, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
3302 !******************************************************************
3303 !******************************************************************
3304 !** This routine was generated by Automatic differentiation. **
3305 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
3306 !******************************************************************
3307 !******************************************************************
3308 !==============================================
3309 ! all entries are defined explicitly
3310 !==============================================
3311 implicit none
3312
3313 !==============================================
3314 ! declare arguments
3315 !==============================================
3316 type (grid_config_rec_type), intent(in) :: config_flags
3317 integer, intent(in) :: kme
3318 integer, intent(in) :: kms
3319 real, intent(in) :: fzm(kms:kme)
3320 real, intent(in) :: fzp(kms:kme)
3321 integer, intent(in) :: ime
3322 integer, intent(in) :: ims
3323 integer, intent(in) :: jme
3324 integer, intent(in) :: jms
3325 real, intent(in) :: g_rom(ims:ime,kms:kme,jms:jme)
3326 real, intent(in) :: g_ru(ims:ime,kms:kme,jms:jme)
3327 real, intent(in) :: g_rv(ims:ime,kms:kme,jms:jme)
3328 real, intent(inout) :: g_tendency(ims:ime,kms:kme,jms:jme)
3329 real, intent(in) :: g_w(ims:ime,kms:kme,jms:jme)
3330 real, intent(in) :: g_w_old(ims:ime,kms:kme,jms:jme)
3331 integer, intent(in) :: ide
3332 integer, intent(in) :: ids
3333 integer, intent(in) :: ite
3334 integer, intent(in) :: its
3335 integer, intent(in) :: jde
3336 integer, intent(in) :: jds
3337 integer, intent(in) :: jte
3338 integer, intent(in) :: jts
3339 integer, intent(in) :: kde
3340 integer, intent(in) :: kte
3341 integer, intent(in) :: kts
3342 real, intent(in) :: msft(ims:ime,jms:jme)
3343 real, intent(in) :: rdx
3344 real, intent(in) :: rdy
3345 real, intent(in) :: rdzu(kms:kme)
3346 real, intent(in) :: rom(ims:ime,kms:kme,jms:jme)
3347 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
3348 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
3349 real, intent(inout) :: tendency(ims:ime,kms:kme,jms:jme)
3350 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
3351 real, intent(in) :: w_old(ims:ime,kms:kme,jms:jme)
3352
3353 !==============================================
3354 ! declare local variables
3355 !==============================================
3356 logical degrade_xe
3357 logical degrade_xs
3358 logical degrade_ye
3359 logical degrade_ys
3360 real fqx(its:ite+1,kts:kte)
3361 real fqy(its:ite,kts:kte,2)
3362 real g_fqx(its:ite+1,kts:kte)
3363 real g_fqy(its:ite,kts:kte,2)
3364 real g_ub
3365 real g_uw
3366 real g_vb
3367 real g_vel
3368 real g_vflux(its:ite,kts:kte)
3369 real g_vw
3370 integer horz_order
3371 integer i
3372 integer i_end
3373 integer i_end_f
3374 integer i_start
3375 integer i_start_f
3376 integer j
3377 integer j_end
3378 integer j_end_f
3379 integer j_start
3380 integer j_start_f
3381 integer jp0
3382 integer jp1
3383 integer jtmp
3384 integer k
3385 integer ktf
3386 real mrdx
3387 real mrdy
3388 logical specified
3389 real ub
3390 real uw
3391 real vb
3392 real vel
3393 integer vert_order
3394 real vflux(its:ite,kts:kte)
3395 real vw
3396
3397 !----------------------------------------------
3398 ! TANGENT LINEAR AND FUNCTION STATEMENTS
3399 !----------------------------------------------
3400 specified = .false.
3401 if (config_flags%specified .or. config_flags%nested) then
3402 specified = .true.
3403 endif
3404 ktf = min(kte,kde-1)
3405 horz_order = config_flags%h_sca_adv_order
3406 vert_order = config_flags%v_sca_adv_order
3407 horizontal_order_tesu: if (horz_order .eq. 6) then
3408 degrade_xs = .true.
3409 degrade_xe = .true.
3410 degrade_ys = .true.
3411 degrade_ye = .true.
3412 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
3413 degrade_xs = .false.
3414 endif
3415 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-3) then
3416 degrade_xe = .false.
3417 endif
3418 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
3419 degrade_ys = .false.
3420 endif
3421 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-3) then
3422 degrade_ye = .false.
3423 endif
3424 i_start = its
3425 i_end = min(ite,ide-1)
3426 j_start = jts
3427 j_end = min(jte,jde-1)
3428 j_start_f = j_start
3429 j_end_f = j_end+1
3430 if (degrade_ys) then
3431 j_start = max(jts,jds+1)
3432 j_start_f = jds+3
3433 endif
3434 if (degrade_ye) then
3435 j_end = min(jte,jde-2)
3436 j_end_f = jde-3
3437 endif
3438 jp1 = 2
3439 jp0 = 1
3440 j_loop_y_flux_6: do j = j_start, j_end+1
3441 if (j .ge. j_start_f .and. j .le. j_end_f) then
3442 do k = kts+1, ktf
3443 do i = i_start, i_end
3444 g_vel = g_rv(i,k-1,j)*fzp(k)+g_rv(i,k,j)*fzm(k)
3445 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
3446 g_fqy(i,k,jp1) = g_vel*(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)+w(i,&
3447 &k,j-3)))+0.016666667*g_w(i,k,j-3)*vel-0.13333333*g_w(i,k,j-2)*vel+0.61666667*g_w(i,k,j-1)*vel+0.016666667*g_w(i,k,j+2)*&
3448 &vel-0.13333333*g_w(i,k,j+1)*vel+0.61666667*g_w(i,k,j)*vel
3449 fqy(i,k,jp1) = vel*(37./60.*(w(i,k,j)+w(i,k,j-1))-2./15.*(w(i,k,j+1)+w(i,k,j-2))+1./60.*(w(i,k,j+2)+w(i,k,j-3)))
3450 end do
3451 end do
3452 k = ktf+1
3453 do i = i_start, i_end
3454 g_vel = (-(g_rv(i,k-2,j)*fzp(k-1)))+g_rv(i,k-1,j)*(2-fzm(k-1))
3455 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
3456 g_fqy(i,k,jp1) = g_vel*(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)+w(i,k,&
3457 &j-3)))+0.016666667*g_w(i,k,j-3)*vel-0.13333333*g_w(i,k,j-2)*vel+0.61666667*g_w(i,k,j-1)*vel+0.016666667*g_w(i,k,j+2)*vel-&
3458 &0.13333333*g_w(i,k,j+1)*vel+0.61666667*g_w(i,k,j)*vel
3459 fqy(i,k,jp1) = vel*(37./60.*(w(i,k,j)+w(i,k,j-1))-2./15.*(w(i,k,j+1)+w(i,k,j-2))+1./60.*(w(i,k,j+2)+w(i,k,j-3)))
3460 end do
3461 else if (j .eq. jds+1) then
3462 do k = kts+1, ktf
3463 do i = i_start, i_end
3464 g_fqy(i,k,jp1) = 0.5*g_rv(i,k-1,j)*fzp(k)*(w(i,k,j)+w(i,k,j-1))+0.5*g_rv(i,k,j)*fzm(k)*(w(i,k,j)+w(i,k,j-1))+0.5*g_w(i,k,&
3465 &j-1)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))+0.5*g_w(i,k,j)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))
3466 fqy(i,k,jp1) = 0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))*(w(i,k,j)+w(i,k,j-1))
3467 end do
3468 end do
3469 k = ktf+1
3470 do i = i_start, i_end
3471 g_fqy(i,k,jp1) = (-(0.5*g_rv(i,k-2,j)*fzp(k-1)*(w(i,k,j)+w(i,k,j-1))))+0.5*g_rv(i,k-1,j)*(2-fzm(k-1))*(w(i,k,j)+w(i,k,j-1))&
3472 &+0.5*g_w(i,k,j-1)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))+0.5*g_w(i,k,j)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))
3473 fqy(i,k,jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))*(w(i,k,j)+w(i,k,j-1))
3474 end do
3475 else if (j .eq. jds+2) then
3476 do k = kts+1, ktf
3477 do i = i_start, i_end
3478 g_vel = g_rv(i,k-1,j)*fzp(k)+g_rv(i,k,j)*fzm(k)
3479 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
3480 g_fqy(i,k,jp1) = g_vel*(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*g_w(i,k,j-2)*&
3481 &vel+0.58333333*g_w(i,k,j-1)*vel-0.083333333*g_w(i,k,j+1)*vel+0.58333333*g_w(i,k,j)*vel
3482 fqy(i,k,jp1) = vel*(7./12.*(w(i,k,j)+w(i,k,j-1))-1./12.*(w(i,k,j+1)+w(i,k,j-2)))
3483 end do
3484 end do
3485 k = ktf+1
3486 do i = i_start, i_end
3487 g_vel = (-(g_rv(i,k-2,j)*fzp(k-1)))+g_rv(i,k-1,j)*(2-fzm(k-1))
3488 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
3489 g_fqy(i,k,jp1) = g_vel*(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*g_w(i,k,j-2)*vel+&
3490 &0.58333333*g_w(i,k,j-1)*vel-0.083333333*g_w(i,k,j+1)*vel+0.58333333*g_w(i,k,j)*vel
3491 fqy(i,k,jp1) = vel*(7./12.*(w(i,k,j)+w(i,k,j-1))-1./12.*(w(i,k,j+1)+w(i,k,j-2)))
3492 end do
3493 else if (j .eq. jde-1) then
3494 do k = kts+1, ktf
3495 do i = i_start, i_end
3496 g_fqy(i,k,jp1) = 0.5*g_rv(i,k-1,j)*fzp(k)*(w(i,k,j)+w(i,k,j-1))+0.5*g_rv(i,k,j)*fzm(k)*(w(i,k,j)+w(i,k,j-1))+0.5*g_w(i,k,&
3497 &j-1)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))+0.5*g_w(i,k,j)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))
3498 fqy(i,k,jp1) = 0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))*(w(i,k,j)+w(i,k,j-1))
3499 end do
3500 end do
3501 k = ktf+1
3502 do i = i_start, i_end
3503 g_fqy(i,k,jp1) = (-(0.5*g_rv(i,k-2,j)*fzp(k-1)*(w(i,k,j)+w(i,k,j-1))))+0.5*g_rv(i,k-1,j)*(2-fzm(k-1))*(w(i,k,j)+w(i,k,j-1))&
3504 &+0.5*g_w(i,k,j-1)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))+0.5*g_w(i,k,j)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))
3505 fqy(i,k,jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))*(w(i,k,j)+w(i,k,j-1))
3506 end do
3507 else if (j .eq. jde-2) then
3508 do k = kts+1, ktf
3509 do i = i_start, i_end
3510 g_vel = g_rv(i,k-1,j)*fzp(k)+g_rv(i,k,j)*fzm(k)
3511 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
3512 g_fqy(i,k,jp1) = g_vel*(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*g_w(i,k,j-2)*&
3513 &vel+0.58333333*g_w(i,k,j-1)*vel-0.083333333*g_w(i,k,j+1)*vel+0.58333333*g_w(i,k,j)*vel
3514 fqy(i,k,jp1) = vel*(7./12.*(w(i,k,j)+w(i,k,j-1))-1./12.*(w(i,k,j+1)+w(i,k,j-2)))
3515 end do
3516 end do
3517 k = ktf+1
3518 do i = i_start, i_end
3519 g_vel = (-(g_rv(i,k-2,j)*fzp(k-1)))+g_rv(i,k-1,j)*(2-fzm(k-1))
3520 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
3521 g_fqy(i,k,jp1) = g_vel*(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*g_w(i,k,j-2)*vel+&
3522 &0.58333333*g_w(i,k,j-1)*vel-0.083333333*g_w(i,k,j+1)*vel+0.58333333*g_w(i,k,j)*vel
3523 fqy(i,k,jp1) = vel*(7./12.*(w(i,k,j)+w(i,k,j-1))-1./12.*(w(i,k,j+1)+w(i,k,j-2)))
3524 end do
3525 endif
3526 if (j .gt. j_start) then
3527 do k = kts+1, ktf+1
3528 do i = i_start, i_end
3529 mrdy = msft(i,j-1)*rdy
3530 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
3531 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
3532 end do
3533 end do
3534 endif
3535 jtmp = jp1
3536 jp1 = jp0
3537 jp0 = jtmp
3538 end do j_loop_y_flux_6
3539 i_start = its
3540 i_end = min(ite,ide-1)
3541 j_start = jts
3542 j_end = min(jte,jde-1)
3543 i_start_f = i_start
3544 i_end_f = i_end+1
3545 if (degrade_xs) then
3546 i_start = max(ids+1,its)
3547 i_start_f = i_start+2
3548 endif
3549 if (degrade_xe) then
3550 i_end = min(ide-2,ite)
3551 i_end_f = ide-3
3552 endif
3553 do j = j_start, j_end
3554 do k = kts+1, ktf
3555 do i = i_start_f, i_end_f
3556 g_vel = g_ru(i,k-1,j)*fzp(k)+g_ru(i,k,j)*fzm(k)
3557 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
3558 g_fqx(i,k) = g_vel*(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,k,j))&
3559 &)+0.016666667*g_w(i-3,k,j)*vel-0.13333333*g_w(i-2,k,j)*vel+0.61666667*g_w(i-1,k,j)*vel+0.016666667*g_w(i+2,k,j)*vel-&
3560 &0.13333333*g_w(i+1,k,j)*vel+0.61666667*g_w(i,k,j)*vel
3561 fqx(i,k) = vel*(37./60.*(w(i,k,j)+w(i-1,k,j))-2./15.*(w(i+1,k,j)+w(i-2,k,j))+1./60.*(w(i+2,k,j)+w(i-3,k,j)))
3562 end do
3563 end do
3564 k = ktf+1
3565 do i = i_start_f, i_end_f
3566 g_vel = (-(g_ru(i,k-2,j)*fzp(k-1)))+g_ru(i,k-1,j)*(2-fzm(k-1))
3567 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
3568 g_fqx(i,k) = g_vel*(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,k,j)))+&
3569 &0.016666667*g_w(i-3,k,j)*vel-0.13333333*g_w(i-2,k,j)*vel+0.61666667*g_w(i-1,k,j)*vel+0.016666667*g_w(i+2,k,j)*vel-&
3570 &0.13333333*g_w(i+1,k,j)*vel+0.61666667*g_w(i,k,j)*vel
3571 fqx(i,k) = vel*(37./60.*(w(i,k,j)+w(i-1,k,j))-2./15.*(w(i+1,k,j)+w(i-2,k,j))+1./60.*(w(i+2,k,j)+w(i-3,k,j)))
3572 end do
3573 if (degrade_xs) then
3574 if (i_start .eq. ids+1) then
3575 i = ids+1
3576 do k = kts+1, ktf
3577 g_fqx(i,k) = 0.5*g_ru(i,k-1,j)*fzp(k)*(w(i,k,j)+w(i-1,k,j))+0.5*g_ru(i,k,j)*fzm(k)*(w(i,k,j)+w(i-1,k,j))+0.5*g_w(i-1,k,j)&
3578 &*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))+0.5*g_w(i,k,j)*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))
3579 fqx(i,k) = 0.5*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))*(w(i,k,j)+w(i-1,k,j))
3580 end do
3581 k = ktf+1
3582 g_fqx(i,k) = (-(0.5*g_ru(i,k-2,j)*fzp(k-1)*(w(i,k,j)+w(i-1,k,j))))+0.5*g_ru(i,k-1,j)*(2-fzm(k-1))*(w(i,k,j)+w(i-1,k,j))+&
3583 &0.5*g_w(i-1,k,j)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))+0.5*g_w(i,k,j)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))
3584 fqx(i,k) = 0.5*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))*(w(i,k,j)+w(i-1,k,j))
3585 endif
3586 do k = kts+1, ktf
3587 i = i_start+1
3588 g_vel = g_ru(i,k-1,j)*fzp(k)+g_ru(i,k,j)*fzm(k)
3589 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
3590 g_fqx(i,k) = g_vel*(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*g_w(i-2,k,j)*vel+&
3591 &0.58333333*g_w(i-1,k,j)*vel-0.083333333*g_w(i+1,k,j)*vel+0.58333333*g_w(i,k,j)*vel
3592 fqx(i,k) = vel*(7./12.*(w(i,k,j)+w(i-1,k,j))-1./12.*(w(i+1,k,j)+w(i-2,k,j)))
3593 end do
3594 k = ktf+1
3595 g_vel = (-(g_ru(i,k-2,j)*fzp(k-1)))+g_ru(i,k-1,j)*(2-fzm(k-1))
3596 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
3597 g_fqx(i,k) = g_vel*(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*g_w(i-2,k,j)*vel+&
3598 &0.58333333*g_w(i-1,k,j)*vel-0.083333333*g_w(i+1,k,j)*vel+0.58333333*g_w(i,k,j)*vel
3599 fqx(i,k) = vel*(7./12.*(w(i,k,j)+w(i-1,k,j))-1./12.*(w(i+1,k,j)+w(i-2,k,j)))
3600 endif
3601 if (degrade_xe) then
3602 if (i_end .eq. ide-2) then
3603 i = ide-1
3604 do k = kts+1, ktf
3605 g_fqx(i,k) = 0.5*g_ru(i,k-1,j)*fzp(k)*(w(i,k,j)+w(i-1,k,j))+0.5*g_ru(i,k,j)*fzm(k)*(w(i,k,j)+w(i-1,k,j))+0.5*g_w(i-1,k,j)&
3606 &*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))+0.5*g_w(i,k,j)*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))
3607 fqx(i,k) = 0.5*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))*(w(i,k,j)+w(i-1,k,j))
3608 end do
3609 k = ktf+1
3610 g_fqx(i,k) = (-(0.5*g_ru(i,k-2,j)*fzp(k-1)*(w(i,k,j)+w(i-1,k,j))))+0.5*g_ru(i,k-1,j)*(2-fzm(k-1))*(w(i,k,j)+w(i-1,k,j))+&
3611 &0.5*g_w(i-1,k,j)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))+0.5*g_w(i,k,j)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))
3612 fqx(i,k) = 0.5*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))*(w(i,k,j)+w(i-1,k,j))
3613 endif
3614 i = ide-2
3615 do k = kts+1, ktf
3616 g_vel = g_ru(i,k-1,j)*fzp(k)+g_ru(i,k,j)*fzm(k)
3617 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
3618 g_fqx(i,k) = g_vel*(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*g_w(i-2,k,j)*vel+&
3619 &0.58333333*g_w(i-1,k,j)*vel-0.083333333*g_w(i+1,k,j)*vel+0.58333333*g_w(i,k,j)*vel
3620 fqx(i,k) = vel*(7./12.*(w(i,k,j)+w(i-1,k,j))-1./12.*(w(i+1,k,j)+w(i-2,k,j)))
3621 end do
3622 k = ktf+1
3623 g_vel = (-(g_ru(i,k-2,j)*fzp(k-1)))+g_ru(i,k-1,j)*(2-fzm(k-1))
3624 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
3625 g_fqx(i,k) = g_vel*(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*g_w(i-2,k,j)*vel+&
3626 &0.58333333*g_w(i-1,k,j)*vel-0.083333333*g_w(i+1,k,j)*vel+0.58333333*g_w(i,k,j)*vel
3627 fqx(i,k) = vel*(7./12.*(w(i,k,j)+w(i-1,k,j))-1./12.*(w(i+1,k,j)+w(i-2,k,j)))
3628 endif
3629 do k = kts+1, ktf+1
3630 do i = i_start, i_end
3631 mrdx = msft(i,j)*rdx
3632 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
3633 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
3634 end do
3635 end do
3636 end do
3637 else if (horz_order .eq. 5) then horizontal_order_tesu
3638 degrade_xs = .true.
3639 degrade_xe = .true.
3640 degrade_ys = .true.
3641 degrade_ye = .true.
3642 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+2) then
3643 degrade_xs = .false.
3644 endif
3645 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-3) then
3646 degrade_xe = .false.
3647 endif
3648 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+2) then
3649 degrade_ys = .false.
3650 endif
3651 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-3) then
3652 degrade_ye = .false.
3653 endif
3654 i_start = its
3655 i_end = min(ite,ide-1)
3656 j_start = jts
3657 j_end = min(jte,jde-1)
3658 j_start_f = j_start
3659 j_end_f = j_end+1
3660 if (degrade_ys) then
3661 j_start = max(jts,jds+1)
3662 j_start_f = jds+3
3663 endif
3664 if (degrade_ye) then
3665 j_end = min(jte,jde-2)
3666 j_end_f = jde-3
3667 endif
3668 jp1 = 2
3669 jp0 = 1
3670 j_loop_y_flux_5: do j = j_start, j_end+1
3671 if (j .ge. j_start_f .and. j .le. j_end_f) then
3672 do k = kts+1, ktf
3673 do i = i_start, i_end
3674 g_vel = g_rv(i,k-1,j)*fzp(k)+g_rv(i,k,j)*fzm(k)
3675 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
3676 g_fqy(i,k,jp1) = g_vel*(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)+w(i,&
3677 &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))+g_w(i,k,&
3678 &j-3)*vel*(0.016666667-(-0.016666667)*sign(1.,vel))+g_w(i,k,j-2)*vel*((-0.13333333)-0.083333333*sign(1.,vel))+g_w(i,k,j-&
3679 &1)*vel*(0.61666667-(-0.16666667)*sign(1.,vel))+g_w(i,k,j+2)*vel*(0.016666667-0.016666667*sign(1.,vel))+g_w(i,k,j+1)*vel*&
3680 &((-0.13333333)-(-0.083333333)*sign(1.,vel))+g_w(i,k,j)*vel*(0.61666667-0.16666667*sign(1.,vel))
3681 fqy(i,k,jp1) = vel*(37./60.*(w(i,k,j)+w(i,k,j-1))-2./15.*(w(i,k,j+1)+w(i,k,j-2))+1./60.*(w(i,k,j+2)+w(i,k,j-3))-sign(1.,&
3682 &vel)*(1./60.)*(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))))
3683 end do
3684 end do
3685 k = ktf+1
3686 do i = i_start, i_end
3687 g_vel = (-(g_rv(i,k-2,j)*fzp(k-1)))+g_rv(i,k-1,j)*(2-fzm(k-1))
3688 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
3689 g_fqy(i,k,jp1) = g_vel*(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)+w(i,k,&
3690 &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))+g_w(i,k,j-3)*&
3691 &vel*(0.016666667-(-0.016666667)*sign(1.,vel))+g_w(i,k,j-2)*vel*((-0.13333333)-0.083333333*sign(1.,vel))+g_w(i,k,j-1)*vel*&
3692 &(0.61666667-(-0.16666667)*sign(1.,vel))+g_w(i,k,j+2)*vel*(0.016666667-0.016666667*sign(1.,vel))+g_w(i,k,j+1)*vel*((-&
3693 &0.13333333)-(-0.083333333)*sign(1.,vel))+g_w(i,k,j)*vel*(0.61666667-0.16666667*sign(1.,vel))
3694 fqy(i,k,jp1) = vel*(37./60.*(w(i,k,j)+w(i,k,j-1))-2./15.*(w(i,k,j+1)+w(i,k,j-2))+1./60.*(w(i,k,j+2)+w(i,k,j-3))-sign(1.,&
3695 &vel)*(1./60.)*(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))))
3696 end do
3697 else if (j .eq. jds+1) then
3698 do k = kts+1, ktf
3699 do i = i_start, i_end
3700 g_fqy(i,k,jp1) = 0.5*g_rv(i,k-1,j)*fzp(k)*(w(i,k,j)+w(i,k,j-1))+0.5*g_rv(i,k,j)*fzm(k)*(w(i,k,j)+w(i,k,j-1))+0.5*g_w(i,k,&
3701 &j-1)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))+0.5*g_w(i,k,j)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))
3702 fqy(i,k,jp1) = 0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))*(w(i,k,j)+w(i,k,j-1))
3703 end do
3704 end do
3705 k = ktf+1
3706 do i = i_start, i_end
3707 g_fqy(i,k,jp1) = (-(0.5*g_rv(i,k-2,j)*fzp(k-1)*(w(i,k,j)+w(i,k,j-1))))+0.5*g_rv(i,k-1,j)*(2-fzm(k-1))*(w(i,k,j)+w(i,k,j-1))&
3708 &+0.5*g_w(i,k,j-1)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))+0.5*g_w(i,k,j)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))
3709 fqy(i,k,jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))*(w(i,k,j)+w(i,k,j-1))
3710 end do
3711 else if (j .eq. jds+2) then
3712 do k = kts+1, ktf
3713 do i = i_start, i_end
3714 g_vel = g_rv(i,k-1,j)*fzp(k)+g_rv(i,k,j)*fzm(k)
3715 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
3716 g_fqy(i,k,jp1) = g_vel*(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)-w(i,&
3717 &k,j-2)-3.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))+g_w(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_w(i,k,j-&
3718 &1)*vel*(0.58333333+0.25*sign(1.,vel))+g_w(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_w(i,k,j)*vel*&
3719 &(0.58333333+(-0.25)*sign(1.,vel))
3720 fqy(i,k,jp1) = vel*(7./12.*(w(i,k,j)+w(i,k,j-1))-1./12.*(w(i,k,j+1)+w(i,k,j-2))+sign(1.,vel)*(1./12.)*(w(i,k,j+1)-w(i,k,&
3721 &j-2)-3.*(w(i,k,j)-w(i,k,j-1))))
3722 end do
3723 end do
3724 k = ktf+1
3725 do i = i_start, i_end
3726 g_vel = (-(g_rv(i,k-2,j)*fzp(k-1)))+g_rv(i,k-1,j)*(2-fzm(k-1))
3727 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
3728 g_fqy(i,k,jp1) = g_vel*(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)-w(i,k,&
3729 &j-2)-3.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))+g_w(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_w(i,k,j-1)*&
3730 &vel*(0.58333333+0.25*sign(1.,vel))+g_w(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_w(i,k,j)*vel*(0.58333333+&
3731 &(-0.25)*sign(1.,vel))
3732 fqy(i,k,jp1) = vel*(7./12.*(w(i,k,j)+w(i,k,j-1))-1./12.*(w(i,k,j+1)+w(i,k,j-2))+sign(1.,vel)*(1./12.)*(w(i,k,j+1)-w(i,k,j-&
3733 &2)-3.*(w(i,k,j)-w(i,k,j-1))))
3734 end do
3735 else if (j .eq. jde-1) then
3736 do k = kts+1, ktf
3737 do i = i_start, i_end
3738 g_fqy(i,k,jp1) = 0.5*g_rv(i,k-1,j)*fzp(k)*(w(i,k,j)+w(i,k,j-1))+0.5*g_rv(i,k,j)*fzm(k)*(w(i,k,j)+w(i,k,j-1))+0.5*g_w(i,k,&
3739 &j-1)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))+0.5*g_w(i,k,j)*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))
3740 fqy(i,k,jp1) = 0.5*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))*(w(i,k,j)+w(i,k,j-1))
3741 end do
3742 end do
3743 k = ktf+1
3744 do i = i_start, i_end
3745 g_fqy(i,k,jp1) = (-(0.5*g_rv(i,k-2,j)*fzp(k-1)*(w(i,k,j)+w(i,k,j-1))))+0.5*g_rv(i,k-1,j)*(2-fzm(k-1))*(w(i,k,j)+w(i,k,j-1))&
3746 &+0.5*g_w(i,k,j-1)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))+0.5*g_w(i,k,j)*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))
3747 fqy(i,k,jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))*(w(i,k,j)+w(i,k,j-1))
3748 end do
3749 else if (j .eq. jde-2) then
3750 do k = kts+1, ktf
3751 do i = i_start, i_end
3752 g_vel = g_rv(i,k-1,j)*fzp(k)+g_rv(i,k,j)*fzm(k)
3753 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
3754 g_fqy(i,k,jp1) = g_vel*(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)-w(i,&
3755 &k,j-2)-3.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))+g_w(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_w(i,k,j-&
3756 &1)*vel*(0.58333333+0.25*sign(1.,vel))+g_w(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_w(i,k,j)*vel*&
3757 &(0.58333333+(-0.25)*sign(1.,vel))
3758 fqy(i,k,jp1) = vel*(7./12.*(w(i,k,j)+w(i,k,j-1))-1./12.*(w(i,k,j+1)+w(i,k,j-2))+sign(1.,vel)*(1./12.)*(w(i,k,j+1)-w(i,k,&
3759 &j-2)-3.*(w(i,k,j)-w(i,k,j-1))))
3760 end do
3761 end do
3762 k = ktf+1
3763 do i = i_start, i_end
3764 g_vel = (-(g_rv(i,k-2,j)*fzp(k-1)))+g_rv(i,k-1,j)*(2-fzm(k-1))
3765 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
3766 g_fqy(i,k,jp1) = g_vel*(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)-w(i,k,&
3767 &j-2)-3.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))+g_w(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_w(i,k,j-1)*&
3768 &vel*(0.58333333+0.25*sign(1.,vel))+g_w(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_w(i,k,j)*vel*(0.58333333+&
3769 &(-0.25)*sign(1.,vel))
3770 fqy(i,k,jp1) = vel*(7./12.*(w(i,k,j)+w(i,k,j-1))-1./12.*(w(i,k,j+1)+w(i,k,j-2))+sign(1.,vel)*(1./12.)*(w(i,k,j+1)-w(i,k,j-&
3771 &2)-3.*(w(i,k,j)-w(i,k,j-1))))
3772 end do
3773 endif
3774 if (j .gt. j_start) then
3775 do k = kts+1, ktf+1
3776 do i = i_start, i_end
3777 mrdy = msft(i,j-1)*rdy
3778 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
3779 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
3780 end do
3781 end do
3782 endif
3783 jtmp = jp1
3784 jp1 = jp0
3785 jp0 = jtmp
3786 end do j_loop_y_flux_5
3787 i_start = its
3788 i_end = min(ite,ide-1)
3789 j_start = jts
3790 j_end = min(jte,jde-1)
3791 i_start_f = i_start
3792 i_end_f = i_end+1
3793 if (degrade_xs) then
3794 i_start = max(ids+1,its)
3795 i_start_f = i_start+2
3796 endif
3797 if (degrade_xe) then
3798 i_end = min(ide-2,ite)
3799 i_end_f = ide-3
3800 endif
3801 do j = j_start, j_end
3802 do k = kts+1, ktf
3803 do i = i_start_f, i_end_f
3804 g_vel = g_ru(i,k-1,j)*fzp(k)+g_ru(i,k,j)*fzm(k)
3805 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
3806 g_fqx(i,k) = g_vel*(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,k,j))&
3807 &-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))+g_w(i-3,k,j)*vel*&
3808 &(0.016666667-(-0.016666667)*sign(1.,vel))+g_w(i-2,k,j)*vel*((-0.13333333)-0.083333333*sign(1.,vel))+g_w(i-1,k,j)*vel*&
3809 &(0.61666667-(-0.16666667)*sign(1.,vel))+g_w(i+2,k,j)*vel*(0.016666667-0.016666667*sign(1.,vel))+g_w(i+1,k,j)*vel*((-&
3810 &0.13333333)-(-0.083333333)*sign(1.,vel))+g_w(i,k,j)*vel*(0.61666667-0.16666667*sign(1.,vel))
3811 fqx(i,k) = vel*(37./60.*(w(i,k,j)+w(i-1,k,j))-2./15.*(w(i+1,k,j)+w(i-2,k,j))+1./60.*(w(i+2,k,j)+w(i-3,k,j))-sign(1.,vel)*&
3812 &(1./60.)*(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))))
3813 end do
3814 end do
3815 k = ktf+1
3816 do i = i_start_f, i_end_f
3817 g_vel = (-(g_ru(i,k-2,j)*fzp(k-1)))+g_ru(i,k-1,j)*(2-fzm(k-1))
3818 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
3819 g_fqx(i,k) = g_vel*(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,k,j))-&
3820 &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))+g_w(i-3,k,j)*vel*&
3821 &(0.016666667-(-0.016666667)*sign(1.,vel))+g_w(i-2,k,j)*vel*((-0.13333333)-0.083333333*sign(1.,vel))+g_w(i-1,k,j)*vel*&
3822 &(0.61666667-(-0.16666667)*sign(1.,vel))+g_w(i+2,k,j)*vel*(0.016666667-0.016666667*sign(1.,vel))+g_w(i+1,k,j)*vel*((-&
3823 &0.13333333)-(-0.083333333)*sign(1.,vel))+g_w(i,k,j)*vel*(0.61666667-0.16666667*sign(1.,vel))
3824 fqx(i,k) = vel*(37./60.*(w(i,k,j)+w(i-1,k,j))-2./15.*(w(i+1,k,j)+w(i-2,k,j))+1./60.*(w(i+2,k,j)+w(i-3,k,j))-sign(1.,vel)*(1./&
3825 &60.)*(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))))
3826 end do
3827 if (degrade_xs) then
3828 if (i_start .eq. ids+1) then
3829 i = ids+1
3830 do k = kts+1, ktf
3831 g_fqx(i,k) = 0.5*g_ru(i,k-1,j)*fzp(k)*(w(i,k,j)+w(i-1,k,j))+0.5*g_ru(i,k,j)*fzm(k)*(w(i,k,j)+w(i-1,k,j))+0.5*g_w(i-1,k,j)&
3832 &*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))+0.5*g_w(i,k,j)*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))
3833 fqx(i,k) = 0.5*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))*(w(i,k,j)+w(i-1,k,j))
3834 end do
3835 k = ktf+1
3836 g_fqx(i,k) = (-(0.5*g_ru(i,k-2,j)*fzp(k-1)*(w(i,k,j)+w(i-1,k,j))))+0.5*g_ru(i,k-1,j)*(2-fzm(k-1))*(w(i,k,j)+w(i-1,k,j))+&
3837 &0.5*g_w(i-1,k,j)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))+0.5*g_w(i,k,j)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))
3838 fqx(i,k) = 0.5*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))*(w(i,k,j)+w(i-1,k,j))
3839 endif
3840 i = i_start+1
3841 do k = kts+1, ktf
3842 g_vel = g_ru(i,k-1,j)*fzp(k)+g_ru(i,k,j)*fzm(k)
3843 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
3844 g_fqx(i,k) = g_vel*(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,k,j)&
3845 &-3.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))+g_w(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_w(i-1,k,j)*vel*&
3846 &(0.58333333+0.25*sign(1.,vel))+g_w(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_w(i,k,j)*vel*(0.58333333+(-&
3847 &0.25)*sign(1.,vel))
3848 fqx(i,k) = vel*(7./12.*(w(i,k,j)+w(i-1,k,j))-1./12.*(w(i+1,k,j)+w(i-2,k,j))+sign(1.,vel)*(1./12.)*(w(i+1,k,j)-w(i-2,k,j)-&
3849 &3.*(w(i,k,j)-w(i-1,k,j))))
3850 end do
3851 k = ktf+1
3852 g_vel = (-(g_ru(i,k-2,j)*fzp(k-1)))+g_ru(i,k-1,j)*(2-fzm(k-1))
3853 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
3854 g_fqx(i,k) = g_vel*(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,k,j)-&
3855 &3.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))+g_w(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_w(i-1,k,j)*vel*&
3856 &(0.58333333+0.25*sign(1.,vel))+g_w(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_w(i,k,j)*vel*(0.58333333+(-0.25)&
3857 &*sign(1.,vel))
3858 fqx(i,k) = vel*(7./12.*(w(i,k,j)+w(i-1,k,j))-1./12.*(w(i+1,k,j)+w(i-2,k,j))+sign(1.,vel)*(1./12.)*(w(i+1,k,j)-w(i-2,k,j)-3.*&
3859 &(w(i,k,j)-w(i-1,k,j))))
3860 endif
3861 if (degrade_xe) then
3862 if (i_end .eq. ide-2) then
3863 i = ide-1
3864 do k = kts+1, ktf
3865 g_fqx(i,k) = 0.5*g_ru(i,k-1,j)*fzp(k)*(w(i,k,j)+w(i-1,k,j))+0.5*g_ru(i,k,j)*fzm(k)*(w(i,k,j)+w(i-1,k,j))+0.5*g_w(i-1,k,j)&
3866 &*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))+0.5*g_w(i,k,j)*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))
3867 fqx(i,k) = 0.5*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))*(w(i,k,j)+w(i-1,k,j))
3868 end do
3869 k = ktf+1
3870 g_fqx(i,k) = (-(0.5*g_ru(i,k-2,j)*fzp(k-1)*(w(i,k,j)+w(i-1,k,j))))+0.5*g_ru(i,k-1,j)*(2-fzm(k-1))*(w(i,k,j)+w(i-1,k,j))+&
3871 &0.5*g_w(i-1,k,j)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))+0.5*g_w(i,k,j)*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))
3872 fqx(i,k) = 0.5*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))*(w(i,k,j)+w(i-1,k,j))
3873 endif
3874 i = ide-2
3875 do k = kts+1, ktf
3876 g_vel = g_ru(i,k-1,j)*fzp(k)+g_ru(i,k,j)*fzm(k)
3877 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
3878 g_fqx(i,k) = g_vel*(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,k,j)&
3879 &-3.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))+g_w(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_w(i-1,k,j)*vel*&
3880 &(0.58333333+0.25*sign(1.,vel))+g_w(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_w(i,k,j)*vel*(0.58333333+(-&
3881 &0.25)*sign(1.,vel))
3882 fqx(i,k) = vel*(7./12.*(w(i,k,j)+w(i-1,k,j))-1./12.*(w(i+1,k,j)+w(i-2,k,j))+sign(1.,vel)*(1./12.)*(w(i+1,k,j)-w(i-2,k,j)-&
3883 &3.*(w(i,k,j)-w(i-1,k,j))))
3884 end do
3885 k = ktf+1
3886 g_vel = (-(g_ru(i,k-2,j)*fzp(k-1)))+g_ru(i,k-1,j)*(2-fzm(k-1))
3887 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
3888 g_fqx(i,k) = g_vel*(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,k,j)-&
3889 &3.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))+g_w(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_w(i-1,k,j)*vel*&
3890 &(0.58333333+0.25*sign(1.,vel))+g_w(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_w(i,k,j)*vel*(0.58333333+(-0.25)&
3891 &*sign(1.,vel))
3892 fqx(i,k) = vel*(7./12.*(w(i,k,j)+w(i-1,k,j))-1./12.*(w(i+1,k,j)+w(i-2,k,j))+sign(1.,vel)*(1./12.)*(w(i+1,k,j)-w(i-2,k,j)-3.*&
3893 &(w(i,k,j)-w(i-1,k,j))))
3894 endif
3895 do k = kts+1, ktf+1
3896 do i = i_start, i_end
3897 mrdx = msft(i,j)*rdx
3898 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
3899 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
3900 end do
3901 end do
3902 end do
3903 else if (horz_order .eq. 4) then horizontal_order_tesu
3904 degrade_xs = .true.
3905 degrade_xe = .true.
3906 degrade_ys = .true.
3907 degrade_ye = .true.
3908 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
3909 degrade_xs = .false.
3910 endif
3911 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
3912 degrade_xe = .false.
3913 endif
3914 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
3915 degrade_ys = .false.
3916 endif
3917 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
3918 degrade_ye = .false.
3919 endif
3920 ktf = min(kte,kde-1)
3921 i_start = its
3922 i_end = min(ite,ide-1)
3923 j_start = jts
3924 j_end = min(jte,jde-1)
3925 i_start_f = i_start
3926 i_end_f = i_end+1
3927 if (degrade_xs) then
3928 i_start = ids+1
3929 i_start_f = i_start+1
3930 endif
3931 if (degrade_xe) then
3932 i_end = ide-2
3933 i_end_f = ide-2
3934 endif
3935 do j = j_start, j_end
3936 do k = kts+1, ktf
3937 do i = i_start_f, i_end_f
3938 g_vel = g_ru(i,k-1,j)*fzp(k)+g_ru(i,k,j)*fzm(k)
3939 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
3940 g_fqx(i,k) = g_vel*(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*g_w(i-2,k,j)*vel+&
3941 &0.58333333*g_w(i-1,k,j)*vel-0.083333333*g_w(i+1,k,j)*vel+0.58333333*g_w(i,k,j)*vel
3942 fqx(i,k) = vel*(7./12.*(w(i,k,j)+w(i-1,k,j))-1./12.*(w(i+1,k,j)+w(i-2,k,j)))
3943 end do
3944 end do
3945 k = ktf+1
3946 do i = i_start_f, i_end_f
3947 g_vel = (-(g_ru(i,k-2,j)*fzp(k-1)))+g_ru(i,k-1,j)*(2-fzm(k-1))
3948 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
3949 g_fqx(i,k) = g_vel*(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*g_w(i-2,k,j)*vel+&
3950 &0.58333333*g_w(i-1,k,j)*vel-0.083333333*g_w(i+1,k,j)*vel+0.58333333*g_w(i,k,j)*vel
3951 fqx(i,k) = vel*(7./12.*(w(i,k,j)+w(i-1,k,j))-1./12.*(w(i+1,k,j)+w(i-2,k,j)))
3952 end do
3953 if (degrade_xs) then
3954 do k = kts+1, ktf
3955 g_fqx(i_start,k) = 0.5*g_ru(i_start,k-1,j)*fzp(k)*(w(i_start,k,j)+w(i_start-1,k,j))+0.5*g_ru(i_start,k,j)*fzm(k)*&
3956 &(w(i_start,k,j)+w(i_start-1,k,j))+0.5*g_w(i_start-1,k,j)*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))+0.5*&
3957 &g_w(i_start,k,j)*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))
3958 fqx(i_start,k) = 0.5*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))*(w(i_start,k,j)+w(i_start-1,k,j))
3959 end do
3960 k = ktf+1
3961 g_fqx(i_start,k) = (-(0.5*g_ru(i_start,k-2,j)*fzp(k-1)*(w(i_start,k,j)+w(i_start-1,k,j))))+0.5*g_ru(i_start,k-1,j)*(2-fzm(k-&
3962 &1))*(w(i_start,k,j)+w(i_start-1,k,j))+0.5*g_w(i_start-1,k,j)*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))+&
3963 &0.5*g_w(i_start,k,j)*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))
3964 fqx(i_start,k) = 0.5*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))*(w(i_start,k,j)+w(i_start-1,k,j))
3965 endif
3966 if (degrade_xe) then
3967 do k = kts+1, ktf
3968 g_fqx(i_end+1,k) = 0.5*g_ru(i_end+1,k-1,j)*fzp(k)*(w(i_end+1,k,j)+w(i_end,k,j))+0.5*g_ru(i_end+1,k,j)*fzm(k)*(w(i_end+1,k,&
3969 &j)+w(i_end,k,j))+0.5*g_w(i_end+1,k,j)*(fzm(k)*ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))+0.5*g_w(i_end,k,j)*(fzm(k)*&
3970 &ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))
3971 fqx(i_end+1,k) = 0.5*(fzm(k)*ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))*(w(i_end+1,k,j)+w(i_end,k,j))
3972 end do
3973 k = ktf+1
3974 g_fqx(i_end+1,k) = (-(0.5*g_ru(i_end+1,k-2,j)*fzp(k-1)*(w(i_end+1,k,j)+w(i_end,k,j))))+0.5*g_ru(i_end+1,k-1,j)*(2-fzm(k-1))*&
3975 &(w(i_end+1,k,j)+w(i_end,k,j))+0.5*g_w(i_end+1,k,j)*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))+0.5*&
3976 &g_w(i_end,k,j)*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))
3977 fqx(i_end+1,k) = 0.5*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))*(w(i_end+1,k,j)+w(i_end,k,j))
3978 endif
3979 do k = kts+1, ktf+1
3980 do i = i_start, i_end
3981 mrdx = msft(i,j)*rdx
3982 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
3983 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
3984 end do
3985 end do
3986 end do
3987 i_start = its
3988 i_end = min(ite,ide-1)
3989 j_start = jts
3990 j_end = min(jte,jde-1)
3991 j_start_f = j_start
3992 j_end_f = j_end+1
3993 if (degrade_ys) then
3994 j_start = jds+1
3995 j_start_f = j_start+1
3996 endif
3997 if (degrade_ye) then
3998 j_end = jde-2
3999 j_end_f = jde-2
4000 endif
4001 jp1 = 2
4002 jp0 = 1
4003 do j = j_start, j_end+1
4004 if (j .lt. j_start_f .and. degrade_ys) then
4005 do k = kts+1, ktf
4006 do i = i_start, i_end
4007 g_fqy(i,k,jp1) = 0.5*g_rv(i,k-1,j_start)*fzp(k)*(w(i,k,j_start)+w(i,k,j_start-1))+0.5*g_rv(i,k,j_start)*fzm(k)*(w(i,k,&
4008 &j_start)+w(i,k,j_start-1))+0.5*g_w(i,k,j_start-1)*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))+0.5*g_w(i,k,j_start)&
4009 &*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))
4010 fqy(i,k,jp1) = 0.5*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))*(w(i,k,j_start)+w(i,k,j_start-1))
4011 end do
4012 end do
4013 k = ktf+1
4014 do i = i_start, i_end
4015 g_fqy(i,k,jp1) = (-(0.5*g_rv(i,k-2,j_start)*fzp(k-1)*(w(i,k,j_start)+w(i,k,j_start-1))))+0.5*g_rv(i,k-1,j_start)*(2-fzm(k-&
4016 &1))*(w(i,k,j_start)+w(i,k,j_start-1))+0.5*g_w(i,k,j_start-1)*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))+&
4017 &0.5*g_w(i,k,j_start)*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))
4018 fqy(i,k,jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))*(w(i,k,j_start)+w(i,k,j_start-1))
4019 end do
4020 else if (j .gt. j_end_f .and. degrade_ye) then
4021 do k = kts+1, ktf
4022 do i = i_start, i_end
4023 g_fqy(i,k,jp1) = 0.5*g_rv(i,k-1,j_end+1)*fzp(k)*(w(i,k,j_end+1)+w(i,k,j_end))+0.5*g_rv(i,k,j_end+1)*fzm(k)*(w(i,k,j_end+&
4024 &1)+w(i,k,j_end))+0.5*g_w(i,k,j_end+1)*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))+0.5*g_w(i,k,j_end)*(fzm(k)*rv(i,&
4025 &k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))
4026 fqy(i,k,jp1) = 0.5*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))*(w(i,k,j_end+1)+w(i,k,j_end))
4027 end do
4028 end do
4029 k = ktf+1
4030 do i = i_start, i_end
4031 g_fqy(i,k,jp1) = (-(0.5*g_rv(i,k-2,j_end+1)*fzp(k-1)*(w(i,k,j_end+1)+w(i,k,j_end))))+0.5*g_rv(i,k-1,j_end+1)*(2-fzm(k-1))*&
4032 &(w(i,k,j_end+1)+w(i,k,j_end))+0.5*g_w(i,k,j_end+1)*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))+0.5*g_w(i,&
4033 &k,j_end)*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))
4034 fqy(i,k,jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))*(w(i,k,j_end+1)+w(i,k,j_end))
4035 end do
4036 else
4037 do k = kts+1, ktf
4038 do i = i_start, i_end
4039 g_vel = g_rv(i,k-1,j)*fzp(k)+g_rv(i,k,j)*fzm(k)
4040 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
4041 g_fqy(i,k,jp1) = g_vel*(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*g_w(i,k,j-2)*&
4042 &vel+0.58333333*g_w(i,k,j-1)*vel-0.083333333*g_w(i,k,j+1)*vel+0.58333333*g_w(i,k,j)*vel
4043 fqy(i,k,jp1) = vel*(7./12.*(w(i,k,j)+w(i,k,j-1))-1./12.*(w(i,k,j+1)+w(i,k,j-2)))
4044 end do
4045 end do
4046 k = ktf+1
4047 do i = i_start, i_end
4048 g_vel = (-(g_rv(i,k-2,j)*fzp(k-1)))+g_rv(i,k-1,j)*(2-fzm(k-1))
4049 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
4050 g_fqy(i,k,jp1) = g_vel*(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*g_w(i,k,j-2)*vel+&
4051 &0.58333333*g_w(i,k,j-1)*vel-0.083333333*g_w(i,k,j+1)*vel+0.58333333*g_w(i,k,j)*vel
4052 fqy(i,k,jp1) = vel*(7./12.*(w(i,k,j)+w(i,k,j-1))-1./12.*(w(i,k,j+1)+w(i,k,j-2)))
4053 end do
4054 endif
4055 if (j .gt. j_start) then
4056 do k = kts+1, ktf+1
4057 do i = i_start, i_end
4058 mrdy = msft(i,j-1)*rdy
4059 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
4060 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
4061 end do
4062 end do
4063 endif
4064 jtmp = jp1
4065 jp1 = jp0
4066 jp0 = jtmp
4067 end do
4068 else if (horz_order .eq. 3) then horizontal_order_tesu
4069 degrade_xs = .true.
4070 degrade_xe = .true.
4071 degrade_ys = .true.
4072 degrade_ye = .true.
4073 if (config_flags%periodic_x .or. config_flags%symmetric_xs .or. its .gt. ids+1) then
4074 degrade_xs = .false.
4075 endif
4076 if (config_flags%periodic_x .or. config_flags%symmetric_xe .or. ite .lt. ide-2) then
4077 degrade_xe = .false.
4078 endif
4079 if (config_flags%periodic_y .or. config_flags%symmetric_ys .or. jts .gt. jds+1) then
4080 degrade_ys = .false.
4081 endif
4082 if (config_flags%periodic_y .or. config_flags%symmetric_ye .or. jte .lt. jde-2) then
4083 degrade_ye = .false.
4084 endif
4085 ktf = min(kte,kde-1)
4086 i_start = its
4087 i_end = min(ite,ide-1)
4088 j_start = jts
4089 j_end = min(jte,jde-1)
4090 i_start_f = i_start
4091 i_end_f = i_end+1
4092 if (degrade_xs) then
4093 i_start = ids+1
4094 i_start_f = i_start+1
4095 endif
4096 if (degrade_xe) then
4097 i_end = ide-2
4098 i_end_f = ide-2
4099 endif
4100 do j = j_start, j_end
4101 do k = kts+1, ktf
4102 do i = i_start_f, i_end_f
4103 g_vel = g_ru(i,k-1,j)*fzp(k)+g_ru(i,k,j)*fzm(k)
4104 vel = fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j)
4105 g_fqx(i,k) = g_vel*(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,k,j)&
4106 &-3.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))+g_w(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_w(i-1,k,j)*vel*&
4107 &(0.58333333+0.25*sign(1.,vel))+g_w(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_w(i,k,j)*vel*(0.58333333+(-&
4108 &0.25)*sign(1.,vel))
4109 fqx(i,k) = vel*(7./12.*(w(i,k,j)+w(i-1,k,j))-1./12.*(w(i+1,k,j)+w(i-2,k,j))+sign(1.,vel)*(1./12.)*(w(i+1,k,j)-w(i-2,k,j)-&
4110 &3.*(w(i,k,j)-w(i-1,k,j))))
4111 end do
4112 end do
4113 k = ktf+1
4114 do i = i_start_f, i_end_f
4115 g_vel = (-(g_ru(i,k-2,j)*fzp(k-1)))+g_ru(i,k-1,j)*(2-fzm(k-1))
4116 vel = (2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)
4117 g_fqx(i,k) = g_vel*(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,k,j)-&
4118 &3.*(w(i,k,j)-w(i-1,k,j)))*sign(1.,vel))+g_w(i-2,k,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_w(i-1,k,j)*vel*&
4119 &(0.58333333+0.25*sign(1.,vel))+g_w(i+1,k,j)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_w(i,k,j)*vel*(0.58333333+(-0.25)&
4120 &*sign(1.,vel))
4121 fqx(i,k) = vel*(7./12.*(w(i,k,j)+w(i-1,k,j))-1./12.*(w(i+1,k,j)+w(i-2,k,j))+sign(1.,vel)*(1./12.)*(w(i+1,k,j)-w(i-2,k,j)-3.*&
4122 &(w(i,k,j)-w(i-1,k,j))))
4123 end do
4124 if (degrade_xs) then
4125 do k = kts+1, ktf
4126 g_fqx(i_start,k) = 0.5*g_ru(i_start,k-1,j)*fzp(k)*(w(i_start,k,j)+w(i_start-1,k,j))+0.5*g_ru(i_start,k,j)*fzm(k)*&
4127 &(w(i_start,k,j)+w(i_start-1,k,j))+0.5*g_w(i_start-1,k,j)*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))+0.5*&
4128 &g_w(i_start,k,j)*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))
4129 fqx(i_start,k) = 0.5*(fzm(k)*ru(i_start,k,j)+fzp(k)*ru(i_start,k-1,j))*(w(i_start,k,j)+w(i_start-1,k,j))
4130 end do
4131 k = ktf+1
4132 g_fqx(i_start,k) = (-(0.5*g_ru(i_start,k-2,j)*fzp(k-1)*(w(i_start,k,j)+w(i_start-1,k,j))))+0.5*g_ru(i_start,k-1,j)*(2-fzm(k-&
4133 &1))*(w(i_start,k,j)+w(i_start-1,k,j))+0.5*g_w(i_start-1,k,j)*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))+&
4134 &0.5*g_w(i_start,k,j)*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))
4135 fqx(i_start,k) = 0.5*((2.-fzm(k-1))*ru(i_start,k-1,j)-fzp(k-1)*ru(i_start,k-2,j))*(w(i_start,k,j)+w(i_start-1,k,j))
4136 endif
4137 if (degrade_xe) then
4138 do k = kts+1, ktf
4139 g_fqx(i_end+1,k) = 0.5*g_ru(i_end+1,k-1,j)*fzp(k)*(w(i_end+1,k,j)+w(i_end,k,j))+0.5*g_ru(i_end+1,k,j)*fzm(k)*(w(i_end+1,k,&
4140 &j)+w(i_end,k,j))+0.5*g_w(i_end+1,k,j)*(fzm(k)*ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))+0.5*g_w(i_end,k,j)*(fzm(k)*&
4141 &ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))
4142 fqx(i_end+1,k) = 0.5*(fzm(k)*ru(i_end+1,k,j)+fzp(k)*ru(i_end+1,k-1,j))*(w(i_end+1,k,j)+w(i_end,k,j))
4143 end do
4144 k = ktf+1
4145 g_fqx(i_end+1,k) = (-(0.5*g_ru(i_end+1,k-2,j)*fzp(k-1)*(w(i_end+1,k,j)+w(i_end,k,j))))+0.5*g_ru(i_end+1,k-1,j)*(2-fzm(k-1))*&
4146 &(w(i_end+1,k,j)+w(i_end,k,j))+0.5*g_w(i_end+1,k,j)*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))+0.5*&
4147 &g_w(i_end,k,j)*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))
4148 fqx(i_end+1,k) = 0.5*((2.-fzm(k-1))*ru(i_end+1,k-1,j)-fzp(k-1)*ru(i_end+1,k-2,j))*(w(i_end+1,k,j)+w(i_end,k,j))
4149 endif
4150 do k = kts+1, ktf+1
4151 do i = i_start, i_end
4152 mrdx = msft(i,j)*rdx
4153 g_tendency(i,k,j) = (-(g_fqx(i+1,k)*mrdx))+g_fqx(i,k)*mrdx+g_tendency(i,k,j)
4154 tendency(i,k,j) = tendency(i,k,j)-mrdx*(fqx(i+1,k)-fqx(i,k))
4155 end do
4156 end do
4157 end do
4158 i_start = its
4159 i_end = min(ite,ide-1)
4160 j_start = jts
4161 j_end = min(jte,jde-1)
4162 j_start_f = j_start
4163 j_end_f = j_end+1
4164 if (degrade_ys) then
4165 j_start = jds+1
4166 j_start_f = j_start+1
4167 endif
4168 if (degrade_ye) then
4169 j_end = jde-2
4170 j_end_f = jde-2
4171 endif
4172 jp1 = 2
4173 jp0 = 1
4174 do j = j_start, j_end+1
4175 if (j .lt. j_start_f .and. degrade_ys) then
4176 do k = kts+1, ktf
4177 do i = i_start, i_end
4178 g_fqy(i,k,jp1) = 0.5*g_rv(i,k-1,j_start)*fzp(k)*(w(i,k,j_start)+w(i,k,j_start-1))+0.5*g_rv(i,k,j_start)*fzm(k)*(w(i,k,&
4179 &j_start)+w(i,k,j_start-1))+0.5*g_w(i,k,j_start-1)*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))+0.5*g_w(i,k,j_start)&
4180 &*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))
4181 fqy(i,k,jp1) = 0.5*(fzm(k)*rv(i,k,j_start)+fzp(k)*rv(i,k-1,j_start))*(w(i,k,j_start)+w(i,k,j_start-1))
4182 end do
4183 end do
4184 k = ktf+1
4185 do i = i_start, i_end
4186 g_fqy(i,k,jp1) = (-(0.5*g_rv(i,k-2,j_start)*fzp(k-1)*(w(i,k,j_start)+w(i,k,j_start-1))))+0.5*g_rv(i,k-1,j_start)*(2-fzm(k-&
4187 &1))*(w(i,k,j_start)+w(i,k,j_start-1))+0.5*g_w(i,k,j_start-1)*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))+&
4188 &0.5*g_w(i,k,j_start)*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))
4189 fqy(i,k,jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j_start)-fzp(k-1)*rv(i,k-2,j_start))*(w(i,k,j_start)+w(i,k,j_start-1))
4190 end do
4191 else if (j .gt. j_end_f .and. degrade_ye) then
4192 do k = kts+1, ktf
4193 do i = i_start, i_end
4194 g_fqy(i,k,jp1) = 0.5*g_rv(i,k-1,j_end+1)*fzp(k)*(w(i,k,j_end+1)+w(i,k,j_end))+0.5*g_rv(i,k,j_end+1)*fzm(k)*(w(i,k,j_end+&
4195 &1)+w(i,k,j_end))+0.5*g_w(i,k,j_end+1)*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))+0.5*g_w(i,k,j_end)*(fzm(k)*rv(i,&
4196 &k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))
4197 fqy(i,k,jp1) = 0.5*(fzm(k)*rv(i,k,j_end+1)+fzp(k)*rv(i,k-1,j_end+1))*(w(i,k,j_end+1)+w(i,k,j_end))
4198 end do
4199 end do
4200 k = ktf+1
4201 do i = i_start, i_end
4202 g_fqy(i,k,jp1) = (-(0.5*g_rv(i,k-2,j_end+1)*fzp(k-1)*(w(i,k,j_end+1)+w(i,k,j_end))))+0.5*g_rv(i,k-1,j_end+1)*(2-fzm(k-1))*&
4203 &(w(i,k,j_end+1)+w(i,k,j_end))+0.5*g_w(i,k,j_end+1)*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))+0.5*g_w(i,&
4204 &k,j_end)*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))
4205 fqy(i,k,jp1) = 0.5*((2.-fzm(k-1))*rv(i,k-1,j_end+1)-fzp(k-1)*rv(i,k-2,j_end+1))*(w(i,k,j_end+1)+w(i,k,j_end))
4206 end do
4207 else
4208 do k = kts+1, ktf
4209 do i = i_start, i_end
4210 g_vel = g_rv(i,k-1,j)*fzp(k)+g_rv(i,k,j)*fzm(k)
4211 vel = fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j)
4212 g_fqy(i,k,jp1) = g_vel*(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)-w(i,&
4213 &k,j-2)-3.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))+g_w(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_w(i,k,j-&
4214 &1)*vel*(0.58333333+0.25*sign(1.,vel))+g_w(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_w(i,k,j)*vel*&
4215 &(0.58333333+(-0.25)*sign(1.,vel))
4216 fqy(i,k,jp1) = vel*(7./12.*(w(i,k,j)+w(i,k,j-1))-1./12.*(w(i,k,j+1)+w(i,k,j-2))+sign(1.,vel)*(1./12.)*(w(i,k,j+1)-w(i,k,&
4217 &j-2)-3.*(w(i,k,j)-w(i,k,j-1))))
4218 end do
4219 end do
4220 k = ktf+1
4221 do i = i_start, i_end
4222 g_vel = (-(g_rv(i,k-2,j)*fzp(k-1)))+g_rv(i,k-1,j)*(2-fzm(k-1))
4223 vel = (2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)
4224 g_fqy(i,k,jp1) = g_vel*(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)-w(i,k,&
4225 &j-2)-3.*(w(i,k,j)-w(i,k,j-1)))*sign(1.,vel))+g_w(i,k,j-2)*vel*((-0.083333333)+(-0.083333333)*sign(1.,vel))+g_w(i,k,j-1)*&
4226 &vel*(0.58333333+0.25*sign(1.,vel))+g_w(i,k,j+1)*vel*((-0.083333333)+0.083333333*sign(1.,vel))+g_w(i,k,j)*vel*(0.58333333+&
4227 &(-0.25)*sign(1.,vel))
4228 fqy(i,k,jp1) = vel*(7./12.*(w(i,k,j)+w(i,k,j-1))-1./12.*(w(i,k,j+1)+w(i,k,j-2))+sign(1.,vel)*(1./12.)*(w(i,k,j+1)-w(i,k,j-&
4229 &2)-3.*(w(i,k,j)-w(i,k,j-1))))
4230 end do
4231 endif
4232 if (j .gt. j_start) then
4233 do k = kts+1, ktf+1
4234 do i = i_start, i_end
4235 mrdy = msft(i,j-1)*rdy
4236 g_tendency(i,k,j-1) = g_fqy(i,k,jp0)*mrdy-g_fqy(i,k,jp1)*mrdy+g_tendency(i,k,j-1)
4237 tendency(i,k,j-1) = tendency(i,k,j-1)-mrdy*(fqy(i,k,jp1)-fqy(i,k,jp0))
4238 end do
4239 end do
4240 endif
4241 jtmp = jp1
4242 jp1 = jp0
4243 jp0 = jtmp
4244 end do
4245 else if (horz_order .eq. 2) then horizontal_order_tesu
4246 i_start = its
4247 i_end = min(ite,ide-1)
4248 j_start = jts
4249 j_end = min(jte,jde-1)
4250 if (config_flags%open_xs .or. specified) then
4251 i_start = max(ids+1,its)
4252 endif
4253 if (config_flags%open_xe .or. specified) then
4254 i_end = min(ide-2,ite)
4255 endif
4256 do j = j_start, j_end
4257 do k = kts+1, ktf
4258 do i = i_start, i_end
4259 mrdx = msft(i,j)*rdx
4260 g_tendency(i,k,j) = (-(0.5*g_ru(i+1,k-1,j)*mrdx*fzp(k)*(w(i+1,k,j)+w(i,k,j))))+0.5*g_ru(i,k-1,j)*mrdx*fzp(k)*(w(i,k,j)+w(i-&
4261 &1,k,j))-0.5*g_ru(i+1,k,j)*mrdx*fzm(k)*(w(i+1,k,j)+w(i,k,j))+0.5*g_ru(i,k,j)*mrdx*fzm(k)*(w(i,k,j)+w(i-1,k,j))+&
4262 &g_tendency(i,k,j)+0.5*g_w(i-1,k,j)*mrdx*(fzm(k)*ru(i,k,j)+fzp(k)*ru(i,k-1,j))-0.5*g_w(i+1,k,j)*mrdx*(fzm(k)*ru(i+1,k,j)+&
4263 &fzp(k)*ru(i+1,k-1,j))-0.5*g_w(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,k-1,j)))
4264 tendency(i,k,j) = tendency(i,k,j)-mrdx*0.5*((fzm(k)*ru(i+1,k,j)+fzp(k)*ru(i+1,k-1,j))*(w(i+1,k,j)+w(i,k,j))-(fzm(k)*ru(i,k,&
4265 &j)+fzp(k)*ru(i,k-1,j))*(w(i,k,j)+w(i-1,k,j)))
4266 end do
4267 end do
4268 k = ktf+1
4269 do i = i_start, i_end
4270 mrdx = msft(i,j)*rdx
4271 g_tendency(i,k,j) = 0.5*g_ru(i+1,k-2,j)*mrdx*fzp(k-1)*(w(i+1,k,j)+w(i,k,j))-0.5*g_ru(i,k-2,j)*mrdx*fzp(k-1)*(w(i,k,j)+w(i-1,&
4272 &k,j))-0.5*g_ru(i+1,k-1,j)*mrdx*(2-fzm(k-1))*(w(i+1,k,j)+w(i,k,j))+0.5*g_ru(i,k-1,j)*mrdx*(2-fzm(k-1))*(w(i,k,j)+w(i-1,k,j))+&
4273 &g_tendency(i,k,j)+0.5*g_w(i-1,k,j)*mrdx*((2.-fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))-0.5*g_w(i+1,k,j)*mrdx*((2.-fzm(k-1)&
4274 &)*ru(i+1,k-1,j)-fzp(k-1)*ru(i+1,k-2,j))-0.5*g_w(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-&
4275 &1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j)))
4276 tendency(i,k,j) = tendency(i,k,j)-mrdx*0.5*(((2.-fzm(k-1))*ru(i+1,k-1,j)-fzp(k-1)*ru(i+1,k-2,j))*(w(i+1,k,j)+w(i,k,j))-((2.-&
4277 &fzm(k-1))*ru(i,k-1,j)-fzp(k-1)*ru(i,k-2,j))*(w(i,k,j)+w(i-1,k,j)))
4278 end do
4279 end do
4280 i_start = its
4281 i_end = min(ite,ide-1)
4282 if (config_flags%open_ys .or. specified) then
4283 j_start = max(jds+1,jts)
4284 endif
4285 if (config_flags%open_ye .or. specified) then
4286 j_end = min(jde-2,jte)
4287 endif
4288 do j = j_start, j_end
4289 do k = kts+1, ktf
4290 do i = i_start, i_end
4291 mrdy = msft(i,j)*rdy
4292 g_tendency(i,k,j) = (-(0.5*g_rv(i,k-1,j+1)*mrdy*fzp(k)*(w(i,k,j+1)+w(i,k,j))))+0.5*g_rv(i,k-1,j)*mrdy*fzp(k)*(w(i,k,j)+w(i,&
4293 &k,j-1))-0.5*g_rv(i,k,j+1)*mrdy*fzm(k)*(w(i,k,j+1)+w(i,k,j))+0.5*g_rv(i,k,j)*mrdy*fzm(k)*(w(i,k,j)+w(i,k,j-1))+&
4294 &g_tendency(i,k,j)+0.5*g_w(i,k,j-1)*mrdy*(fzm(k)*rv(i,k,j)+fzp(k)*rv(i,k-1,j))-0.5*g_w(i,k,j+1)*mrdy*(fzm(k)*rv(i,k,j+1)+&
4295 &fzp(k)*rv(i,k-1,j+1))-0.5*g_w(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,k-1,j)))
4296 tendency(i,k,j) = tendency(i,k,j)-mrdy*0.5*((fzm(k)*rv(i,k,j+1)+fzp(k)*rv(i,k-1,j+1))*(w(i,k,j+1)+w(i,k,j))-(fzm(k)*rv(i,k,&
4297 &j)+fzp(k)*rv(i,k-1,j))*(w(i,k,j)+w(i,k,j-1)))
4298 end do
4299 end do
4300 k = ktf+1
4301 do i = i_start, i_end
4302 mrdy = msft(i,j)*rdy
4303 g_tendency(i,k,j) = 0.5*g_rv(i,k-2,j+1)*mrdy*fzp(k-1)*(w(i,k,j+1)+w(i,k,j))-0.5*g_rv(i,k-2,j)*mrdy*fzp(k-1)*(w(i,k,j)+w(i,k,&
4304 &j-1))-0.5*g_rv(i,k-1,j+1)*mrdy*(2-fzm(k-1))*(w(i,k,j+1)+w(i,k,j))+0.5*g_rv(i,k-1,j)*mrdy*(2-fzm(k-1))*(w(i,k,j)+w(i,k,j-1))+&
4305 &g_tendency(i,k,j)+0.5*g_w(i,k,j-1)*mrdy*((2.-fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))-0.5*g_w(i,k,j+1)*mrdy*((2.-fzm(k-1)&
4306 &)*rv(i,k-1,j+1)-fzp(k-1)*rv(i,k-2,j+1))-0.5*g_w(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-&
4307 &1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j)))
4308 tendency(i,k,j) = tendency(i,k,j)-mrdy*0.5*(((2.-fzm(k-1))*rv(i,k-1,j+1)-fzp(k-1)*rv(i,k-2,j+1))*(w(i,k,j+1)+w(i,k,j))-((2.-&
4309 &fzm(k-1))*rv(i,k-1,j)-fzp(k-1)*rv(i,k-2,j))*(w(i,k,j)+w(i,k,j-1)))
4310 end do
4311 end do
4312 else horizontal_order_tesu
4313 write(unit=wrf_err_message,fmt=*) ' advect_w_6a, h_order not known ',horz_order
4314 endif horizontal_order_tesu
4315 i_start = its
4316 i_end = min(ite,ide-1)
4317 j_start = jts
4318 j_end = min(jte,jde-1)
4319 if (config_flags%open_xs .and. its .eq. ids) then
4320 do j = j_start, j_end
4321 do k = kts+1, ktf
4322 g_uw = 0.5*g_ru(its+1,k-1,j)*fzp(k)+0.5*g_ru(its,k-1,j)*fzp(k)+0.5*g_ru(its+1,k,j)*fzm(k)+0.5*g_ru(its,k,j)*fzm(k)
4323 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)))
4324 g_ub = g_uw*(0.5+sign(0.5,0.-uw))
4325 ub = min(uw,0.)
4326 g_tendency(its,k,j) = (-(g_ru(its+1,k-1,j)*rdx*w(its,k,j)*fzp(k)))+g_ru(its,k-1,j)*rdx*w(its,k,j)*fzp(k)-g_ru(its+1,k,j)*rdx*&
4327 &w(its,k,j)*fzm(k)+g_ru(its,k,j)*rdx*w(its,k,j)*fzm(k)+g_tendency(its,k,j)-g_ub*rdx*(w_old(its+1,k,j)-w_old(its,k,j))-&
4328 &g_w(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)))-g_w_old(its+1,k,j)*rdx*ub+&
4329 &g_w_old(its,k,j)*rdx*ub
4330 tendency(its,k,j) = tendency(its,k,j)-rdx*(ub*(w_old(its+1,k,j)-w_old(its,k,j))+w(its,k,j)*(fzm(k)*(ru(its+1,k,j)-ru(its,k,j)&
4331 &)+fzp(k)*(ru(its+1,k-1,j)-ru(its,k-1,j))))
4332 end do
4333 end do
4334 k = ktf+1
4335 do j = j_start, j_end
4336 g_uw = (-(0.5*g_ru(its+1,k-2,j)*fzp(k-1)))-0.5*g_ru(its,k-2,j)*fzp(k-1)+0.5*g_ru(its+1,k-1,j)*(2-fzm(k-1))+0.5*g_ru(its,k-1,j)*&
4337 &(2-fzm(k-1))
4338 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)))
4339 g_ub = g_uw*(0.5+sign(0.5,0.-uw))
4340 ub = min(uw,0.)
4341 g_tendency(its,k,j) = g_ru(its+1,k-2,j)*rdx*w(its,k,j)*fzp(k-1)-g_ru(its,k-2,j)*rdx*w(its,k,j)*fzp(k-1)-g_ru(its+1,k-1,j)*rdx*&
4342 &w(its,k,j)*(2-fzm(k-1))+g_ru(its,k-1,j)*rdx*w(its,k,j)*(2.-fzm(k-1))+g_tendency(its,k,j)-g_ub*rdx*(w_old(its+1,k,j)-w_old(its,&
4343 &k,j))-g_w(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)-ru(its,k-2,j)))-g_w_old(its+1,&
4344 &k,j)*rdx*ub+g_w_old(its,k,j)*rdx*ub
4345 tendency(its,k,j) = tendency(its,k,j)-rdx*(ub*(w_old(its+1,k,j)-w_old(its,k,j))+w(its,k,j)*((2.-fzm(k-1))*(ru(its+1,k-1,j)-&
4346 &ru(its,k-1,j))-fzp(k-1)*(ru(its+1,k-2,j)-ru(its,k-2,j))))
4347 end do
4348 endif
4349 if (config_flags%open_xe .and. ite .eq. ide) then
4350 do j = j_start, j_end
4351 do k = kts+1, ktf
4352 g_uw = 0.5*g_ru(ite-1,k-1,j)*fzp(k)+0.5*g_ru(ite,k-1,j)*fzp(k)+0.5*g_ru(ite-1,k,j)*fzm(k)+0.5*g_ru(ite,k,j)*fzm(k)
4353 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)))
4354 g_ub = g_uw*(0.5+sign(0.5,uw-0.))
4355 ub = max(uw,0.)
4356 g_tendency(i_end,k,j) = g_ru(ite-1,k-1,j)*rdx*w(i_end,k,j)*fzp(k)-g_ru(ite,k-1,j)*rdx*w(i_end,k,j)*fzp(k)+g_ru(ite-1,k,j)*&
4357 &rdx*w(i_end,k,j)*fzm(k)-g_ru(ite,k,j)*rdx*w(i_end,k,j)*fzm(k)+g_tendency(i_end,k,j)-g_ub*rdx*(w_old(i_end,k,j)-w_old(i_end-&
4358 &1,k,j))-g_w(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,k-1,j)))+g_w_old(i_end-1,k,j)*&
4359 &rdx*ub-g_w_old(i_end,k,j)*rdx*ub
4360 tendency(i_end,k,j) = tendency(i_end,k,j)-rdx*(ub*(w_old(i_end,k,j)-w_old(i_end-1,k,j))+w(i_end,k,j)*(fzm(k)*(ru(ite,k,j)-&
4361 &ru(ite-1,k,j))+fzp(k)*(ru(ite,k-1,j)-ru(ite-1,k-1,j))))
4362 end do
4363 end do
4364 k = ktf+1
4365 do j = j_start, j_end
4366 g_uw = (-(0.5*g_ru(ite-1,k-2,j)*fzp(k-1)))-0.5*g_ru(ite,k-2,j)*fzp(k-1)+0.5*g_ru(ite-1,k-1,j)*(2-fzm(k-1))+0.5*g_ru(ite,k-1,j)*&
4367 &(2-fzm(k-1))
4368 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)))
4369 g_ub = g_uw*(0.5+sign(0.5,uw-0.))
4370 ub = max(uw,0.)
4371 g_tendency(i_end,k,j) = (-(g_ru(ite-1,k-2,j)*rdx*w(i_end,k,j)*fzp(k-1)))+g_ru(ite,k-2,j)*rdx*w(i_end,k,j)*fzp(k-1)+g_ru(ite-1,&
4372 &k-1,j)*rdx*w(i_end,k,j)*(2.-fzm(k-1))-g_ru(ite,k-1,j)*rdx*w(i_end,k,j)*(2-fzm(k-1))+g_tendency(i_end,k,j)-g_ub*rdx*&
4373 &(w_old(i_end,k,j)-w_old(i_end-1,k,j))-g_w(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,&
4374 &j)-ru(ite-1,k-2,j)))+g_w_old(i_end-1,k,j)*rdx*ub-g_w_old(i_end,k,j)*rdx*ub
4375 tendency(i_end,k,j) = tendency(i_end,k,j)-rdx*(ub*(w_old(i_end,k,j)-w_old(i_end-1,k,j))+w(i_end,k,j)*((2.-fzm(k-1))*(ru(ite,k-&
4376 &1,j)-ru(ite-1,k-1,j))-fzp(k-1)*(ru(ite,k-2,j)-ru(ite-1,k-2,j))))
4377 end do
4378 endif
4379 if (config_flags%open_ys .and. jts .eq. jds) then
4380 do i = i_start, i_end
4381 do k = kts+1, ktf
4382 g_vw = 0.5*g_rv(i,k-1,jts+1)*fzp(k)+0.5*g_rv(i,k-1,jts)*fzp(k)+0.5*g_rv(i,k,jts+1)*fzm(k)+0.5*g_rv(i,k,jts)*fzm(k)
4383 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)))
4384 g_vb = g_vw*(0.5+sign(0.5,0.-vw))
4385 vb = min(vw,0.)
4386 g_tendency(i,k,jts) = (-(g_rv(i,k-1,jts+1)*rdy*w(i,k,jts)*fzp(k)))+g_rv(i,k-1,jts)*rdy*w(i,k,jts)*fzp(k)-g_rv(i,k,jts+1)*rdy*&
4387 &w(i,k,jts)*fzm(k)+g_rv(i,k,jts)*rdy*w(i,k,jts)*fzm(k)+g_tendency(i,k,jts)-g_vb*rdy*(w_old(i,k,jts+1)-w_old(i,k,jts))-g_w(i,&
4388 &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)))-g_w_old(i,k,jts+1)*rdy*vb+g_w_old(i,&
4389 &k,jts)*rdy*vb
4390 tendency(i,k,jts) = tendency(i,k,jts)-rdy*(vb*(w_old(i,k,jts+1)-w_old(i,k,jts))+w(i,k,jts)*(fzm(k)*(rv(i,k,jts+1)-rv(i,k,jts)&
4391 &)+fzp(k)*(rv(i,k-1,jts+1)-rv(i,k-1,jts))))
4392 end do
4393 end do
4394 k = ktf+1
4395 do i = i_start, i_end
4396 g_vw = (-(0.5*g_rv(i,k-2,jts+1)*fzp(k-1)))-0.5*g_rv(i,k-2,jts)*fzp(k-1)+0.5*g_rv(i,k-1,jts+1)*(2-fzm(k-1))+0.5*g_rv(i,k-1,jts)*&
4397 &(2-fzm(k-1))
4398 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)))
4399 g_vb = g_vw*(0.5+sign(0.5,0.-vw))
4400 vb = min(vw,0.)
4401 g_tendency(i,k,jts) = g_rv(i,k-2,jts+1)*rdy*w(i,k,jts)*fzp(k-1)-g_rv(i,k-2,jts)*rdy*w(i,k,jts)*fzp(k-1)-g_rv(i,k-1,jts+1)*rdy*&
4402 &w(i,k,jts)*(2-fzm(k-1))+g_rv(i,k-1,jts)*rdy*w(i,k,jts)*(2.-fzm(k-1))+g_tendency(i,k,jts)-g_vb*rdy*(w_old(i,k,jts+1)-w_old(i,k,&
4403 &jts))-g_w(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)-rv(i,k-2,jts)))-g_w_old(i,k,&
4404 &jts+1)*rdy*vb+g_w_old(i,k,jts)*rdy*vb
4405 tendency(i,k,jts) = tendency(i,k,jts)-rdy*(vb*(w_old(i,k,jts+1)-w_old(i,k,jts))+w(i,k,jts)*((2.-fzm(k-1))*(rv(i,k-1,jts+1)-&
4406 &rv(i,k-1,jts))-fzp(k-1)*(rv(i,k-2,jts+1)-rv(i,k-2,jts))))
4407 end do
4408 endif
4409 if (config_flags%open_ye .and. jte .eq. jde) then
4410 do i = i_start, i_end
4411 do k = kts+1, ktf
4412 g_vw = 0.5*g_rv(i,k-1,jte-1)*fzp(k)+0.5*g_rv(i,k-1,jte)*fzp(k)+0.5*g_rv(i,k,jte-1)*fzm(k)+0.5*g_rv(i,k,jte)*fzm(k)
4413 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)))
4414 g_vb = g_vw*(0.5+sign(0.5,vw-0.))
4415 vb = max(vw,0.)
4416 g_tendency(i,k,j_end) = g_rv(i,k-1,jte-1)*rdy*w(i,k,j_end)*fzp(k)-g_rv(i,k-1,jte)*rdy*w(i,k,j_end)*fzp(k)+g_rv(i,k,jte-1)*&
4417 &rdy*w(i,k,j_end)*fzm(k)-g_rv(i,k,jte)*rdy*w(i,k,j_end)*fzm(k)+g_tendency(i,k,j_end)-g_vb*rdy*(w_old(i,k,j_end)-w_old(i,k,&
4418 &j_end-1))-g_w(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,jte-1)))+g_w_old(i,k,j_end-&
4419 &1)*rdy*vb-g_w_old(i,k,j_end)*rdy*vb
4420 tendency(i,k,j_end) = tendency(i,k,j_end)-rdy*(vb*(w_old(i,k,j_end)-w_old(i,k,j_end-1))+w(i,k,j_end)*(fzm(k)*(rv(i,k,jte)-&
4421 &rv(i,k,jte-1))+fzp(k)*(rv(i,k-1,jte)-rv(i,k-1,jte-1))))
4422 end do
4423 end do
4424 k = ktf+1
4425 do i = i_start, i_end
4426 g_vw = (-(0.5*g_rv(i,k-2,jte-1)*fzp(k-1)))-0.5*g_rv(i,k-2,jte)*fzp(k-1)+0.5*g_rv(i,k-1,jte-1)*(2-fzm(k-1))+0.5*g_rv(i,k-1,jte)*&
4427 &(2-fzm(k-1))
4428 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)))
4429 g_vb = g_vw*(0.5+sign(0.5,vw-0.))
4430 vb = max(vw,0.)
4431 g_tendency(i,k,j_end) = (-(g_rv(i,k-2,jte-1)*rdy*w(i,k,j_end)*fzp(k-1)))+g_rv(i,k-2,jte)*rdy*w(i,k,j_end)*fzp(k-1)+g_rv(i,k-1,&
4432 &jte-1)*rdy*w(i,k,j_end)*(2.-fzm(k-1))-g_rv(i,k-1,jte)*rdy*w(i,k,j_end)*(2-fzm(k-1))+g_tendency(i,k,j_end)-g_vb*rdy*(w_old(i,k,&
4433 &j_end)-w_old(i,k,j_end-1))-g_w(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,jte)-rv(i,k-2,&
4434 &jte-1)))+g_w_old(i,k,j_end-1)*rdy*vb-g_w_old(i,k,j_end)*rdy*vb
4435 tendency(i,k,j_end) = tendency(i,k,j_end)-rdy*(vb*(w_old(i,k,j_end)-w_old(i,k,j_end-1))+w(i,k,j_end)*((2.-fzm(k-1))*(rv(i,k-1,&
4436 &jte)-rv(i,k-1,jte-1))-fzp(k-1)*(rv(i,k-2,jte)-rv(i,k-2,jte-1))))
4437 end do
4438 endif
4439 i_start = its
4440 i_end = min(ite,ide-1)
4441 j_start = jts
4442 j_end = min(jte,jde-1)
4443 do i = i_start, i_end
4444 g_vflux(i,kts) = 0.
4445 vflux(i,kts) = 0.
4446 g_vflux(i,kte) = 0.
4447 vflux(i,kte) = 0.
4448 end do
4449 vert_order_tesu: if (vert_order .eq. 6) then
4450 do j = j_start, j_end
4451 do k = kts+3, ktf-1
4452 do i = i_start, i_end
4453 g_vel = 0.5*g_rom(i,k-1,j)+0.5*g_rom(i,k,j)
4454 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
4455 g_vflux(i,k) = g_vel*(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)+w(i,k-3,&
4456 &j)))+0.016666667*g_w(i,k-3,j)*vel-0.13333333*g_w(i,k-2,j)*vel+0.61666667*g_w(i,k-1,j)*vel+0.016666667*g_w(i,k+2,j)*vel-&
4457 &0.13333333*g_w(i,k+1,j)*vel+0.61666667*g_w(i,k,j)*vel
4458 vflux(i,k) = vel*(37./60.*(w(i,k,j)+w(i,k-1,j))-2./15.*(w(i,k+1,j)+w(i,k-2,j))+1./60.*(w(i,k+2,j)+w(i,k-3,j)))
4459 end do
4460 end do
4461 do i = i_start, i_end
4462 k = kts+1
4463 g_vflux(i,k) = 0.25*g_rom(i,k-1,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_rom(i,k,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_w(i,k-1,j)*(rom(i,k,&
4464 &j)+rom(i,k-1,j))+0.25*g_w(i,k,j)*(rom(i,k,j)+rom(i,k-1,j))
4465 vflux(i,k) = 0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
4466 k = kts+2
4467 g_vel = 0.5*g_rom(i,k-1,j)+0.5*g_rom(i,k,j)
4468 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
4469 g_vflux(i,k) = g_vel*(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*g_w(i,k-2,j)*vel+&
4470 &0.58333333*g_w(i,k-1,j)*vel-0.083333333*g_w(i,k+1,j)*vel+0.58333333*g_w(i,k,j)*vel
4471 vflux(i,k) = vel*(7./12.*(w(i,k,j)+w(i,k-1,j))-1./12.*(w(i,k+1,j)+w(i,k-2,j)))
4472 k = ktf
4473 g_vel = 0.5*g_rom(i,k-1,j)+0.5*g_rom(i,k,j)
4474 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
4475 g_vflux(i,k) = g_vel*(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*g_w(i,k-2,j)*vel+&
4476 &0.58333333*g_w(i,k-1,j)*vel-0.083333333*g_w(i,k+1,j)*vel+0.58333333*g_w(i,k,j)*vel
4477 vflux(i,k) = vel*(7./12.*(w(i,k,j)+w(i,k-1,j))-1./12.*(w(i,k+1,j)+w(i,k-2,j)))
4478 k = ktf+1
4479 g_vflux(i,k) = 0.25*g_rom(i,k-1,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_rom(i,k,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_w(i,k-1,j)*(rom(i,k,&
4480 &j)+rom(i,k-1,j))+0.25*g_w(i,k,j)*(rom(i,k,j)+rom(i,k-1,j))
4481 vflux(i,k) = 0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
4482 end do
4483 do k = kts+1, ktf
4484 do i = i_start, i_end
4485 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzu(k)+g_vflux(i,k)*rdzu(k)
4486 tendency(i,k,j) = tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
4487 end do
4488 end do
4489 k = ktf+1
4490 do i = i_start, i_end
4491 g_tendency(i,k,j) = g_tendency(i,k,j)+2*g_vflux(i,k)*rdzu(k-1)
4492 tendency(i,k,j) = tendency(i,k,j)+2.*rdzu(k-1)*vflux(i,k)
4493 end do
4494 end do
4495 else if (vert_order .eq. 5) then vert_order_tesu
4496 do j = j_start, j_end
4497 do k = kts+3, ktf-1
4498 do i = i_start, i_end
4499 g_vel = 0.5*g_rom(i,k-1,j)+0.5*g_rom(i,k,j)
4500 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
4501 g_vflux(i,k) = g_vel*(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)+w(i,k-3,&
4502 &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))+g_w(i,k-3,j)*&
4503 &vel*(0.016666667-(-0.016666667)*sign(1.,-vel))+g_w(i,k-2,j)*vel*((-0.13333333)-0.083333333*sign(1.,-vel))+g_w(i,k-1,j)*&
4504 &vel*(0.61666667-(-0.16666667)*sign(1.,-vel))+g_w(i,k+2,j)*vel*(0.016666667-0.016666667*sign(1.,-vel))+g_w(i,k+1,j)*vel*((-&
4505 &0.13333333)-(-0.083333333)*sign(1.,-vel))+g_w(i,k,j)*vel*(0.61666667-0.16666667*sign(1.,-vel))
4506 vflux(i,k) = vel*(37./60.*(w(i,k,j)+w(i,k-1,j))-2./15.*(w(i,k+1,j)+w(i,k-2,j))+1./60.*(w(i,k+2,j)+w(i,k-3,j))-sign(1.,-vel)&
4507 &*(1./60.)*(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))))
4508 end do
4509 end do
4510 do i = i_start, i_end
4511 k = kts+1
4512 g_vflux(i,k) = 0.25*g_rom(i,k-1,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_rom(i,k,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_w(i,k-1,j)*(rom(i,k,&
4513 &j)+rom(i,k-1,j))+0.25*g_w(i,k,j)*(rom(i,k,j)+rom(i,k-1,j))
4514 vflux(i,k) = 0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
4515 k = kts+2
4516 g_vel = 0.5*g_rom(i,k-1,j)+0.5*g_rom(i,k,j)
4517 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
4518 g_vflux(i,k) = g_vel*(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,k-2,j)&
4519 &-3.*(w(i,k,j)-w(i,k-1,j)))*sign(1.,-vel))+g_w(i,k-2,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))+g_w(i,k-1,j)*vel*&
4520 &(0.58333333+0.25*sign(1.,-vel))+g_w(i,k+1,j)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))+g_w(i,k,j)*vel*(0.58333333+(-&
4521 &0.25)*sign(1.,-vel))
4522 vflux(i,k) = vel*(7./12.*(w(i,k,j)+w(i,k-1,j))-1./12.*(w(i,k+1,j)+w(i,k-2,j))+sign(1.,-vel)*(1./12.)*(w(i,k+1,j)-w(i,k-2,j)-&
4523 &3.*(w(i,k,j)-w(i,k-1,j))))
4524 k = ktf
4525 g_vel = 0.5*g_rom(i,k-1,j)+0.5*g_rom(i,k,j)
4526 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
4527 g_vflux(i,k) = g_vel*(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,k-2,j)&
4528 &-3.*(w(i,k,j)-w(i,k-1,j)))*sign(1.,-vel))+g_w(i,k-2,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))+g_w(i,k-1,j)*vel*&
4529 &(0.58333333+0.25*sign(1.,-vel))+g_w(i,k+1,j)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))+g_w(i,k,j)*vel*(0.58333333+(-&
4530 &0.25)*sign(1.,-vel))
4531 vflux(i,k) = vel*(7./12.*(w(i,k,j)+w(i,k-1,j))-1./12.*(w(i,k+1,j)+w(i,k-2,j))+sign(1.,-vel)*(1./12.)*(w(i,k+1,j)-w(i,k-2,j)-&
4532 &3.*(w(i,k,j)-w(i,k-1,j))))
4533 k = ktf+1
4534 g_vflux(i,k) = 0.25*g_rom(i,k-1,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_rom(i,k,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_w(i,k-1,j)*(rom(i,k,&
4535 &j)+rom(i,k-1,j))+0.25*g_w(i,k,j)*(rom(i,k,j)+rom(i,k-1,j))
4536 vflux(i,k) = 0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
4537 end do
4538 do k = kts+1, ktf
4539 do i = i_start, i_end
4540 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzu(k)+g_vflux(i,k)*rdzu(k)
4541 tendency(i,k,j) = tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
4542 end do
4543 end do
4544 k = ktf+1
4545 do i = i_start, i_end
4546 g_tendency(i,k,j) = g_tendency(i,k,j)+2*g_vflux(i,k)*rdzu(k-1)
4547 tendency(i,k,j) = tendency(i,k,j)+2.*rdzu(k-1)*vflux(i,k)
4548 end do
4549 end do
4550 else if (vert_order .eq. 4) then vert_order_tesu
4551 do j = j_start, j_end
4552 do k = kts+2, ktf
4553 do i = i_start, i_end
4554 g_vel = 0.5*g_rom(i,k-1,j)+0.5*g_rom(i,k,j)
4555 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
4556 g_vflux(i,k) = g_vel*(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*g_w(i,k-2,j)*vel+&
4557 &0.58333333*g_w(i,k-1,j)*vel-0.083333333*g_w(i,k+1,j)*vel+0.58333333*g_w(i,k,j)*vel
4558 vflux(i,k) = vel*(7./12.*(w(i,k,j)+w(i,k-1,j))-1./12.*(w(i,k+1,j)+w(i,k-2,j)))
4559 end do
4560 end do
4561 do i = i_start, i_end
4562 k = kts+1
4563 g_vflux(i,k) = 0.25*g_rom(i,k-1,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_rom(i,k,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_w(i,k-1,j)*(rom(i,k,&
4564 &j)+rom(i,k-1,j))+0.25*g_w(i,k,j)*(rom(i,k,j)+rom(i,k-1,j))
4565 vflux(i,k) = 0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
4566 k = ktf+1
4567 g_vflux(i,k) = 0.25*g_rom(i,k-1,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_rom(i,k,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_w(i,k-1,j)*(rom(i,k,&
4568 &j)+rom(i,k-1,j))+0.25*g_w(i,k,j)*(rom(i,k,j)+rom(i,k-1,j))
4569 vflux(i,k) = 0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
4570 end do
4571 do k = kts+1, ktf
4572 do i = i_start, i_end
4573 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzu(k)+g_vflux(i,k)*rdzu(k)
4574 tendency(i,k,j) = tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
4575 end do
4576 end do
4577 k = ktf+1
4578 do i = i_start, i_end
4579 g_tendency(i,k,j) = g_tendency(i,k,j)+2*g_vflux(i,k)*rdzu(k-1)
4580 tendency(i,k,j) = tendency(i,k,j)+2.*rdzu(k-1)*vflux(i,k)
4581 end do
4582 end do
4583 else if (vert_order .eq. 3) then vert_order_tesu
4584 do j = j_start, j_end
4585 do k = kts+2, ktf
4586 do i = i_start, i_end
4587 g_vel = 0.5*g_rom(i,k-1,j)+0.5*g_rom(i,k,j)
4588 vel = 0.5*(rom(i,k,j)+rom(i,k-1,j))
4589 g_vflux(i,k) = g_vel*(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,k-2,&
4590 &j)-3.*(w(i,k,j)-w(i,k-1,j)))*sign(1.,-vel))+g_w(i,k-2,j)*vel*((-0.083333333)+(-0.083333333)*sign(1.,-vel))+g_w(i,k-1,j)*&
4591 &vel*(0.58333333+0.25*sign(1.,-vel))+g_w(i,k+1,j)*vel*((-0.083333333)+0.083333333*sign(1.,-vel))+g_w(i,k,j)*vel*&
4592 &(0.58333333+(-0.25)*sign(1.,-vel))
4593 vflux(i,k) = vel*(7./12.*(w(i,k,j)+w(i,k-1,j))-1./12.*(w(i,k+1,j)+w(i,k-2,j))+sign(1.,-vel)*(1./12.)*(w(i,k+1,j)-w(i,k-2,j)&
4594 &-3.*(w(i,k,j)-w(i,k-1,j))))
4595 end do
4596 end do
4597 do i = i_start, i_end
4598 k = kts+1
4599 g_vflux(i,k) = 0.25*g_rom(i,k-1,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_rom(i,k,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_w(i,k-1,j)*(rom(i,k,&
4600 &j)+rom(i,k-1,j))+0.25*g_w(i,k,j)*(rom(i,k,j)+rom(i,k-1,j))
4601 vflux(i,k) = 0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
4602 k = ktf+1
4603 g_vflux(i,k) = 0.25*g_rom(i,k-1,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_rom(i,k,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_w(i,k-1,j)*(rom(i,k,&
4604 &j)+rom(i,k-1,j))+0.25*g_w(i,k,j)*(rom(i,k,j)+rom(i,k-1,j))
4605 vflux(i,k) = 0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
4606 end do
4607 do k = kts+1, ktf
4608 do i = i_start, i_end
4609 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzu(k)+g_vflux(i,k)*rdzu(k)
4610 tendency(i,k,j) = tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
4611 end do
4612 end do
4613 k = ktf+1
4614 do i = i_start, i_end
4615 g_tendency(i,k,j) = g_tendency(i,k,j)+2*g_vflux(i,k)*rdzu(k-1)
4616 tendency(i,k,j) = tendency(i,k,j)+2.*rdzu(k-1)*vflux(i,k)
4617 end do
4618 end do
4619 else if (vert_order .eq. 2) then vert_order_tesu
4620 do j = j_start, j_end
4621 do k = kts+1, ktf+1
4622 do i = i_start, i_end
4623 g_vflux(i,k) = 0.25*g_rom(i,k-1,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_rom(i,k,j)*(w(i,k,j)+w(i,k-1,j))+0.25*g_w(i,k-1,j)*(rom(i,&
4624 &k,j)+rom(i,k-1,j))+0.25*g_w(i,k,j)*(rom(i,k,j)+rom(i,k-1,j))
4625 vflux(i,k) = 0.25*(rom(i,k,j)+rom(i,k-1,j))*(w(i,k,j)+w(i,k-1,j))
4626 end do
4627 end do
4628 do k = kts+1, ktf
4629 do i = i_start, i_end
4630 g_tendency(i,k,j) = g_tendency(i,k,j)-g_vflux(i,k+1)*rdzu(k)+g_vflux(i,k)*rdzu(k)
4631 tendency(i,k,j) = tendency(i,k,j)-rdzu(k)*(vflux(i,k+1)-vflux(i,k))
4632 end do
4633 end do
4634 k = ktf+1
4635 do i = i_start, i_end
4636 g_tendency(i,k,j) = g_tendency(i,k,j)+2*g_vflux(i,k)*rdzu(k-1)
4637 tendency(i,k,j) = tendency(i,k,j)+2.*rdzu(k-1)*vflux(i,k)
4638 end do
4639 end do
4640 endif vert_order_tesu
4641
4642 end subroutine g_advect_w
4643
4644
4645 end module g_module_advect_em
4646
4647