module_big_step_utilities_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_big_step_utilities_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_domain
34 use module_model_constants
35 use module_state_description
36 use module_configure
37 use module_big_step_utilities_em
38
39 !==============================================
40 ! all entries are defined explicitly
41 !==============================================
42 implicit none
43
44 contains
45 subroutine g_calc_alt( alt, g_alt, al, g_al, alb, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
46 !******************************************************************
47 !******************************************************************
48 !** This routine was generated by Automatic differentiation. **
49 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
50 !******************************************************************
51 !******************************************************************
52 !==============================================
53 ! all entries are defined explicitly
54 !==============================================
55 implicit none
56
57 !==============================================
58 ! declare arguments
59 !==============================================
60 integer, intent(in) :: ime
61 integer, intent(in) :: ims
62 integer, intent(in) :: jme
63 integer, intent(in) :: jms
64 integer, intent(in) :: kme
65 integer, intent(in) :: kms
66 real, intent(in) :: al(ims:ime,kms:kme,jms:jme)
67 real, intent(in) :: alb(ims:ime,kms:kme,jms:jme)
68 real, intent(out) :: alt(ims:ime,kms:kme,jms:jme)
69 real, intent(in) :: g_al(ims:ime,kms:kme,jms:jme)
70 real, intent(out) :: g_alt(ims:ime,kms:kme,jms:jme)
71 integer, intent(in) :: ide
72 integer, intent(in) :: ite
73 integer, intent(in) :: its
74 integer, intent(in) :: jde
75 integer, intent(in) :: jte
76 integer, intent(in) :: jts
77 integer, intent(in) :: kde
78 integer, intent(in) :: kte
79 integer, intent(in) :: kts
80
81 !==============================================
82 ! declare local variables
83 !==============================================
84 integer i
85 integer itf
86 integer j
87 integer jtf
88 integer k
89 integer ktf
90
91 !----------------------------------------------
92 ! TANGENT LINEAR AND FUNCTION STATEMENTS
93 !----------------------------------------------
94 itf = min(ite,ide-1)
95 jtf = min(jte,jde-1)
96 ktf = min(kte,kde-1)
97 do j = jts, jtf
98 do k = kts, ktf
99 do i = its, itf
100 g_alt(i,k,j) = g_al(i,k,j)
101 alt(i,k,j) = al(i,k,j)+alb(i,k,j)
102 end do
103 end do
104 end do
105
106 end subroutine g_calc_alt
107
108
109 subroutine g_calc_cq( moist, g_moist, cqu, g_cqu, cqv, g_cqv, cqw, g_cqw, n_moist, ide, jde, kde, ims, ime, jms, jme, kms, kme, &
110 &its, ite, jts, jte, kts, kte )
111 !******************************************************************
112 !******************************************************************
113 !** This routine was generated by Automatic differentiation. **
114 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
115 !******************************************************************
116 !******************************************************************
117 !==============================================
118 ! all entries are defined explicitly
119 !==============================================
120 implicit none
121
122 !==============================================
123 ! declare arguments
124 !==============================================
125 integer, intent(in) :: ime
126 integer, intent(in) :: ims
127 integer, intent(in) :: jme
128 integer, intent(in) :: jms
129 integer, intent(in) :: kme
130 integer, intent(in) :: kms
131 real, intent(out) :: cqu(ims:ime,kms:kme,jms:jme)
132 real, intent(out) :: cqv(ims:ime,kms:kme,jms:jme)
133 real, intent(out) :: cqw(ims:ime,kms:kme,jms:jme)
134 real, intent(out) :: g_cqu(ims:ime,kms:kme,jms:jme)
135 real, intent(out) :: g_cqv(ims:ime,kms:kme,jms:jme)
136 real, intent(out) :: g_cqw(ims:ime,kms:kme,jms:jme)
137 integer, intent(in) :: n_moist
138 real, intent(in) :: g_moist(ims:ime,kms:kme,jms:jme,n_moist)
139 integer, intent(in) :: ide
140 integer, intent(in) :: ite
141 integer, intent(in) :: its
142 integer, intent(in) :: jde
143 integer, intent(in) :: jte
144 integer, intent(in) :: jts
145 integer, intent(in) :: kde
146 integer, intent(in) :: kte
147 integer, intent(in) :: kts
148 real, intent(in) :: moist(ims:ime,kms:kme,jms:jme,n_moist)
149
150 !==============================================
151 ! declare local variables
152 !==============================================
153 real g_qtot
154 integer i
155 integer ispe
156 integer itf
157 integer j
158 integer jtf
159 integer k
160 integer ktf
161 real qtot
162
163 !----------------------------------------------
164 ! TANGENT LINEAR AND FUNCTION STATEMENTS
165 !----------------------------------------------
166 itf = ite
167 jtf = min(jte,jde-1)
168 ktf = min(kte,kde-1)
169 if (n_moist .ge. param_first_scalar) then
170 do j = jts, jtf
171 do k = kts, ktf
172 do i = its, itf
173 g_qtot = 0.
174 qtot = 0.
175 do ispe = param_first_scalar, n_moist
176 g_qtot = g_moist(i-1,k,j,ispe)+g_moist(i,k,j,ispe)+g_qtot
177 qtot = qtot+moist(i,k,j,ispe)+moist(i-1,k,j,ispe)
178 end do
179 g_cqu(i,k,j) = -(g_qtot*(0.5/((1.+0.5*qtot)*(1.+0.5*qtot))))
180 cqu(i,k,j) = 1./(1.+0.5*qtot)
181 end do
182 end do
183 end do
184 itf = min(ite,ide-1)
185 jtf = jte
186 do j = jts, jtf
187 do k = kts, ktf
188 do i = its, itf
189 g_qtot = 0.
190 qtot = 0.
191 do ispe = param_first_scalar, n_moist
192 g_qtot = g_moist(i,k,j-1,ispe)+g_moist(i,k,j,ispe)+g_qtot
193 qtot = qtot+moist(i,k,j,ispe)+moist(i,k,j-1,ispe)
194 end do
195 g_cqv(i,k,j) = -(g_qtot*(0.5/((1.+0.5*qtot)*(1.+0.5*qtot))))
196 cqv(i,k,j) = 1./(1.+0.5*qtot)
197 end do
198 end do
199 end do
200 itf = min(ite,ide-1)
201 jtf = min(jte,jde-1)
202 do j = jts, jtf
203 do k = kts+1, ktf
204 do i = its, itf
205 g_qtot = 0.
206 qtot = 0.
207 do ispe = param_first_scalar, n_moist
208 g_qtot = g_moist(i,k-1,j,ispe)+g_moist(i,k,j,ispe)+g_qtot
209 qtot = qtot+moist(i,k,j,ispe)+moist(i,k-1,j,ispe)
210 end do
211 g_cqw(i,k,j) = 0.5*g_qtot
212 cqw(i,k,j) = 0.5*qtot
213 end do
214 end do
215 end do
216 else
217 do j = jts, jtf
218 do k = kts, ktf
219 do i = its, itf
220 g_cqu(i,k,j) = 0.
221 cqu(i,k,j) = 1.
222 end do
223 end do
224 end do
225 itf = min(ite,ide-1)
226 jtf = jte
227 do j = jts, jtf
228 do k = kts, ktf
229 do i = its, itf
230 g_cqv(i,k,j) = 0.
231 cqv(i,k,j) = 1.
232 end do
233 end do
234 end do
235 itf = min(ite,ide-1)
236 jtf = min(jte,jde-1)
237 do j = jts, jtf
238 do k = kts+1, ktf
239 do i = its, itf
240 g_cqw(i,k,j) = 0.
241 cqw(i,k,j) = 0.
242 end do
243 end do
244 end do
245 endif
246
247 end subroutine g_calc_cq
248
249
250 subroutine g_calc_mu_uv( config_flags, mu, g_mu, mub, muu, g_muu, muv, g_muv, ids, ide, jds, jde, ims, ime, jms, jme, its, ite, &
251 &jts, jte )
252 !******************************************************************
253 !******************************************************************
254 !** This routine was generated by Automatic differentiation. **
255 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
256 !******************************************************************
257 !******************************************************************
258 !==============================================
259 ! all entries are defined explicitly
260 !==============================================
261 implicit none
262
263 !==============================================
264 ! declare arguments
265 !==============================================
266 type (grid_config_rec_type), intent(in) :: config_flags
267 integer, intent(in) :: ime
268 integer, intent(in) :: ims
269 integer, intent(in) :: jme
270 integer, intent(in) :: jms
271 real, intent(in) :: g_mu(ims:ime,jms:jme)
272 real, intent(out) :: g_muu(ims:ime,jms:jme)
273 real, intent(out) :: g_muv(ims:ime,jms:jme)
274 integer, intent(in) :: ide
275 integer, intent(in) :: ids
276 integer, intent(in) :: ite
277 integer, intent(in) :: its
278 integer, intent(in) :: jde
279 integer, intent(in) :: jds
280 integer, intent(in) :: jte
281 integer, intent(in) :: jts
282 real, intent(in) :: mu(ims:ime,jms:jme)
283 real, intent(in) :: mub(ims:ime,jms:jme)
284 real, intent(out) :: muu(ims:ime,jms:jme)
285 real, intent(out) :: muv(ims:ime,jms:jme)
286
287 !==============================================
288 ! declare local variables
289 !==============================================
290 integer i
291 integer im
292 integer itf
293 integer j
294 integer jm
295 integer jtf
296
297 !----------------------------------------------
298 ! TANGENT LINEAR AND FUNCTION STATEMENTS
299 !----------------------------------------------
300 itf = ite
301 jtf = min(jte,jde-1)
302 if (its .ne. ids .and. ite .ne. ide) then
303 do j = jts, jtf
304 do i = its, itf
305 g_muu(i,j) = 0.5*g_mu(i-1,j)+0.5*g_mu(i,j)
306 muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
307 end do
308 end do
309 else if (its .eq. ids .and. ite .ne. ide) then
310 do j = jts, jtf
311 do i = its+1, itf
312 g_muu(i,j) = 0.5*g_mu(i-1,j)+0.5*g_mu(i,j)
313 muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
314 end do
315 end do
316 i = its
317 im = its
318 if (config_flags%periodic_x) then
319 im = its-1
320 endif
321 do j = jts, jtf
322 g_muu(i,j) = 0.5*g_mu(i,j)+0.5*g_mu(im,j)
323 muu(i,j) = 0.5*(mu(i,j)+mu(im,j)+mub(i,j)+mub(im,j))
324 end do
325 else if (its .ne. ids .and. ite .eq. ide) then
326 do j = jts, jtf
327 do i = its, itf-1
328 g_muu(i,j) = 0.5*g_mu(i-1,j)+0.5*g_mu(i,j)
329 muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
330 end do
331 end do
332 i = ite
333 im = ite-1
334 if (config_flags%periodic_x) then
335 im = ite
336 endif
337 do j = jts, jtf
338 g_muu(i,j) = 0.5*g_mu(i-1,j)+0.5*g_mu(im,j)
339 muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)+mub(i-1,j)+mub(im,j))
340 end do
341 else if (its .eq. ids .and. ite .eq. ide) then
342 do j = jts, jtf
343 do i = its+1, itf-1
344 g_muu(i,j) = 0.5*g_mu(i-1,j)+0.5*g_mu(i,j)
345 muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j))
346 end do
347 end do
348 i = its
349 im = its
350 if (config_flags%periodic_x) then
351 im = its-1
352 endif
353 do j = jts, jtf
354 g_muu(i,j) = 0.5*g_mu(i,j)+0.5*g_mu(im,j)
355 muu(i,j) = 0.5*(mu(i,j)+mu(im,j)+mub(i,j)+mub(im,j))
356 end do
357 i = ite
358 im = ite-1
359 if (config_flags%periodic_x) then
360 im = ite
361 endif
362 do j = jts, jtf
363 g_muu(i,j) = 0.5*g_mu(i-1,j)+0.5*g_mu(im,j)
364 muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)+mub(i-1,j)+mub(im,j))
365 end do
366 endif
367 itf = min(ite,ide-1)
368 jtf = jte
369 if (jts .ne. jds .and. jte .ne. jde) then
370 do j = jts, jtf
371 do i = its, itf
372 g_muv(i,j) = 0.5*g_mu(i,j-1)+0.5*g_mu(i,j)
373 muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
374 end do
375 end do
376 else if (jts .eq. jds .and. jte .ne. jde) then
377 do j = jts+1, jtf
378 do i = its, itf
379 g_muv(i,j) = 0.5*g_mu(i,j-1)+0.5*g_mu(i,j)
380 muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
381 end do
382 end do
383 j = jts
384 jm = jts
385 if (config_flags%periodic_y) then
386 jm = jts-1
387 endif
388 do i = its, itf
389 g_muv(i,j) = 0.5*g_mu(i,j)+0.5*g_mu(i,jm)
390 muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)+mub(i,j)+mub(i,jm))
391 end do
392 else if (jts .ne. jds .and. jte .eq. jde) then
393 do j = jts, jtf-1
394 do i = its, itf
395 g_muv(i,j) = 0.5*g_mu(i,j-1)+0.5*g_mu(i,j)
396 muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
397 end do
398 end do
399 j = jte
400 jm = jte-1
401 if (config_flags%periodic_y) then
402 jm = jte
403 endif
404 do i = its, itf
405 g_muv(i,j) = g_mu(i,j-1)
406 muv(i,j) = mu(i,j-1)+mub(i,j-1)
407 g_muv(i,j) = 0.5*g_mu(i,j-1)+0.5*g_mu(i,jm)
408 muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)+mub(i,j-1)+mub(i,jm))
409 end do
410 else if (jts .eq. jds .and. jte .eq. jde) then
411 do j = jts+1, jtf-1
412 do i = its, itf
413 g_muv(i,j) = 0.5*g_mu(i,j-1)+0.5*g_mu(i,j)
414 muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1))
415 end do
416 end do
417 j = jts
418 jm = jts
419 if (config_flags%periodic_y) then
420 jm = jts-1
421 endif
422 do i = its, itf
423 g_muv(i,j) = 0.5*g_mu(i,j)+0.5*g_mu(i,jm)
424 muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)+mub(i,j)+mub(i,jm))
425 end do
426 j = jte
427 jm = jte-1
428 if (config_flags%periodic_y) then
429 jm = jte
430 endif
431 do i = its, itf
432 g_muv(i,j) = 0.5*g_mu(i,j-1)+0.5*g_mu(i,jm)
433 muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)+mub(i,j-1)+mub(i,jm))
434 end do
435 endif
436
437 end subroutine g_calc_mu_uv
438
439
440 subroutine g_calc_mu_uv_1( config_flags, mu, g_mu, muu, g_muu, muv, g_muv, ids, ide, jds, jde, ims, ime, jms, jme, its, ite, jts, &
441 &jte )
442 !******************************************************************
443 !******************************************************************
444 !** This routine was generated by Automatic differentiation. **
445 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
446 !******************************************************************
447 !******************************************************************
448 !==============================================
449 ! all entries are defined explicitly
450 !==============================================
451 implicit none
452
453 !==============================================
454 ! declare arguments
455 !==============================================
456 type (grid_config_rec_type), intent(in) :: config_flags
457 integer, intent(in) :: ime
458 integer, intent(in) :: ims
459 integer, intent(in) :: jme
460 integer, intent(in) :: jms
461 real, intent(in) :: g_mu(ims:ime,jms:jme)
462 real, intent(out) :: g_muu(ims:ime,jms:jme)
463 real, intent(out) :: g_muv(ims:ime,jms:jme)
464 integer, intent(in) :: ide
465 integer, intent(in) :: ids
466 integer, intent(in) :: ite
467 integer, intent(in) :: its
468 integer, intent(in) :: jde
469 integer, intent(in) :: jds
470 integer, intent(in) :: jte
471 integer, intent(in) :: jts
472 real, intent(in) :: mu(ims:ime,jms:jme)
473 real, intent(out) :: muu(ims:ime,jms:jme)
474 real, intent(out) :: muv(ims:ime,jms:jme)
475
476 !==============================================
477 ! declare local variables
478 !==============================================
479 integer i
480 integer im
481 integer itf
482 integer j
483 integer jm
484 integer jtf
485
486 !----------------------------------------------
487 ! TANGENT LINEAR AND FUNCTION STATEMENTS
488 !----------------------------------------------
489 itf = ite
490 jtf = min(jte,jde-1)
491 if (its .ne. ids .and. ite .ne. ide) then
492 do j = jts, jtf
493 do i = its, itf
494 g_muu(i,j) = 0.5*g_mu(i-1,j)+0.5*g_mu(i,j)
495 muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j))
496 end do
497 end do
498 else if (its .eq. ids .and. ite .ne. ide) then
499 do j = jts, jtf
500 do i = its+1, itf
501 g_muu(i,j) = 0.5*g_mu(i-1,j)+0.5*g_mu(i,j)
502 muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j))
503 end do
504 end do
505 i = its
506 im = its
507 if (config_flags%periodic_x) then
508 im = its-1
509 endif
510 do j = jts, jtf
511 g_muu(i,j) = 0.5*g_mu(i,j)+0.5*g_mu(im,j)
512 muu(i,j) = 0.5*(mu(i,j)+mu(im,j))
513 end do
514 else if (its .ne. ids .and. ite .eq. ide) then
515 do j = jts, jtf
516 do i = its, itf-1
517 g_muu(i,j) = 0.5*g_mu(i-1,j)+0.5*g_mu(i,j)
518 muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j))
519 end do
520 end do
521 i = ite
522 im = ite-1
523 if (config_flags%periodic_x) then
524 im = ite
525 endif
526 do j = jts, jtf
527 g_muu(i,j) = 0.5*g_mu(i-1,j)+0.5*g_mu(im,j)
528 muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j))
529 end do
530 else if (its .eq. ids .and. ite .eq. ide) then
531 do j = jts, jtf
532 do i = its+1, itf-1
533 g_muu(i,j) = 0.5*g_mu(i-1,j)+0.5*g_mu(i,j)
534 muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j))
535 end do
536 end do
537 i = its
538 im = its
539 if (config_flags%periodic_x) then
540 im = its-1
541 endif
542 do j = jts, jtf
543 g_muu(i,j) = 0.5*g_mu(i,j)+0.5*g_mu(im,j)
544 muu(i,j) = 0.5*(mu(i,j)+mu(im,j))
545 end do
546 i = ite
547 im = ite-1
548 if (config_flags%periodic_x) then
549 im = ite
550 endif
551 do j = jts, jtf
552 g_muu(i,j) = 0.5*g_mu(i-1,j)+0.5*g_mu(im,j)
553 muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j))
554 end do
555 endif
556 itf = min(ite,ide-1)
557 jtf = jte
558 if (jts .ne. jds .and. jte .ne. jde) then
559 do j = jts, jtf
560 do i = its, itf
561 g_muv(i,j) = 0.5*g_mu(i,j-1)+0.5*g_mu(i,j)
562 muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1))
563 end do
564 end do
565 else if (jts .eq. jds .and. jte .ne. jde) then
566 do j = jts+1, jtf
567 do i = its, itf
568 g_muv(i,j) = 0.5*g_mu(i,j-1)+0.5*g_mu(i,j)
569 muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1))
570 end do
571 end do
572 j = jts
573 jm = jts
574 if (config_flags%periodic_y) then
575 jm = jts-1
576 endif
577 do i = its, itf
578 g_muv(i,j) = 0.5*g_mu(i,j)+0.5*g_mu(i,jm)
579 muv(i,j) = 0.5*(mu(i,j)+mu(i,jm))
580 end do
581 else if (jts .ne. jds .and. jte .eq. jde) then
582 do j = jts, jtf-1
583 do i = its, itf
584 g_muv(i,j) = 0.5*g_mu(i,j-1)+0.5*g_mu(i,j)
585 muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1))
586 end do
587 end do
588 j = jte
589 jm = jte-1
590 if (config_flags%periodic_y) then
591 jm = jte
592 endif
593 do i = its, itf
594 g_muv(i,j) = 0.5*g_mu(i,j-1)+0.5*g_mu(i,jm)
595 muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm))
596 end do
597 else if (jts .eq. jds .and. jte .eq. jde) then
598 do j = jts+1, jtf-1
599 do i = its, itf
600 g_muv(i,j) = 0.5*g_mu(i,j-1)+0.5*g_mu(i,j)
601 muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1))
602 end do
603 end do
604 j = jts
605 jm = jts
606 if (config_flags%periodic_y) then
607 jm = jts-1
608 endif
609 do i = its, itf
610 g_muv(i,j) = 0.5*g_mu(i,j)+0.5*g_mu(i,jm)
611 muv(i,j) = 0.5*(mu(i,j)+mu(i,jm))
612 end do
613 j = jte
614 jm = jte-1
615 if (config_flags%periodic_y) then
616 jm = jte
617 endif
618 do i = its, itf
619 g_muv(i,j) = 0.5*g_mu(i,j-1)+0.5*g_mu(i,jm)
620 muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm))
621 end do
622 endif
623
624 end subroutine g_calc_mu_uv_1
625
626
627 subroutine g_calc_p_rho_phi( moist, g_moist, n_moist, al, g_al, alb, mu, g_mu, muts, g_muts, ph, g_ph, p, g_p, pb, t, g_t, p0, t0, &
628 &dnw, rdnw, rdn, non_hydrostatic, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
629 !******************************************************************
630 !******************************************************************
631 !** This routine was generated by Automatic differentiation. **
632 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
633 !******************************************************************
634 !******************************************************************
635 !==============================================
636 ! all entries are defined explicitly
637 !==============================================
638 implicit none
639
640 !==============================================
641 ! declare arguments
642 !==============================================
643 integer, intent(in) :: ime
644 integer, intent(in) :: ims
645 integer, intent(in) :: jme
646 integer, intent(in) :: jms
647 integer, intent(in) :: kme
648 integer, intent(in) :: kms
649 real, intent(out) :: al(ims:ime,kms:kme,jms:jme)
650 real, intent(in) :: alb(ims:ime,kms:kme,jms:jme)
651 real, intent(in) :: dnw(kms:kme)
652 real, intent(out) :: g_al(ims:ime,kms:kme,jms:jme)
653 integer, intent(in) :: n_moist
654 real, intent(in) :: g_moist(ims:ime,kms:kme,jms:jme,n_moist)
655 real, intent(in) :: g_mu(ims:ime,jms:jme)
656 real, intent(in) :: g_muts(ims:ime,jms:jme)
657 real, intent(out) :: g_p(ims:ime,kms:kme,jms:jme)
658 real, intent(inout) :: g_ph(ims:ime,kms:kme,jms:jme)
659 real, intent(in) :: g_t(ims:ime,kms:kme,jms:jme)
660 integer, intent(in) :: ide
661 integer, intent(in) :: ite
662 integer, intent(in) :: its
663 integer, intent(in) :: jde
664 integer, intent(in) :: jte
665 integer, intent(in) :: jts
666 integer, intent(in) :: kde
667 integer, intent(in) :: kte
668 integer, intent(in) :: kts
669 real, intent(in) :: moist(ims:ime,kms:kme,jms:jme,n_moist)
670 real, intent(in) :: mu(ims:ime,jms:jme)
671 real, intent(in) :: muts(ims:ime,jms:jme)
672 logical, intent(in) :: non_hydrostatic
673 real, intent(out) :: p(ims:ime,kms:kme,jms:jme)
674 real, intent(in) :: p0
675 real, intent(in) :: pb(ims:ime,kms:kme,jms:jme)
676 real, intent(inout) :: ph(ims:ime,kms:kme,jms:jme)
677 real, intent(in) :: rdn(kms:kme)
678 real, intent(in) :: rdnw(kms:kme)
679 real, intent(in) :: t(ims:ime,kms:kme,jms:jme)
680 real, intent(in) :: t0
681
682 !==============================================
683 ! declare local variables
684 !==============================================
685 real g_qf1
686 real g_qf2
687 real g_qtot
688 real g_qvf
689 integer i
690 integer ispe
691 integer itf
692 integer j
693 integer jtf
694 integer k
695 integer ktf
696 real qf1
697 real qf2
698 real qtot
699 real qvf
700
701 !----------------------------------------------
702 ! TANGENT LINEAR AND FUNCTION STATEMENTS
703 !----------------------------------------------
704 itf = min(ite,ide-1)
705 jtf = min(jte,jde-1)
706 ktf = min(kte,kde-1)
707 if (non_hydrostatic) then
708 if (n_moist .ge. param_first_scalar) then
709 do j = jts, jtf
710 do k = kts, ktf
711 do i = its, itf
712 g_qvf = g_moist(i,k,j,p_qv)*rvovrd
713 qvf = 1.+rvovrd*moist(i,k,j,p_qv)
714 g_al(i,k,j) = (-(g_mu(i,j)*1./muts(i,j)*alb(i,k,j)))+g_muts(i,j)/(muts(i,j)*muts(i,j))*(alb(i,k,j)*mu(i,j)+rdnw(k)*(ph(i,&
715 &k+1,j)-ph(i,k,j)))-g_ph(i,k+1,j)*1./muts(i,j)*rdnw(k)+g_ph(i,k,j)*1./muts(i,j)*rdnw(k)
716 al(i,k,j) = -(1./muts(i,j)*(alb(i,k,j)*mu(i,j)+rdnw(k)*(ph(i,k+1,j)-ph(i,k,j))))
717 g_p(i,k,j) = (-(g_al(i,k,j)*r_d*(t0+t(i,k,j))*qvf*p0/(p0*(al(i,k,j)+alb(i,k,j))*p0*(al(i,k,j)+alb(i,k,j)))*cpovcv*(r_d*&
718 &(t0+t(i,k,j))*qvf/(p0*(al(i,k,j)+alb(i,k,j))))**(cpovcv-1)*p0))+g_qvf*r_d*(t0+t(i,k,j))/(p0*(al(i,k,j)+alb(i,k,j)))*&
719 &cpovcv*(r_d*(t0+t(i,k,j))*qvf/(p0*(al(i,k,j)+alb(i,k,j))))**(cpovcv-1)*p0+g_t(i,k,j)*r_d*qvf/(p0*(al(i,k,j)+alb(i,k,j)))&
720 &*cpovcv*(r_d*(t0+t(i,k,j))*qvf/(p0*(al(i,k,j)+alb(i,k,j))))**(cpovcv-1)*p0
721 p(i,k,j) = (r_d*(t0+t(i,k,j))*qvf/(p0*(al(i,k,j)+alb(i,k,j))))**cpovcv*p0-pb(i,k,j)
722 end do
723 end do
724 end do
725 else
726 do j = jts, jtf
727 do k = kts, ktf
728 do i = its, itf
729 g_al(i,k,j) = (-(g_mu(i,j)*1./muts(i,j)*alb(i,k,j)))+g_muts(i,j)/(muts(i,j)*muts(i,j))*(alb(i,k,j)*mu(i,j)+rdnw(k)*(ph(i,&
730 &k+1,j)-ph(i,k,j)))-g_ph(i,k+1,j)*1./muts(i,j)*rdnw(k)+g_ph(i,k,j)*1./muts(i,j)*rdnw(k)
731 al(i,k,j) = -(1./muts(i,j)*(alb(i,k,j)*mu(i,j)+rdnw(k)*(ph(i,k+1,j)-ph(i,k,j))))
732 g_p(i,k,j) = (-(g_al(i,k,j)*p0*r_d*(t0+t(i,k,j))*p0/(p0*(al(i,k,j)+alb(i,k,j))*p0*(al(i,k,j)+alb(i,k,j)))*cpovcv*(r_d*&
733 &(t0+t(i,k,j))/(p0*(al(i,k,j)+alb(i,k,j))))**(cpovcv-1)))+g_t(i,k,j)*p0*r_d/(p0*(al(i,k,j)+alb(i,k,j)))*cpovcv*(r_d*(t0+&
734 &t(i,k,j))/(p0*(al(i,k,j)+alb(i,k,j))))**(cpovcv-1)
735 p(i,k,j) = p0*(r_d*(t0+t(i,k,j))/(p0*(al(i,k,j)+alb(i,k,j))))**cpovcv-pb(i,k,j)
736 end do
737 end do
738 end do
739 endif
740 else
741 if (n_moist .ge. param_first_scalar) then
742 do j = jts, jtf
743 k = ktf
744 do i = its, itf
745 g_qtot = 0.
746 qtot = 0.
747 do ispe = param_first_scalar, n_moist
748 g_qtot = g_moist(i,k,j,ispe)+g_qtot
749 qtot = qtot+moist(i,k,j,ispe)
750 end do
751 g_qf2 = -(g_qtot/((1.+qtot)*(1.+qtot)))
752 qf2 = 1./(1.+qtot)
753 g_qf1 = g_qf2*qtot+g_qtot*qf2
754 qf1 = qtot*qf2
755 g_p(i,k,j) = (-(g_mu(i,j)*(0.5/rdnw(k)/qf2)))-g_muts(i,j)*(0.5*qf1/rdnw(k)/qf2)-g_qf1*(0.5*muts(i,j)/rdnw(k)/qf2)+g_qf2*&
756 &(0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/(qf2*qf2))
757 p(i,k,j) = -(0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2)
758 g_qvf = g_moist(i,k,j,p_qv)*rvovrd
759 qvf = 1.+rvovrd*moist(i,k,j,p_qv)
760 g_al(i,k,j) = g_p(i,k,j)*r_d/p1000mb*(t(i,k,j)+t0)*qvf/p1000mb*cvpm*((p(i,k,j)+pb(i,k,j))/p1000mb)**(cvpm-1)+g_qvf*r_d/&
761 &p1000mb*(t(i,k,j)+t0)*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm+g_t(i,k,j)*r_d/p1000mb*qvf*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm
762 al(i,k,j) = r_d/p1000mb*(t(i,k,j)+t0)*qvf*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm-alb(i,k,j)
763 end do
764 do k = ktf-1, kts, -1
765 do i = its, itf
766 g_qtot = 0.
767 qtot = 0.
768 do ispe = param_first_scalar, n_moist
769 g_qtot = 0.5*g_moist(i,k+1,j,ispe)+0.5*g_moist(i,k,j,ispe)+g_qtot
770 qtot = qtot+0.5*(moist(i,k,j,ispe)+moist(i,k+1,j,ispe))
771 end do
772 g_qf2 = -(g_qtot/((1.+qtot)*(1.+qtot)))
773 qf2 = 1./(1.+qtot)
774 g_qf1 = g_qf2*qtot+g_qtot*qf2
775 qf1 = qtot*qf2
776 g_p(i,k,j) = (-(g_mu(i,j)*(1/qf2/rdn(k+1))))-g_muts(i,j)*(qf1/qf2/rdn(k+1))+g_p(i,k+1,j)-g_qf1*(muts(i,j)/qf2/rdn(k+1))+&
777 &g_qf2*((mu(i,j)+qf1*muts(i,j))/(qf2*qf2)/rdn(k+1))
778 p(i,k,j) = p(i,k+1,j)-(mu(i,j)+qf1*muts(i,j))/qf2/rdn(k+1)
779 g_qvf = g_moist(i,k,j,p_qv)*rvovrd
780 qvf = 1.+rvovrd*moist(i,k,j,p_qv)
781 g_al(i,k,j) = g_p(i,k,j)*r_d/p1000mb*(t(i,k,j)+t0)*qvf/p1000mb*cvpm*((p(i,k,j)+pb(i,k,j))/p1000mb)**(cvpm-1)+g_qvf*r_d/&
782 &p1000mb*(t(i,k,j)+t0)*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm+g_t(i,k,j)*r_d/p1000mb*qvf*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm
783 al(i,k,j) = r_d/p1000mb*(t(i,k,j)+t0)*qvf*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm-alb(i,k,j)
784 end do
785 end do
786 do k = 2, ktf+1
787 do i = its, itf
788 g_ph(i,k,j) = (-(g_al(i,k-1,j)*dnw(k-1)*muts(i,j)))-g_mu(i,j)*dnw(k-1)*alb(i,k-1,j)-g_muts(i,j)*dnw(k-1)*al(i,k-1,j)+&
789 &g_ph(i,k-1,j)
790 ph(i,k,j) = ph(i,k-1,j)-dnw(k-1)*(muts(i,j)*al(i,k-1,j)+mu(i,j)*alb(i,k-1,j))
791 end do
792 end do
793 end do
794 else
795 do j = jts, jtf
796 k = ktf
797 do i = its, itf
798 g_qtot = 0.
799 qtot = 0.
800 g_qf2 = -(g_qtot/((1.+qtot)*(1.+qtot)))
801 qf2 = 1./(1.+qtot)
802 g_qf1 = g_qf2*qtot+g_qtot*qf2
803 qf1 = qtot*qf2
804 g_p(i,k,j) = (-(g_mu(i,j)*(0.5/rdnw(k)/qf2)))-g_muts(i,j)*(0.5*qf1/rdnw(k)/qf2)-g_qf1*(0.5*muts(i,j)/rdnw(k)/qf2)+g_qf2*&
805 &(0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/(qf2*qf2))
806 p(i,k,j) = -(0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2)
807 g_qvf = 0.
808 qvf = 1.
809 g_al(i,k,j) = g_p(i,k,j)*r_d/p1000mb*(t(i,k,j)+t0)*qvf/p1000mb*cvpm*((p(i,k,j)+pb(i,k,j))/p1000mb)**(cvpm-1)+g_qvf*r_d/&
810 &p1000mb*(t(i,k,j)+t0)*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm+g_t(i,k,j)*r_d/p1000mb*qvf*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm
811 al(i,k,j) = r_d/p1000mb*(t(i,k,j)+t0)*qvf*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm-alb(i,k,j)
812 end do
813 do k = ktf-1, kts, -1
814 do i = its, itf
815 g_qtot = 0.
816 qtot = 0.
817 g_qf2 = -(g_qtot/((1.+qtot)*(1.+qtot)))
818 qf2 = 1./(1.+qtot)
819 g_qf1 = g_qf2*qtot+g_qtot*qf2
820 qf1 = qtot*qf2
821 g_p(i,k,j) = (-(g_mu(i,j)*(1/qf2/rdn(k+1))))-g_muts(i,j)*(qf1/qf2/rdn(k+1))+g_p(i,k+1,j)-g_qf1*(muts(i,j)/qf2/rdn(k+1))+&
822 &g_qf2*((mu(i,j)+qf1*muts(i,j))/(qf2*qf2)/rdn(k+1))
823 p(i,k,j) = p(i,k+1,j)-(mu(i,j)+qf1*muts(i,j))/qf2/rdn(k+1)
824 g_qvf = 0.
825 qvf = 1.
826 g_al(i,k,j) = g_p(i,k,j)*r_d/p1000mb*(t(i,k,j)+t0)*qvf/p1000mb*cvpm*((p(i,k,j)+pb(i,k,j))/p1000mb)**(cvpm-1)+g_qvf*r_d/&
827 &p1000mb*(t(i,k,j)+t0)*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm+g_t(i,k,j)*r_d/p1000mb*qvf*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm
828 al(i,k,j) = r_d/p1000mb*(t(i,k,j)+t0)*qvf*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm-alb(i,k,j)
829 end do
830 end do
831 do k = 2, ktf+1
832 do i = its, itf
833 g_ph(i,k,j) = (-(g_al(i,k-1,j)*dnw(k-1)*muts(i,j)))-g_mu(i,j)*dnw(k-1)*alb(i,k-1,j)-g_muts(i,j)*dnw(k-1)*al(i,k-1,j)+&
834 &g_ph(i,k-1,j)
835 ph(i,k,j) = ph(i,k-1,j)-dnw(k-1)*(muts(i,j)*al(i,k-1,j)+mu(i,j)*alb(i,k-1,j))
836 end do
837 end do
838 end do
839 endif
840 endif
841
842 end subroutine g_calc_p_rho_phi
843
844
845 subroutine g_calc_php( php, g_php, ph, g_ph, phb, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
846 !******************************************************************
847 !******************************************************************
848 !** This routine was generated by Automatic differentiation. **
849 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
850 !******************************************************************
851 !******************************************************************
852 !==============================================
853 ! all entries are defined explicitly
854 !==============================================
855 implicit none
856
857 !==============================================
858 ! declare arguments
859 !==============================================
860 integer, intent(in) :: ime
861 integer, intent(in) :: ims
862 integer, intent(in) :: jme
863 integer, intent(in) :: jms
864 integer, intent(in) :: kme
865 integer, intent(in) :: kms
866 real, intent(in) :: g_ph(ims:ime,kms:kme,jms:jme)
867 real, intent(out) :: g_php(ims:ime,kms:kme,jms:jme)
868 integer, intent(in) :: ide
869 integer, intent(in) :: ite
870 integer, intent(in) :: its
871 integer, intent(in) :: jde
872 integer, intent(in) :: jte
873 integer, intent(in) :: jts
874 integer, intent(in) :: kde
875 integer, intent(in) :: kte
876 integer, intent(in) :: kts
877 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
878 real, intent(in) :: phb(ims:ime,kms:kme,jms:jme)
879 real, intent(out) :: php(ims:ime,kms:kme,jms:jme)
880
881 !==============================================
882 ! declare local variables
883 !==============================================
884 integer i
885 integer itf
886 integer j
887 integer jtf
888 integer k
889 integer ktf
890
891 !----------------------------------------------
892 ! TANGENT LINEAR AND FUNCTION STATEMENTS
893 !----------------------------------------------
894 itf = min(ite,ide-1)
895 jtf = min(jte,jde-1)
896 ktf = min(kte,kde-1)
897 do j = jts, jtf
898 do k = kts, ktf
899 do i = its, itf
900 g_php(i,k,j) = 0.5*g_ph(i,k+1,j)+0.5*g_ph(i,k,j)
901 php(i,k,j) = 0.5*(phb(i,k,j)+phb(i,k+1,j)+ph(i,k,j)+ph(i,k+1,j))
902 end do
903 end do
904 end do
905
906 end subroutine g_calc_php
907
908
909 subroutine g_calc_ww_cp( u, g_u, v, g_v, mup, g_mup, mub, ww, g_ww, rdx, rdy, msft, msfu, msfv, dnw, ide, jde, kde, ims, ime, jms, &
910 &jme, kms, kme, its, ite, jts, jte, kts, kte )
911 !******************************************************************
912 !******************************************************************
913 !** This routine was generated by Automatic differentiation. **
914 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
915 !******************************************************************
916 !******************************************************************
917 !==============================================
918 ! all entries are defined explicitly
919 !==============================================
920 implicit none
921
922 !==============================================
923 ! declare arguments
924 !==============================================
925 integer, intent(in) :: kme
926 integer, intent(in) :: kms
927 real, intent(in) :: dnw(kms:kme)
928 integer, intent(in) :: ime
929 integer, intent(in) :: ims
930 integer, intent(in) :: jme
931 integer, intent(in) :: jms
932 real, intent(in) :: g_mup(ims:ime,jms:jme)
933 real, intent(in) :: g_u(ims:ime,kms:kme,jms:jme)
934 real, intent(in) :: g_v(ims:ime,kms:kme,jms:jme)
935 real, intent(out) :: g_ww(ims:ime,kms:kme,jms:jme)
936 integer, intent(in) :: ide
937 integer, intent(in) :: ite
938 integer, intent(in) :: its
939 integer, intent(in) :: jde
940 integer, intent(in) :: jte
941 integer, intent(in) :: jts
942 integer, intent(in) :: kde
943 integer, intent(in) :: kte
944 integer, intent(in) :: kts
945 real, intent(in) :: msft(ims:ime,jms:jme)
946 real, intent(in) :: msfu(ims:ime,jms:jme)
947 real, intent(in) :: msfv(ims:ime,jms:jme)
948 real, intent(in) :: mub(ims:ime,jms:jme)
949 real, intent(in) :: mup(ims:ime,jms:jme)
950 real, intent(in) :: rdx
951 real, intent(in) :: rdy
952 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
953 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
954 real, intent(out) :: ww(ims:ime,kms:kme,jms:jme)
955
956 !==============================================
957 ! declare local variables
958 !==============================================
959 real divv(its:ite,kts:kte)
960 real dmdt(its:ite)
961 real g_divv(its:ite,kts:kte)
962 real g_dmdt(its:ite)
963 real g_muu(its:ite+1,jts:jte+1)
964 real g_muv(its:ite+1,jts:jte+1)
965 integer i
966 integer itf
967 integer j
968 integer jtf
969 integer k
970 integer ktf
971 real muu(its:ite+1,jts:jte+1)
972 real muv(its:ite+1,jts:jte+1)
973
974 !----------------------------------------------
975 ! TANGENT LINEAR AND FUNCTION STATEMENTS
976 !----------------------------------------------
977 jtf = min(jte,jde-1)
978 ktf = min(kte,kde-1)
979 itf = min(ite,ide-1)
980 do j = jts, jtf
981 do i = its, min(ite+1,ide)
982 g_muu(i,j) = (g_mup(i-1,j)+g_mup(i,j))*(0.5/msfu(i,j))
983 muu(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i-1,j)+mub(i-1,j))/msfu(i,j)
984 end do
985 end do
986 do j = jts, min(jte+1,jde)
987 do i = its, itf
988 g_muv(i,j) = (g_mup(i,j-1)+g_mup(i,j))*(0.5/msfv(i,j))
989 muv(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i,j-1)+mub(i,j-1))/msfv(i,j)
990 end do
991 end do
992 do j = jts, jtf
993 do i = its, ite
994 g_dmdt(i) = 0.
995 dmdt(i) = 0.
996 g_ww(i,1,j) = 0.
997 ww(i,1,j) = 0.
998 g_ww(i,kte,j) = 0.
999 ww(i,kte,j) = 0.
1000 end do
1001 do k = kts, ktf
1002 do i = its, itf
1003 g_divv(i,k) = g_muu(i+1,j)*msft(i,j)*dnw(k)*rdx*u(i+1,k,j)-g_muu(i,j)*msft(i,j)*dnw(k)*rdx*u(i,k,j)+g_muv(i,j+1)*msft(i,j)*&
1004 &dnw(k)*rdy*v(i,k,j+1)-g_muv(i,j)*msft(i,j)*dnw(k)*rdy*v(i,k,j)+g_u(i+1,k,j)*msft(i,j)*dnw(k)*rdx*muu(i+1,j)-g_u(i,k,j)*&
1005 &msft(i,j)*dnw(k)*rdx*muu(i,j)+g_v(i,k,j+1)*msft(i,j)*dnw(k)*rdy*muv(i,j+1)-g_v(i,k,j)*msft(i,j)*dnw(k)*rdy*muv(i,j)
1006 divv(i,k) = msft(i,j)*dnw(k)*(rdx*(muu(i+1,j)*u(i+1,k,j)-muu(i,j)*u(i,k,j))+rdy*(muv(i,j+1)*v(i,k,j+1)-muv(i,j)*v(i,k,j)))
1007 g_dmdt(i) = g_divv(i,k)+g_dmdt(i)
1008 dmdt(i) = dmdt(i)+divv(i,k)
1009 end do
1010 end do
1011 do k = 2, ktf
1012 do i = its, itf
1013 g_ww(i,k,j) = (-g_divv(i,k-1))-g_dmdt(i)*dnw(k-1)+g_ww(i,k-1,j)
1014 ww(i,k,j) = ww(i,k-1,j)-dnw(k-1)*dmdt(i)-divv(i,k-1)
1015 end do
1016 end do
1017 end do
1018
1019 end subroutine g_calc_ww_cp
1020
1021
1022 subroutine g_calculate_full( rfield, g_rfield, rfieldb, rfieldp, g_rfieldp, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, &
1023 &jts, jte, kts, kte )
1024 !******************************************************************
1025 !******************************************************************
1026 !** This routine was generated by Automatic differentiation. **
1027 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1028 !******************************************************************
1029 !******************************************************************
1030 !==============================================
1031 ! all entries are defined explicitly
1032 !==============================================
1033 implicit none
1034
1035 !==============================================
1036 ! declare arguments
1037 !==============================================
1038 integer, intent(in) :: ime
1039 integer, intent(in) :: ims
1040 integer, intent(in) :: jme
1041 integer, intent(in) :: jms
1042 integer, intent(in) :: kme
1043 integer, intent(in) :: kms
1044 real, intent(out) :: g_rfield(ims:ime,kms:kme,jms:jme)
1045 real, intent(in) :: g_rfieldp(ims:ime,kms:kme,jms:jme)
1046 integer, intent(in) :: ide
1047 integer, intent(in) :: ite
1048 integer, intent(in) :: its
1049 integer, intent(in) :: jde
1050 integer, intent(in) :: jte
1051 integer, intent(in) :: jts
1052 integer, intent(in) :: kde
1053 integer, intent(in) :: kte
1054 integer, intent(in) :: kts
1055 real, intent(out) :: rfield(ims:ime,kms:kme,jms:jme)
1056 real, intent(in) :: rfieldb(ims:ime,kms:kme,jms:jme)
1057 real, intent(in) :: rfieldp(ims:ime,kms:kme,jms:jme)
1058
1059 !==============================================
1060 ! declare local variables
1061 !==============================================
1062 integer i
1063 integer itf
1064 integer j
1065 integer jtf
1066 integer k
1067 integer ktf
1068
1069 !----------------------------------------------
1070 ! TANGENT LINEAR AND FUNCTION STATEMENTS
1071 !----------------------------------------------
1072 itf = min(ite,ide-1)
1073 jtf = min(jte,jde-1)
1074 ktf = min(kte,kde-1)
1075 do j = jts, jtf
1076 do k = kts, ktf
1077 do i = its, itf
1078 g_rfield(i,k,j) = g_rfieldp(i,k,j)
1079 rfield(i,k,j) = rfieldb(i,k,j)+rfieldp(i,k,j)
1080 end do
1081 end do
1082 end do
1083
1084 end subroutine g_calculate_full
1085
1086
1087 subroutine g_coriolis( ru, g_ru, rv, g_rv, rw, g_rw, ru_tend, g_ru_tend, rv_tend, g_rv_tend, rw_tend, g_rw_tend, config_flags, f, &
1088 &e, sina, cosa, fzm, fzp, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1089 !******************************************************************
1090 !******************************************************************
1091 !** This routine was generated by Automatic differentiation. **
1092 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1093 !******************************************************************
1094 !******************************************************************
1095 !==============================================
1096 ! all entries are defined explicitly
1097 !==============================================
1098 implicit none
1099
1100 !==============================================
1101 ! declare arguments
1102 !==============================================
1103 type (grid_config_rec_type), intent(in) :: config_flags
1104 integer, intent(in) :: ime
1105 integer, intent(in) :: ims
1106 integer, intent(in) :: jme
1107 integer, intent(in) :: jms
1108 real, intent(in) :: cosa(ims:ime,jms:jme)
1109 real, intent(in) :: e(ims:ime,jms:jme)
1110 real, intent(in) :: f(ims:ime,jms:jme)
1111 integer, intent(in) :: kme
1112 integer, intent(in) :: kms
1113 real, intent(in) :: fzm(kms:kme)
1114 real, intent(in) :: fzp(kms:kme)
1115 real, intent(in) :: g_ru(ims:ime,kms:kme,jms:jme)
1116 real, intent(inout) :: g_ru_tend(ims:ime,kms:kme,jms:jme)
1117 real, intent(in) :: g_rv(ims:ime,kms:kme,jms:jme)
1118 real, intent(inout) :: g_rv_tend(ims:ime,kms:kme,jms:jme)
1119 real, intent(in) :: g_rw(ims:ime,kms:kme,jms:jme)
1120 real, intent(inout) :: g_rw_tend(ims:ime,kms:kme,jms:jme)
1121 integer, intent(in) :: ide
1122 integer, intent(in) :: ids
1123 integer, intent(in) :: ite
1124 integer, intent(in) :: its
1125 integer, intent(in) :: jde
1126 integer, intent(in) :: jds
1127 integer, intent(in) :: jte
1128 integer, intent(in) :: jts
1129 integer, intent(in) :: kde
1130 integer, intent(in) :: kte
1131 integer, intent(in) :: kts
1132 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
1133 real, intent(inout) :: ru_tend(ims:ime,kms:kme,jms:jme)
1134 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
1135 real, intent(inout) :: rv_tend(ims:ime,kms:kme,jms:jme)
1136 real, intent(in) :: rw(ims:ime,kms:kme,jms:jme)
1137 real, intent(inout) :: rw_tend(ims:ime,kms:kme,jms:jme)
1138 real, intent(in) :: sina(ims:ime,jms:jme)
1139
1140 !==============================================
1141 ! declare local variables
1142 !==============================================
1143 integer i
1144 integer i_end
1145 integer i_start
1146 integer j
1147 integer j_end
1148 integer j_start
1149 integer k
1150 integer ktf
1151 logical specified
1152
1153 !----------------------------------------------
1154 ! TANGENT LINEAR AND FUNCTION STATEMENTS
1155 !----------------------------------------------
1156 specified = .false.
1157 if (config_flags%specified .or. config_flags%nested) then
1158 specified = .true.
1159 endif
1160 ktf = min(kte,kde-1)
1161 i_start = its
1162 i_end = ite
1163 if (config_flags%open_xs .or. specified .or. config_flags%nested) then
1164 i_start = max(ids+1,its)
1165 endif
1166 if (config_flags%open_xe .or. specified .or. config_flags%nested) then
1167 i_end = min(ide-1,ite)
1168 endif
1169 do j = jts, min(jte,jde-1)
1170 do k = kts, ktf
1171 do i = i_start, i_end
1172 g_ru_tend(i,k,j) = g_ru_tend(i,k,j)+0.125*g_rv(i-1,k,j+1)*(f(i,j)+f(i-1,j))+0.125*g_rv(i,k,j+1)*(f(i,j)+f(i-1,j))+0.125*&
1173 &g_rv(i-1,k,j)*(f(i,j)+f(i-1,j))+0.125*g_rv(i,k,j)*(f(i,j)+f(i-1,j))-0.0625*g_rw(i-1,k+1,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+&
1174 &cosa(i-1,j))-0.0625*g_rw(i,k+1,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+cosa(i-1,j))-0.0625*g_rw(i-1,k,j)*(e(i,j)+e(i-1,j))*(cosa(i,&
1175 &j)+cosa(i-1,j))-0.0625*g_rw(i,k,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+cosa(i-1,j))
1176 ru_tend(i,k,j) = ru_tend(i,k,j)+0.5*(f(i,j)+f(i-1,j))*0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j))-0.5*(e(i,j)+e(i-&
1177 &1,j))*0.5*(cosa(i,j)+cosa(i-1,j))*0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j))
1178 end do
1179 end do
1180 if (config_flags%open_xs .and. its .eq. ids) then
1181 do k = kts, ktf
1182 g_ru_tend(its,k,j) = g_ru_tend(its,k,j)+0.5*g_rv(its,k,j+1)*f(its,j)+0.5*g_rv(its,k,j)*f(its,j)-0.5*g_rw(its,k+1,j)*e(its,j)*&
1183 &cosa(its,j)-0.5*g_rw(its,k,j)*e(its,j)*cosa(its,j)
1184 ru_tend(its,k,j) = ru_tend(its,k,j)+0.5*(f(its,j)+f(its,j))*0.25*(rv(its,k,j+1)+rv(its,k,j+1)+rv(its,k,j)+rv(its,k,j))-0.5*&
1185 &(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j))*0.25*(rw(its,k+1,j)+rw(its,k,j)+rw(its,k+1,j)+rw(its,k,j))
1186 end do
1187 endif
1188 if (config_flags%open_xe .and. ite .eq. ide) then
1189 do k = kts, ktf
1190 g_ru_tend(ite,k,j) = g_ru_tend(ite,k,j)+0.5*g_rv(ite-1,k,j+1)*f(ite-1,j)+0.5*g_rv(ite-1,k,j)*f(ite-1,j)-0.5*g_rw(ite-1,k+1,j)&
1191 &*e(ite-1,j)*cosa(ite-1,j)-0.5*g_rw(ite-1,k,j)*e(ite-1,j)*cosa(ite-1,j)
1192 ru_tend(ite,k,j) = ru_tend(ite,k,j)+0.5*(f(ite-1,j)+f(ite-1,j))*0.25*(rv(ite-1,k,j+1)+rv(ite-1,k,j+1)+rv(ite-1,k,j)+rv(ite-1,&
1193 &k,j))-0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j))*0.25*(rw(ite-1,k+1,j)+rw(ite-1,k,j)+rw(ite-1,k+1,j)+&
1194 &rw(ite-1,k,j))
1195 end do
1196 endif
1197 end do
1198 j_start = jts
1199 j_end = jte
1200 if (config_flags%open_ys .or. specified .or. config_flags%nested) then
1201 j_start = max(jds+1,jts)
1202 endif
1203 if (config_flags%open_ye .or. specified .or. config_flags%nested) then
1204 j_end = min(jde-1,jte)
1205 endif
1206 if (config_flags%open_ys .and. jts .eq. jds) then
1207 do k = kts, ktf
1208 do i = its, min(ide-1,ite)
1209 g_rv_tend(i,k,jts) = (-(0.5*g_ru(i+1,k,jts)*f(i,jts)))-0.5*g_ru(i,k,jts)*f(i,jts)+g_rv_tend(i,k,jts)+0.5*g_rw(i,k+1,jts)*e(i,&
1210 &jts)*sina(i,jts)+0.5*g_rw(i,k,jts)*e(i,jts)*sina(i,jts)
1211 rv_tend(i,k,jts) = rv_tend(i,k,jts)-0.5*(f(i,jts)+f(i,jts))*0.25*(ru(i,k,jts)+ru(i+1,k,jts)+ru(i,k,jts)+ru(i+1,k,jts))+0.5*&
1212 &(e(i,jts)+e(i,jts))*0.5*(sina(i,jts)+sina(i,jts))*0.25*(rw(i,k+1,jts)+rw(i,k,jts)+rw(i,k+1,jts)+rw(i,k,jts))
1213 end do
1214 end do
1215 endif
1216 do j = j_start, j_end
1217 do k = kts, ktf
1218 do i = its, min(ide-1,ite)
1219 g_rv_tend(i,k,j) = (-(0.125*g_ru(i+1,k,j-1)*(f(i,j)+f(i,j-1))))-0.125*g_ru(i,k,j-1)*(f(i,j)+f(i,j-1))-0.125*g_ru(i+1,k,j)*&
1220 &(f(i,j)+f(i,j-1))-0.125*g_ru(i,k,j)*(f(i,j)+f(i,j-1))+g_rv_tend(i,k,j)+0.0625*g_rw(i,k+1,j-1)*(e(i,j)+e(i,j-1))*(sina(i,j)+&
1221 &sina(i,j-1))+0.0625*g_rw(i,k+1,j)*(e(i,j)+e(i,j-1))*(sina(i,j)+sina(i,j-1))+0.0625*g_rw(i,k,j-1)*(e(i,j)+e(i,j-1))*(sina(i,&
1222 &j)+sina(i,j-1))+0.0625*g_rw(i,k,j)*(e(i,j)+e(i,j-1))*(sina(i,j)+sina(i,j-1))
1223 rv_tend(i,k,j) = rv_tend(i,k,j)-0.5*(f(i,j)+f(i,j-1))*0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1))+0.5*(e(i,j)+e(i,&
1224 &j-1))*0.5*(sina(i,j)+sina(i,j-1))*0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j))
1225 end do
1226 end do
1227 end do
1228 if (config_flags%open_ye .and. jte .eq. jde) then
1229 do k = kts, ktf
1230 do i = its, min(ide-1,ite)
1231 g_rv_tend(i,k,jte) = (-(0.5*g_ru(i+1,k,jte-1)*f(i,jte-1)))-0.5*g_ru(i,k,jte-1)*f(i,jte-1)+g_rv_tend(i,k,jte)+0.5*g_rw(i,k+1,&
1232 &jte-1)*e(i,jte-1)*sina(i,jte-1)+0.5*g_rw(i,k,jte-1)*e(i,jte-1)*sina(i,jte-1)
1233 rv_tend(i,k,jte) = rv_tend(i,k,jte)-0.5*(f(i,jte-1)+f(i,jte-1))*0.25*(ru(i,k,jte-1)+ru(i+1,k,jte-1)+ru(i,k,jte-1)+ru(i+1,k,&
1234 &jte-1))+0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i,jte-1)+sina(i,jte-1))*0.25*(rw(i,k+1,jte-1)+rw(i,k,jte-1)+rw(i,k+1,jte-1)+&
1235 &rw(i,k,jte-1))
1236 end do
1237 end do
1238 endif
1239 do j = jts, min(jte,jde-1)
1240 do k = kts+1, ktf
1241 do i = its, min(ite,ide-1)
1242 g_rw_tend(i,k,j) = 0.5*g_ru(i+1,k-1,j)*e(i,j)*cosa(i,j)*fzp(k)+0.5*g_ru(i,k-1,j)*e(i,j)*cosa(i,j)*fzp(k)+0.5*g_ru(i+1,k,j)*&
1243 &e(i,j)*cosa(i,j)*fzm(k)+0.5*g_ru(i,k,j)*e(i,j)*cosa(i,j)*fzm(k)-0.5*g_rv(i,k-1,j+1)*e(i,j)*sina(i,j)*fzp(k)-0.5*g_rv(i,k-1,&
1244 &j)*e(i,j)*sina(i,j)*fzp(k)-0.5*g_rv(i,k,j+1)*e(i,j)*sina(i,j)*fzm(k)-0.5*g_rv(i,k,j)*e(i,j)*sina(i,j)*fzm(k)+g_rw_tend(i,k,j)
1245 rw_tend(i,k,j) = rw_tend(i,k,j)+e(i,j)*(cosa(i,j)*0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j))+fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j)))-&
1246 &sina(i,j)*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1))+fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1))))
1247 end do
1248 end do
1249 end do
1250
1251 end subroutine g_coriolis
1252
1253
1254 subroutine g_couple_momentum( muu, g_muu, ru, g_ru, u, g_u, msfu, muv, g_muv, rv, g_rv, v, g_v, msfv, mut, g_mut, rw, g_rw, w, g_w,&
1255 & msft, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1256 !******************************************************************
1257 !******************************************************************
1258 !** This routine was generated by Automatic differentiation. **
1259 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1260 !******************************************************************
1261 !******************************************************************
1262 !==============================================
1263 ! all entries are defined explicitly
1264 !==============================================
1265 implicit none
1266
1267 !==============================================
1268 ! declare arguments
1269 !==============================================
1270 integer, intent(in) :: ime
1271 integer, intent(in) :: ims
1272 integer, intent(in) :: jme
1273 integer, intent(in) :: jms
1274 real, intent(in) :: g_mut(ims:ime,jms:jme)
1275 real, intent(in) :: g_muu(ims:ime,jms:jme)
1276 real, intent(in) :: g_muv(ims:ime,jms:jme)
1277 integer, intent(in) :: kme
1278 integer, intent(in) :: kms
1279 real, intent(out) :: g_ru(ims:ime,kms:kme,jms:jme)
1280 real, intent(out) :: g_rv(ims:ime,kms:kme,jms:jme)
1281 real, intent(out) :: g_rw(ims:ime,kms:kme,jms:jme)
1282 real, intent(in) :: g_u(ims:ime,kms:kme,jms:jme)
1283 real, intent(in) :: g_v(ims:ime,kms:kme,jms:jme)
1284 real, intent(in) :: g_w(ims:ime,kms:kme,jms:jme)
1285 integer, intent(in) :: ide
1286 integer, intent(in) :: ite
1287 integer, intent(in) :: its
1288 integer, intent(in) :: jde
1289 integer, intent(in) :: jte
1290 integer, intent(in) :: jts
1291 integer, intent(in) :: kde
1292 integer, intent(in) :: kte
1293 integer, intent(in) :: kts
1294 real, intent(in) :: msft(ims:ime,jms:jme)
1295 real, intent(in) :: msfu(ims:ime,jms:jme)
1296 real, intent(in) :: msfv(ims:ime,jms:jme)
1297 real, intent(in) :: mut(ims:ime,jms:jme)
1298 real, intent(in) :: muu(ims:ime,jms:jme)
1299 real, intent(in) :: muv(ims:ime,jms:jme)
1300 real, intent(out) :: ru(ims:ime,kms:kme,jms:jme)
1301 real, intent(out) :: rv(ims:ime,kms:kme,jms:jme)
1302 real, intent(out) :: rw(ims:ime,kms:kme,jms:jme)
1303 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
1304 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
1305 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
1306
1307 !==============================================
1308 ! declare local variables
1309 !==============================================
1310 integer i
1311 integer itf
1312 integer j
1313 integer jtf
1314 integer k
1315 integer ktf
1316
1317 !----------------------------------------------
1318 ! TANGENT LINEAR AND FUNCTION STATEMENTS
1319 !----------------------------------------------
1320 ktf = min(kte,kde-1)
1321 itf = ite
1322 jtf = min(jte,jde-1)
1323 do j = jts, jtf
1324 do k = kts, ktf
1325 do i = its, itf
1326 g_ru(i,k,j) = g_muu(i,j)*(u(i,k,j)/msfu(i,j))+g_u(i,k,j)*(muu(i,j)/msfu(i,j))
1327 ru(i,k,j) = u(i,k,j)*muu(i,j)/msfu(i,j)
1328 end do
1329 end do
1330 end do
1331 itf = min(ite,ide-1)
1332 jtf = jte
1333 do j = jts, jtf
1334 do k = kts, ktf
1335 do i = its, itf
1336 g_rv(i,k,j) = g_muv(i,j)*(v(i,k,j)/msfv(i,j))+g_v(i,k,j)*(muv(i,j)/msfv(i,j))
1337 rv(i,k,j) = v(i,k,j)*muv(i,j)/msfv(i,j)
1338 end do
1339 end do
1340 end do
1341 itf = min(ite,ide-1)
1342 jtf = min(jte,jde-1)
1343 do j = jts, jtf
1344 do k = kts, kte
1345 do i = its, itf
1346 g_rw(i,k,j) = g_mut(i,j)*(w(i,k,j)/msft(i,j))+g_w(i,k,j)*(mut(i,j)/msft(i,j))
1347 rw(i,k,j) = w(i,k,j)*mut(i,j)/msft(i,j)
1348 end do
1349 end do
1350 end do
1351
1352 end subroutine g_couple_momentum
1353
1354
1355 subroutine g_curvature( ru, g_ru, rv, g_rv, rw, g_rw, u, g_u, v, g_v, ru_tend, g_ru_tend, rv_tend, g_rv_tend, rw_tend, g_rw_tend, &
1356 &config_flags, msfu, msfv, fzm, fzp, rdx, rdy, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1357 !******************************************************************
1358 !******************************************************************
1359 !** This routine was generated by Automatic differentiation. **
1360 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1361 !******************************************************************
1362 !******************************************************************
1363 !==============================================
1364 ! all entries are defined explicitly
1365 !==============================================
1366 implicit none
1367
1368 !==============================================
1369 ! declare arguments
1370 !==============================================
1371 type (grid_config_rec_type), intent(in) :: config_flags
1372 integer, intent(in) :: kme
1373 integer, intent(in) :: kms
1374 real, intent(in) :: fzm(kms:kme)
1375 real, intent(in) :: fzp(kms:kme)
1376 integer, intent(in) :: ime
1377 integer, intent(in) :: ims
1378 integer, intent(in) :: jme
1379 integer, intent(in) :: jms
1380 real, intent(in) :: g_ru(ims:ime,kms:kme,jms:jme)
1381 real, intent(inout) :: g_ru_tend(ims:ime,kms:kme,jms:jme)
1382 real, intent(in) :: g_rv(ims:ime,kms:kme,jms:jme)
1383 real, intent(inout) :: g_rv_tend(ims:ime,kms:kme,jms:jme)
1384 real, intent(in) :: g_rw(ims:ime,kms:kme,jms:jme)
1385 real, intent(inout) :: g_rw_tend(ims:ime,kms:kme,jms:jme)
1386 real, intent(in) :: g_u(ims:ime,kms:kme,jms:jme)
1387 real, intent(in) :: g_v(ims:ime,kms:kme,jms:jme)
1388 integer, intent(in) :: ide
1389 integer, intent(in) :: ids
1390 integer, intent(in) :: ite
1391 integer, intent(in) :: its
1392 integer, intent(in) :: jde
1393 integer, intent(in) :: jds
1394 integer, intent(in) :: jte
1395 integer, intent(in) :: jts
1396 integer, intent(in) :: kde
1397 integer, intent(in) :: kte
1398 integer, intent(in) :: kts
1399 real, intent(in) :: msfu(ims:ime,jms:jme)
1400 real, intent(in) :: msfv(ims:ime,jms:jme)
1401 real, intent(in) :: rdx
1402 real, intent(in) :: rdy
1403 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
1404 real, intent(inout) :: ru_tend(ims:ime,kms:kme,jms:jme)
1405 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
1406 real, intent(inout) :: rv_tend(ims:ime,kms:kme,jms:jme)
1407 real, intent(in) :: rw(ims:ime,kms:kme,jms:jme)
1408 real, intent(inout) :: rw_tend(ims:ime,kms:kme,jms:jme)
1409 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
1410 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
1411
1412 !==============================================
1413 ! declare local variables
1414 !==============================================
1415 real g_vxgm(its-1:ite,kts:kte,jts-1:jte)
1416 integer i
1417 integer i_end
1418 integer i_start
1419 integer j
1420 integer j_end
1421 integer j_start
1422 integer k
1423 integer ktf
1424 logical specified
1425 real vxgm(its-1:ite,kts:kte,jts-1:jte)
1426
1427 !----------------------------------------------
1428 ! TANGENT LINEAR AND FUNCTION STATEMENTS
1429 !----------------------------------------------
1430 specified = .false.
1431 if (config_flags%specified .or. config_flags%nested) then
1432 specified = .true.
1433 endif
1434 ktf = min(kte,kde-1)
1435 i_start = its-1
1436 i_end = ite
1437 j_start = jts-1
1438 j_end = jte
1439 if ((config_flags%open_xs .or. specified .or. config_flags%nested) .and. its .eq. ids) then
1440 i_start = its
1441 endif
1442 if ((config_flags%open_xe .or. specified .or. config_flags%nested) .and. ite .eq. ide) then
1443 i_end = ite-1
1444 endif
1445 if ((config_flags%open_ys .or. specified .or. config_flags%nested) .and. jts .eq. jds) then
1446 j_start = jts
1447 endif
1448 if ((config_flags%open_ye .or. specified .or. config_flags%nested) .and. jte .eq. jde) then
1449 j_end = jte-1
1450 endif
1451 do j = j_start, j_end
1452 do k = kts, ktf
1453 do i = i_start, i_end
1454 g_vxgm(i,k,j) = 0.5*g_u(i+1,k,j)*(msfv(i,j+1)-msfv(i,j))*rdy+0.5*g_u(i,k,j)*(msfv(i,j+1)-msfv(i,j))*rdy-0.5*g_v(i,k,j+1)*&
1455 &(msfu(i+1,j)-msfu(i,j))*rdx-0.5*g_v(i,k,j)*(msfu(i+1,j)-msfu(i,j))*rdx
1456 vxgm(i,k,j) = 0.5*(u(i,k,j)+u(i+1,k,j))*(msfv(i,j+1)-msfv(i,j))*rdy-0.5*(v(i,k,j)+v(i,k,j+1))*(msfu(i+1,j)-msfu(i,j))*rdx
1457 end do
1458 end do
1459 end do
1460 if ((config_flags%open_xs .or. specified .or. config_flags%nested) .and. its .eq. ids) then
1461 do j = jts-1, jte
1462 do k = kts, ktf
1463 g_vxgm(its-1,k,j) = g_vxgm(its,k,j)
1464 vxgm(its-1,k,j) = vxgm(its,k,j)
1465 end do
1466 end do
1467 endif
1468 if ((config_flags%open_xe .or. specified .or. config_flags%nested) .and. ite .eq. ide) then
1469 do j = jts-1, jte
1470 do k = kts, ktf
1471 g_vxgm(ite,k,j) = g_vxgm(ite-1,k,j)
1472 vxgm(ite,k,j) = vxgm(ite-1,k,j)
1473 end do
1474 end do
1475 endif
1476 if ((config_flags%open_ys .or. specified .or. config_flags%nested) .and. jts .eq. jds) then
1477 do k = kts, ktf
1478 do i = its-1, ite
1479 g_vxgm(i,k,jts-1) = g_vxgm(i,k,jts)
1480 vxgm(i,k,jts-1) = vxgm(i,k,jts)
1481 end do
1482 end do
1483 endif
1484 if ((config_flags%open_ye .or. specified .or. config_flags%nested) .and. jte .eq. jde) then
1485 do k = kts, ktf
1486 do i = its-1, ite
1487 g_vxgm(i,k,jte) = g_vxgm(i,k,jte-1)
1488 vxgm(i,k,jte) = vxgm(i,k,jte-1)
1489 end do
1490 end do
1491 endif
1492 i_start = its
1493 if (config_flags%open_xs .or. specified .or. config_flags%nested) then
1494 i_start = max(ids+1,its)
1495 endif
1496 if (config_flags%open_xe .or. specified .or. config_flags%nested) then
1497 i_end = min(ide-1,ite)
1498 endif
1499 do j = jts, min(jde-1,jte)
1500 do k = kts, ktf
1501 do i = i_start, i_end
1502 g_ru_tend(i,k,j) = g_ru_tend(i,k,j)+0.125*g_rv(i-1,k,j+1)*(vxgm(i,k,j)+vxgm(i-1,k,j))+0.125*g_rv(i,k,j+1)*(vxgm(i,k,j)+&
1503 &vxgm(i-1,k,j))+0.125*g_rv(i-1,k,j)*(vxgm(i,k,j)+vxgm(i-1,k,j))+0.125*g_rv(i,k,j)*(vxgm(i,k,j)+vxgm(i-1,k,j))-0.25*g_rw(i-1,&
1504 &k+1,j)*u(i,k,j)*reradius-0.25*g_rw(i,k+1,j)*u(i,k,j)*reradius-0.25*g_rw(i-1,k,j)*u(i,k,j)*reradius-0.25*g_rw(i,k,j)*u(i,k,j)&
1505 &*reradius-0.25*g_u(i,k,j)*reradius*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j))+0.125*g_vxgm(i-1,k,j)*(rv(i-1,k,j+1)+&
1506 &rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j))+0.125*g_vxgm(i,k,j)*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j))
1507 ru_tend(i,k,j) = ru_tend(i,k,j)+0.5*(vxgm(i,k,j)+vxgm(i-1,k,j))*0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j))-u(i,k,&
1508 &j)*reradius*0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j))
1509 end do
1510 end do
1511 end do
1512 j_start = jts
1513 if (config_flags%open_ys .or. specified .or. config_flags%nested) then
1514 j_start = max(jds+1,jts)
1515 endif
1516 if (config_flags%open_ye .or. specified .or. config_flags%nested) then
1517 j_end = min(jde-1,jte)
1518 endif
1519 do j = j_start, j_end
1520 do k = kts, ktf
1521 do i = its, min(ite,ide-1)
1522 g_rv_tend(i,k,j) = (-(0.125*g_ru(i+1,k,j-1)*(vxgm(i,k,j)+vxgm(i,k,j-1))))-0.125*g_ru(i,k,j-1)*(vxgm(i,k,j)+vxgm(i,k,j-1))-&
1523 &0.125*g_ru(i+1,k,j)*(vxgm(i,k,j)+vxgm(i,k,j-1))-0.125*g_ru(i,k,j)*(vxgm(i,k,j)+vxgm(i,k,j-1))+g_rv_tend(i,k,j)+0.25*g_rw(i,&
1524 &k+1,j-1)*v(i,k,j)*reradius+0.25*g_rw(i,k+1,j)*v(i,k,j)*reradius+0.25*g_rw(i,k,j-1)*v(i,k,j)*reradius+0.25*g_rw(i,k,j)*v(i,k,&
1525 &j)*reradius+0.25*g_v(i,k,j)*reradius*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j))-0.125*g_vxgm(i,k,j-1)*(ru(i,k,j)+&
1526 &ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1))-0.125*g_vxgm(i,k,j)*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1))
1527 rv_tend(i,k,j) = rv_tend(i,k,j)-0.5*(vxgm(i,k,j)+vxgm(i,k,j-1))*0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1))+v(i,k,&
1528 &j)*reradius*0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j))
1529 end do
1530 end do
1531 end do
1532 do j = jts, min(jte,jde-1)
1533 do k = max(2,kts), ktf
1534 do i = its, min(ite,ide-1)
1535 g_rw_tend(i,k,j) = 0.25*g_ru(i+1,k-1,j)*reradius*fzp(k)*(fzm(k)*(u(i,k,j)+u(i+1,k,j))+fzp(k)*(u(i,k-1,j)+u(i+1,k-1,j)))+0.25*&
1536 &g_ru(i,k-1,j)*reradius*fzp(k)*(fzm(k)*(u(i,k,j)+u(i+1,k,j))+fzp(k)*(u(i,k-1,j)+u(i+1,k-1,j)))+0.25*g_ru(i+1,k,j)*reradius*&
1537 &fzm(k)*(fzm(k)*(u(i,k,j)+u(i+1,k,j))+fzp(k)*(u(i,k-1,j)+u(i+1,k-1,j)))+0.25*g_ru(i,k,j)*reradius*fzm(k)*(fzm(k)*(u(i,k,j)+&
1538 &u(i+1,k,j))+fzp(k)*(u(i,k-1,j)+u(i+1,k-1,j)))+0.25*g_rv(i,k-1,j+1)*reradius*fzp(k)*(fzm(k)*(v(i,k,j)+v(i,k,j+1))+fzp(k)*&
1539 &(v(i,k-1,j)+v(i,k-1,j+1)))+0.25*g_rv(i,k-1,j)*reradius*fzp(k)*(fzm(k)*(v(i,k,j)+v(i,k,j+1))+fzp(k)*(v(i,k-1,j)+v(i,k-1,j+1))&
1540 &)+0.25*g_rv(i,k,j+1)*reradius*fzm(k)*(fzm(k)*(v(i,k,j)+v(i,k,j+1))+fzp(k)*(v(i,k-1,j)+v(i,k-1,j+1)))+0.25*g_rv(i,k,j)*&
1541 &reradius*fzm(k)*(fzm(k)*(v(i,k,j)+v(i,k,j+1))+fzp(k)*(v(i,k-1,j)+v(i,k-1,j+1)))+g_rw_tend(i,k,j)+0.25*g_u(i+1,k-1,j)*&
1542 &reradius*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j))+fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j)))*fzp(k)+0.25*g_u(i,k-1,j)*reradius*(fzm(k)*&
1543 &(ru(i,k,j)+ru(i+1,k,j))+fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j)))*fzp(k)+0.25*g_u(i+1,k,j)*reradius*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j)&
1544 &)+fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j)))*fzm(k)+0.25*g_u(i,k,j)*reradius*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j))+fzp(k)*(ru(i,k-1,j)+&
1545 &ru(i+1,k-1,j)))*fzm(k)+0.25*g_v(i,k-1,j+1)*reradius*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1))+fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1)))*&
1546 &fzp(k)+0.25*g_v(i,k-1,j)*reradius*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1))+fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1)))*fzp(k)+0.25*g_v(i,k,j+&
1547 &1)*reradius*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1))+fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1)))*fzm(k)+0.25*g_v(i,k,j)*reradius*(fzm(k)*&
1548 &(rv(i,k,j)+rv(i,k,j+1))+fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1)))*fzm(k)
1549 rw_tend(i,k,j) = rw_tend(i,k,j)+reradius*(0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j))+fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j)))*0.5*(fzm(k)&
1550 &*(u(i,k,j)+u(i+1,k,j))+fzp(k)*(u(i,k-1,j)+u(i+1,k-1,j)))+0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1))+fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+&
1551 &1)))*0.5*(fzm(k)*(v(i,k,j)+v(i,k,j+1))+fzp(k)*(v(i,k-1,j)+v(i,k-1,j+1))))
1552 end do
1553 end do
1554 end do
1555
1556 end subroutine g_curvature
1557
1558
1559 subroutine g_diagnose_w( ph_tend, g_ph_tend, ph_new, g_ph_new, ph_old, g_ph_old, w, g_w, mu, g_mu, dt, u, g_u, v, g_v, ht, cf1, &
1560 &cf2, cf3, rdx, rdy, msft, ide, jde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kte )
1561 !******************************************************************
1562 !******************************************************************
1563 !** This routine was generated by Automatic differentiation. **
1564 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1565 !******************************************************************
1566 !******************************************************************
1567 !==============================================
1568 ! all entries are defined explicitly
1569 !==============================================
1570 implicit none
1571
1572 !==============================================
1573 ! declare arguments
1574 !==============================================
1575 real, intent(in) :: cf1
1576 real, intent(in) :: cf2
1577 real, intent(in) :: cf3
1578 real, intent(in) :: dt
1579 integer, intent(in) :: ime
1580 integer, intent(in) :: ims
1581 integer, intent(in) :: jme
1582 integer, intent(in) :: jms
1583 real, intent(in) :: g_mu(ims:ime,jms:jme)
1584 integer, intent(in) :: kme
1585 integer, intent(in) :: kms
1586 real, intent(in) :: g_ph_new(ims:ime,kms:kme,jms:jme)
1587 real, intent(in) :: g_ph_old(ims:ime,kms:kme,jms:jme)
1588 real, intent(in) :: g_ph_tend(ims:ime,kms:kme,jms:jme)
1589 real, intent(in) :: g_u(ims:ime,kms:kme,jms:jme)
1590 real, intent(in) :: g_v(ims:ime,kms:kme,jms:jme)
1591 real, intent(out) :: g_w(ims:ime,kms:kme,jms:jme)
1592 real, intent(in) :: ht(ims:ime,jms:jme)
1593 integer, intent(in) :: ide
1594 integer, intent(in) :: ite
1595 integer, intent(in) :: its
1596 integer, intent(in) :: jde
1597 integer, intent(in) :: jte
1598 integer, intent(in) :: jts
1599 integer, intent(in) :: kte
1600 real, intent(in) :: msft(ims:ime,jms:jme)
1601 real, intent(in) :: mu(ims:ime,jms:jme)
1602 real, intent(in) :: ph_new(ims:ime,kms:kme,jms:jme)
1603 real, intent(in) :: ph_old(ims:ime,kms:kme,jms:jme)
1604 real, intent(in) :: ph_tend(ims:ime,kms:kme,jms:jme)
1605 real, intent(in) :: rdx
1606 real, intent(in) :: rdy
1607 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
1608 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
1609 real, intent(out) :: w(ims:ime,kms:kme,jms:jme)
1610
1611 !==============================================
1612 ! declare local variables
1613 !==============================================
1614 integer i
1615 integer itf
1616 integer j
1617 integer jtf
1618 integer k
1619
1620 !----------------------------------------------
1621 ! TANGENT LINEAR AND FUNCTION STATEMENTS
1622 !----------------------------------------------
1623 itf = min(ite,ide-1)
1624 jtf = min(jte,jde-1)
1625 do j = jts, jtf
1626 do i = its, itf
1627 g_w(i,1,j) = 0.5*g_u(i+1,3,j)*msft(i,j)*rdx*(ht(i+1,j)-ht(i,j))*cf3+0.5*g_u(i,3,j)*msft(i,j)*rdx*(ht(i,j)-ht(i,j-1))*cf3+0.5*&
1628 &g_u(i+1,2,j)*msft(i,j)*rdx*(ht(i+1,j)-ht(i,j))*cf2+0.5*g_u(i,2,j)*msft(i,j)*rdx*(ht(i,j)-ht(i,j-1))*cf2+0.5*g_u(i+1,1,j)*&
1629 &msft(i,j)*rdx*(ht(i+1,j)-ht(i,j))*cf1+0.5*g_u(i,1,j)*msft(i,j)*rdx*(ht(i,j)-ht(i,j-1))*cf1+0.5*g_v(i,3,j+1)*msft(i,j)*rdy*&
1630 &(ht(i,j+1)-ht(i,j))*cf3+0.5*g_v(i,3,j)*msft(i,j)*rdy*(ht(i,j)-ht(i,j-1))*cf3+0.5*g_v(i,2,j+1)*msft(i,j)*rdy*(ht(i,j+1)-ht(i,j)&
1631 &)*cf2+0.5*g_v(i,2,j)*msft(i,j)*rdy*(ht(i,j)-ht(i,j-1))*cf2+0.5*g_v(i,1,j+1)*msft(i,j)*rdy*(ht(i,j+1)-ht(i,j))*cf1+0.5*g_v(i,1,&
1632 &j)*msft(i,j)*rdy*(ht(i,j)-ht(i,j-1))*cf1
1633 w(i,1,j) = msft(i,j)*(0.5*rdy*((ht(i,j+1)-ht(i,j))*(cf1*v(i,1,j+1)+cf2*v(i,2,j+1)+cf3*v(i,3,j+1))+(ht(i,j)-ht(i,j-1))*(cf1*v(i,&
1634 &1,j)+cf2*v(i,2,j)+cf3*v(i,3,j)))+0.5*rdx*((ht(i+1,j)-ht(i,j))*(cf1*u(i+1,1,j)+cf2*u(i+1,2,j)+cf3*u(i+1,3,j))+(ht(i,j)-ht(i,j-&
1635 &1))*(cf1*u(i,1,j)+cf2*u(i,2,j)+cf3*u(i,3,j))))
1636 end do
1637 do k = 2, kte
1638 do i = its, itf
1639 g_w(i,k,j) = g_mu(i,j)*(msft(i,j)*(ph_tend(i,k,j)/(mu(i,j)*mu(i,j)))/g)+g_ph_new(i,k,j)*(msft(i,j)/dt/g)-g_ph_old(i,k,j)*&
1640 &(msft(i,j)/dt/g)-g_ph_tend(i,k,j)*(msft(i,j)/mu(i,j)/g)
1641 w(i,k,j) = msft(i,j)*((ph_new(i,k,j)-ph_old(i,k,j))/dt-ph_tend(i,k,j)/mu(i,j))/g
1642 end do
1643 end do
1644 end do
1645
1646 end subroutine g_diagnose_w
1647
1648
1649 subroutine g_horizontal_diffusion( name, field, g_field, tendency, g_tendency, mu, g_mu, config_flags, msfu, msfv, msft, xkmhd, &
1650 &g_xkmhd, rdx, rdy, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1651 !******************************************************************
1652 !******************************************************************
1653 !** This routine was generated by Automatic differentiation. **
1654 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1655 !******************************************************************
1656 !******************************************************************
1657 !==============================================
1658 ! all entries are defined explicitly
1659 !==============================================
1660 implicit none
1661
1662 !==============================================
1663 ! declare arguments
1664 !==============================================
1665 type (grid_config_rec_type), intent(in) :: config_flags
1666 integer, intent(in) :: ime
1667 integer, intent(in) :: ims
1668 integer, intent(in) :: jme
1669 integer, intent(in) :: jms
1670 integer, intent(in) :: kme
1671 integer, intent(in) :: kms
1672 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
1673 real, intent(in) :: g_field(ims:ime,kms:kme,jms:jme)
1674 real, intent(in) :: g_mu(ims:ime,jms:jme)
1675 real, intent(inout) :: g_tendency(ims:ime,kms:kme,jms:jme)
1676 real, intent(in) :: g_xkmhd(ims:ime,kms:kme,jms:jme)
1677 integer, intent(in) :: ide
1678 integer, intent(in) :: ids
1679 integer, intent(in) :: ite
1680 integer, intent(in) :: its
1681 integer, intent(in) :: jde
1682 integer, intent(in) :: jds
1683 integer, intent(in) :: jte
1684 integer, intent(in) :: jts
1685 integer, intent(in) :: kde
1686 integer, intent(in) :: kte
1687 integer, intent(in) :: kts
1688 real, intent(in) :: msft(ims:ime,jms:jme)
1689 real, intent(in) :: msfu(ims:ime,jms:jme)
1690 real, intent(in) :: msfv(ims:ime,jms:jme)
1691 real, intent(in) :: mu(ims:ime,jms:jme)
1692 character*(1), intent(in) :: name
1693 real, intent(in) :: rdx
1694 real, intent(in) :: rdy
1695 real, intent(inout) :: tendency(ims:ime,kms:kme,jms:jme)
1696 real, intent(in) :: xkmhd(ims:ime,kms:kme,jms:jme)
1697
1698 !==============================================
1699 ! declare local variables
1700 !==============================================
1701 real g_mkrdxm
1702 real g_mkrdxp
1703 real g_mkrdym
1704 real g_mkrdyp
1705 real g_rcoup
1706 integer i
1707 integer i_end
1708 integer i_start
1709 integer j
1710 integer j_end
1711 integer j_start
1712 integer k
1713 integer ktf
1714 real mkrdxm
1715 real mkrdxp
1716 real mkrdym
1717 real mkrdyp
1718 real mrdx
1719 real mrdy
1720 real :: pr = 3.
1721 real rcoup
1722 logical specified
1723
1724 !----------------------------------------------
1725 ! TANGENT LINEAR AND FUNCTION STATEMENTS
1726 !----------------------------------------------
1727 specified = .false.
1728 if (config_flags%specified .or. config_flags%nested) then
1729 specified = .true.
1730 endif
1731 ktf = min(kte,kde-1)
1732 if (name .eq. 'u') then
1733 i_start = its
1734 i_end = ite
1735 j_start = jts
1736 j_end = min(jte,jde-1)
1737 if (config_flags%open_xs .or. specified) then
1738 i_start = max(ids+1,its)
1739 endif
1740 if (config_flags%open_xe .or. specified) then
1741 i_end = min(ide-1,ite)
1742 endif
1743 if (config_flags%open_ys .or. specified) then
1744 j_start = max(jds+1,jts)
1745 endif
1746 if (config_flags%open_ye .or. specified) then
1747 j_end = min(jde-2,jte)
1748 endif
1749 do j = j_start, j_end
1750 do k = kts, ktf
1751 do i = i_start, i_end
1752 g_mkrdxm = g_xkmhd(i-1,k,j)*msft(i-1,j)*rdx
1753 mkrdxm = msft(i-1,j)*xkmhd(i-1,k,j)*rdx
1754 g_mkrdxp = g_xkmhd(i,k,j)*msft(i,j)*rdx
1755 mkrdxp = msft(i,j)*xkmhd(i,k,j)*rdx
1756 mrdx = msfu(i,j)*rdx
1757 g_mkrdym = 0.125*g_xkmhd(i-1,k,j-1)*(msfu(i,j)+msfu(i,j-1))*rdy+0.125*g_xkmhd(i,k,j-1)*(msfu(i,j)+msfu(i,j-1))*rdy+0.125*&
1758 &g_xkmhd(i-1,k,j)*(msfu(i,j)+msfu(i,j-1))*rdy+0.125*g_xkmhd(i,k,j)*(msfu(i,j)+msfu(i,j-1))*rdy
1759 mkrdym = 0.5*(msfu(i,j)+msfu(i,j-1))*0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i-1,k,j-1)+xkmhd(i-1,k,j))*rdy
1760 g_mkrdyp = 0.125*g_xkmhd(i-1,k,j+1)*(msfu(i,j)+msfu(i,j+1))*rdy+0.125*g_xkmhd(i,k,j+1)*(msfu(i,j)+msfu(i,j+1))*rdy+0.125*&
1761 &g_xkmhd(i-1,k,j)*(msfu(i,j)+msfu(i,j+1))*rdy+0.125*g_xkmhd(i,k,j)*(msfu(i,j)+msfu(i,j+1))*rdy
1762 mkrdyp = 0.5*(msfu(i,j)+msfu(i,j+1))*0.25*(xkmhd(i,k,j)+xkmhd(i,k,j+1)+xkmhd(i-1,k,j+1)+xkmhd(i-1,k,j))*rdy
1763 mrdy = msfu(i,j)*rdy
1764 g_rcoup = 0.5*g_mu(i-1,j)+0.5*g_mu(i,j)
1765 rcoup = 0.5*(mu(i,j)+mu(i-1,j))
1766 g_tendency(i,k,j) = g_field(i,k,j-1)*rcoup*mrdy*mkrdym+g_field(i,k,j+1)*rcoup*mrdy*mkrdyp+g_field(i-1,k,j)*rcoup*mrdx*&
1767 &mkrdxm+g_field(i+1,k,j)*rcoup*mrdx*mkrdxp+g_field(i,k,j)*rcoup*((-(mrdx*(mkrdxp+mkrdxm)))-mrdy*(mkrdyp+mkrdym))-g_mkrdxm*&
1768 &rcoup*mrdx*(field(i,k,j)-field(i-1,k,j))+g_mkrdxp*rcoup*mrdx*(field(i+1,k,j)-field(i,k,j))-g_mkrdym*rcoup*mrdy*(field(i,k,&
1769 &j)-field(i,k,j-1))+g_mkrdyp*rcoup*mrdy*(field(i,k,j+1)-field(i,k,j))+g_rcoup*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j))-&
1770 &mkrdxm*(field(i,k,j)-field(i-1,k,j)))+mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1))))+&
1771 &g_tendency(i,k,j)
1772 tendency(i,k,j) = tendency(i,k,j)+rcoup*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j))-mkrdxm*(field(i,k,j)-field(i-1,k,j)))+&
1773 &mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1))))
1774 end do
1775 end do
1776 end do
1777 else if (name .eq. 'v') then
1778 i_start = its
1779 i_end = min(ite,ide-1)
1780 j_start = jts
1781 j_end = jte
1782 if (config_flags%open_xs .or. specified) then
1783 i_start = max(ids+1,its)
1784 endif
1785 if (config_flags%open_xe .or. specified) then
1786 i_end = min(ide-2,ite)
1787 endif
1788 if (config_flags%open_ys .or. specified) then
1789 j_start = max(jds+1,jts)
1790 endif
1791 if (config_flags%open_ye .or. specified) then
1792 j_end = min(jde-1,jte)
1793 endif
1794 do j = j_start, j_end
1795 do k = kts, ktf
1796 do i = i_start, i_end
1797 g_mkrdxm = 0.125*g_xkmhd(i-1,k,j-1)*(msfv(i,j)+msfv(i-1,j))*rdx+0.125*g_xkmhd(i,k,j-1)*(msfv(i,j)+msfv(i-1,j))*rdx+0.125*&
1798 &g_xkmhd(i-1,k,j)*(msfv(i,j)+msfv(i-1,j))*rdx+0.125*g_xkmhd(i,k,j)*(msfv(i,j)+msfv(i-1,j))*rdx
1799 mkrdxm = 0.5*(msfv(i,j)+msfv(i-1,j))*0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i-1,k,j-1)+xkmhd(i-1,k,j))*rdx
1800 g_mkrdxp = 0.125*g_xkmhd(i+1,k,j-1)*(msfv(i,j)+msfv(i+1,j))*rdx+0.125*g_xkmhd(i,k,j-1)*(msfv(i,j)+msfv(i+1,j))*rdx+0.125*&
1801 &g_xkmhd(i+1,k,j)*(msfv(i,j)+msfv(i+1,j))*rdx+0.125*g_xkmhd(i,k,j)*(msfv(i,j)+msfv(i+1,j))*rdx
1802 mkrdxp = 0.5*(msfv(i,j)+msfv(i+1,j))*0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i+1,k,j-1)+xkmhd(i+1,k,j))*rdx
1803 mrdx = msfv(i,j)*rdx
1804 g_mkrdym = g_xkmhd(i,k,j-1)*msft(i,j-1)*rdy
1805 mkrdym = msft(i,j-1)*xkmhd(i,k,j-1)*rdy
1806 g_mkrdyp = g_xkmhd(i,k,j)*msft(i,j)*rdy
1807 mkrdyp = msft(i,j)*xkmhd(i,k,j)*rdy
1808 mrdy = msfv(i,j)*rdy
1809 g_rcoup = 0.5*g_mu(i,j-1)+0.5*g_mu(i,j)
1810 rcoup = 0.5*(mu(i,j)+mu(i,j-1))
1811 g_tendency(i,k,j) = g_field(i,k,j-1)*rcoup*mrdy*mkrdym+g_field(i,k,j+1)*rcoup*mrdy*mkrdyp+g_field(i-1,k,j)*rcoup*mrdx*&
1812 &mkrdxm+g_field(i+1,k,j)*rcoup*mrdx*mkrdxp+g_field(i,k,j)*rcoup*((-(mrdx*(mkrdxp+mkrdxm)))-mrdy*(mkrdyp+mkrdym))-g_mkrdxm*&
1813 &rcoup*mrdx*(field(i,k,j)-field(i-1,k,j))+g_mkrdxp*rcoup*mrdx*(field(i+1,k,j)-field(i,k,j))-g_mkrdym*rcoup*mrdy*(field(i,k,&
1814 &j)-field(i,k,j-1))+g_mkrdyp*rcoup*mrdy*(field(i,k,j+1)-field(i,k,j))+g_rcoup*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j))-&
1815 &mkrdxm*(field(i,k,j)-field(i-1,k,j)))+mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1))))+&
1816 &g_tendency(i,k,j)
1817 tendency(i,k,j) = tendency(i,k,j)+rcoup*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j))-mkrdxm*(field(i,k,j)-field(i-1,k,j)))+&
1818 &mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1))))
1819 end do
1820 end do
1821 end do
1822 else if (name .eq. 'w') then
1823 i_start = its
1824 i_end = min(ite,ide-1)
1825 j_start = jts
1826 j_end = min(jte,jde-1)
1827 if (config_flags%open_xs .or. specified) then
1828 i_start = max(ids+1,its)
1829 endif
1830 if (config_flags%open_xe .or. specified) then
1831 i_end = min(ide-2,ite)
1832 endif
1833 if (config_flags%open_ys .or. specified) then
1834 j_start = max(jds+1,jts)
1835 endif
1836 if (config_flags%open_ye .or. specified) then
1837 j_end = min(jde-2,jte)
1838 endif
1839 do j = j_start, j_end
1840 do k = kts+1, ktf
1841 do i = i_start, i_end
1842 g_mkrdxm = 0.25*g_xkmhd(i-1,k-1,j)*msfu(i,j)*rdx+0.25*g_xkmhd(i,k-1,j)*msfu(i,j)*rdx+0.25*g_xkmhd(i-1,k,j)*msfu(i,j)*rdx+&
1843 &0.25*g_xkmhd(i,k,j)*msfu(i,j)*rdx
1844 mkrdxm = msfu(i,j)*0.25*(xkmhd(i,k,j)+xkmhd(i-1,k,j)+xkmhd(i,k-1,j)+xkmhd(i-1,k-1,j))*rdx
1845 g_mkrdxp = 0.25*g_xkmhd(i+1,k-1,j)*msfu(i+1,j)*rdx+0.25*g_xkmhd(i,k-1,j)*msfu(i+1,j)*rdx+0.25*g_xkmhd(i+1,k,j)*msfu(i+1,j)*&
1846 &rdx+0.25*g_xkmhd(i,k,j)*msfu(i+1,j)*rdx
1847 mkrdxp = msfu(i+1,j)*0.25*(xkmhd(i+1,k,j)+xkmhd(i,k,j)+xkmhd(i+1,k-1,j)+xkmhd(i,k-1,j))*rdx
1848 mrdx = msft(i,j)*rdx
1849 g_mkrdym = 0.25*g_xkmhd(i,k-1,j-1)*msfv(i,j)*rdy+0.25*g_xkmhd(i,k-1,j)*msfv(i,j)*rdy+0.25*g_xkmhd(i,k,j-1)*msfv(i,j)*rdy+&
1850 &0.25*g_xkmhd(i,k,j)*msfv(i,j)*rdy
1851 mkrdym = msfv(i,j)*0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i,k-1,j)+xkmhd(i,k-1,j-1))*rdy
1852 g_mkrdyp = 0.25*g_xkmhd(i,k-1,j+1)*msfv(i,j+1)*rdy+0.25*g_xkmhd(i,k-1,j)*msfv(i,j+1)*rdy+0.25*g_xkmhd(i,k,j+1)*msfv(i,j+1)*&
1853 &rdy+0.25*g_xkmhd(i,k,j)*msfv(i,j+1)*rdy
1854 mkrdyp = msfv(i,j+1)*0.25*(xkmhd(i,k,j+1)+xkmhd(i,k,j)+xkmhd(i,k-1,j+1)+xkmhd(i,k-1,j))*rdy
1855 mrdy = msft(i,j)*rdy
1856 g_rcoup = g_mu(i,j)
1857 rcoup = 0.5*(mu(i,j)+mu(i,j))
1858 g_tendency(i,k,j) = g_field(i,k,j-1)*rcoup*mrdy*mkrdym+g_field(i,k,j+1)*rcoup*mrdy*mkrdyp+g_field(i-1,k,j)*rcoup*mrdx*&
1859 &mkrdxm+g_field(i+1,k,j)*rcoup*mrdx*mkrdxp+g_field(i,k,j)*rcoup*((-(mrdx*(mkrdxp+mkrdxm)))-mrdy*(mkrdyp+mkrdym))-g_mkrdxm*&
1860 &rcoup*mrdx*(field(i,k,j)-field(i-1,k,j))+g_mkrdxp*rcoup*mrdx*(field(i+1,k,j)-field(i,k,j))-g_mkrdym*rcoup*mrdy*(field(i,k,&
1861 &j)-field(i,k,j-1))+g_mkrdyp*rcoup*mrdy*(field(i,k,j+1)-field(i,k,j))+g_rcoup*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j))-&
1862 &mkrdxm*(field(i,k,j)-field(i-1,k,j)))+mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1))))+&
1863 &g_tendency(i,k,j)
1864 tendency(i,k,j) = tendency(i,k,j)+rcoup*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j))-mkrdxm*(field(i,k,j)-field(i-1,k,j)))+&
1865 &mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1))))
1866 end do
1867 end do
1868 end do
1869 else
1870 i_start = its
1871 i_end = min(ite,ide-1)
1872 j_start = jts
1873 j_end = min(jte,jde-1)
1874 if (config_flags%open_xs .or. specified) then
1875 i_start = max(ids+1,its)
1876 endif
1877 if (config_flags%open_xe .or. specified) then
1878 i_end = min(ide-2,ite)
1879 endif
1880 if (config_flags%open_ys .or. specified) then
1881 j_start = max(jds+1,jts)
1882 endif
1883 if (config_flags%open_ye .or. specified) then
1884 j_end = min(jde-2,jte)
1885 endif
1886 do j = j_start, j_end
1887 do k = kts, ktf
1888 do i = i_start, i_end
1889 g_mkrdxm = 0.5*g_xkmhd(i-1,k,j)*msfu(i,j)*rdx*pr+0.5*g_xkmhd(i,k,j)*msfu(i,j)*rdx*pr
1890 mkrdxm = msfu(i,j)*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*rdx*pr
1891 g_mkrdxp = 0.5*g_xkmhd(i+1,k,j)*msfu(i+1,j)*rdx*pr+0.5*g_xkmhd(i,k,j)*msfu(i+1,j)*rdx*pr
1892 mkrdxp = msfu(i+1,j)*0.5*(xkmhd(i+1,k,j)+xkmhd(i,k,j))*rdx*pr
1893 mrdx = msft(i,j)*rdx
1894 g_mkrdym = 0.5*g_xkmhd(i,k,j-1)*msfv(i,j)*rdy*pr+0.5*g_xkmhd(i,k,j)*msfv(i,j)*rdy*pr
1895 mkrdym = msfv(i,j)*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*rdy*pr
1896 g_mkrdyp = 0.5*g_xkmhd(i,k,j+1)*msfv(i,j+1)*rdy*pr+0.5*g_xkmhd(i,k,j)*msfv(i,j+1)*rdy*pr
1897 mkrdyp = msfv(i,j+1)*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*rdy*pr
1898 mrdy = msft(i,j)*rdy
1899 g_rcoup = g_mu(i,j)
1900 rcoup = mu(i,j)
1901 g_tendency(i,k,j) = g_field(i,k,j-1)*rcoup*mrdy*mkrdym+g_field(i,k,j+1)*rcoup*mrdy*mkrdyp+g_field(i-1,k,j)*rcoup*mrdx*&
1902 &mkrdxm+g_field(i+1,k,j)*rcoup*mrdx*mkrdxp+g_field(i,k,j)*rcoup*((-(mrdx*(mkrdxp+mkrdxm)))-mrdy*(mkrdyp+mkrdym))-g_mkrdxm*&
1903 &rcoup*mrdx*(field(i,k,j)-field(i-1,k,j))+g_mkrdxp*rcoup*mrdx*(field(i+1,k,j)-field(i,k,j))-g_mkrdym*rcoup*mrdy*(field(i,k,&
1904 &j)-field(i,k,j-1))+g_mkrdyp*rcoup*mrdy*(field(i,k,j+1)-field(i,k,j))+g_rcoup*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j))-&
1905 &mkrdxm*(field(i,k,j)-field(i-1,k,j)))+mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1))))+&
1906 &g_tendency(i,k,j)
1907 tendency(i,k,j) = tendency(i,k,j)+rcoup*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j))-mkrdxm*(field(i,k,j)-field(i-1,k,j)))+&
1908 &mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1))))
1909 end do
1910 end do
1911 end do
1912 endif
1913
1914 end subroutine g_horizontal_diffusion
1915
1916
1917 subroutine g_horizontal_diffusion_3dmp( field, g_field, tendency, g_tendency, mu, g_mu, config_flags, base_3d, msfu, msfv, msft, &
1918 &xkmhd, g_xkmhd, rdx, rdy, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1919 !******************************************************************
1920 !******************************************************************
1921 !** This routine was generated by Automatic differentiation. **
1922 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1923 !******************************************************************
1924 !******************************************************************
1925 !==============================================
1926 ! all entries are defined explicitly
1927 !==============================================
1928 implicit none
1929
1930 !==============================================
1931 ! declare arguments
1932 !==============================================
1933 integer, intent(in) :: ime
1934 integer, intent(in) :: ims
1935 integer, intent(in) :: jme
1936 integer, intent(in) :: jms
1937 integer, intent(in) :: kme
1938 integer, intent(in) :: kms
1939 real, intent(in) :: base_3d(ims:ime,kms:kme,jms:jme)
1940 type (grid_config_rec_type), intent(in) :: config_flags
1941 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
1942 real, intent(in) :: g_field(ims:ime,kms:kme,jms:jme)
1943 real, intent(in) :: g_mu(ims:ime,jms:jme)
1944 real, intent(inout) :: g_tendency(ims:ime,kms:kme,jms:jme)
1945 real, intent(in) :: g_xkmhd(ims:ime,kms:kme,jms:jme)
1946 integer, intent(in) :: ide
1947 integer, intent(in) :: ids
1948 integer, intent(in) :: ite
1949 integer, intent(in) :: its
1950 integer, intent(in) :: jde
1951 integer, intent(in) :: jds
1952 integer, intent(in) :: jte
1953 integer, intent(in) :: jts
1954 integer, intent(in) :: kde
1955 integer, intent(in) :: kte
1956 integer, intent(in) :: kts
1957 real, intent(in) :: msft(ims:ime,jms:jme)
1958 real, intent(in) :: msfu(ims:ime,jms:jme)
1959 real, intent(in) :: msfv(ims:ime,jms:jme)
1960 real, intent(in) :: mu(ims:ime,jms:jme)
1961 real, intent(in) :: rdx
1962 real, intent(in) :: rdy
1963 real, intent(inout) :: tendency(ims:ime,kms:kme,jms:jme)
1964 real, intent(in) :: xkmhd(ims:ime,kms:kme,jms:jme)
1965
1966 !==============================================
1967 ! declare local variables
1968 !==============================================
1969 real g_mkrdxm
1970 real g_mkrdxp
1971 real g_mkrdym
1972 real g_mkrdyp
1973 real g_rcoup
1974 integer i
1975 integer i_end
1976 integer i_start
1977 integer j
1978 integer j_end
1979 integer j_start
1980 integer k
1981 integer ktf
1982 real mkrdxm
1983 real mkrdxp
1984 real mkrdym
1985 real mkrdyp
1986 real mrdx
1987 real mrdy
1988 real :: pr = 3.
1989 real rcoup
1990 logical specified
1991
1992 !----------------------------------------------
1993 ! TANGENT LINEAR AND FUNCTION STATEMENTS
1994 !----------------------------------------------
1995 specified = .false.
1996 if (config_flags%specified .or. config_flags%nested) then
1997 specified = .true.
1998 endif
1999 ktf = min(kte,kde-1)
2000 i_start = its
2001 i_end = min(ite,ide-1)
2002 j_start = jts
2003 j_end = min(jte,jde-1)
2004 if (config_flags%open_xs .or. specified) then
2005 i_start = max(ids+1,its)
2006 endif
2007 if (config_flags%open_xe .or. specified) then
2008 i_end = min(ide-2,ite)
2009 endif
2010 if (config_flags%open_ys .or. specified) then
2011 j_start = max(jds+1,jts)
2012 endif
2013 if (config_flags%open_ye .or. specified) then
2014 j_end = min(jde-2,jte)
2015 endif
2016 do j = j_start, j_end
2017 do k = kts, ktf
2018 do i = i_start, i_end
2019 g_mkrdxm = 0.5*g_xkmhd(i-1,k,j)*msfu(i,j)*rdx*pr+0.5*g_xkmhd(i,k,j)*msfu(i,j)*rdx*pr
2020 mkrdxm = msfu(i,j)*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*rdx*pr
2021 g_mkrdxp = 0.5*g_xkmhd(i+1,k,j)*msfu(i+1,j)*rdx*pr+0.5*g_xkmhd(i,k,j)*msfu(i+1,j)*rdx*pr
2022 mkrdxp = msfu(i+1,j)*0.5*(xkmhd(i+1,k,j)+xkmhd(i,k,j))*rdx*pr
2023 mrdx = msft(i,j)*rdx
2024 g_mkrdym = 0.5*g_xkmhd(i,k,j-1)*msfv(i,j)*rdy*pr+0.5*g_xkmhd(i,k,j)*msfv(i,j)*rdy*pr
2025 mkrdym = msfv(i,j)*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*rdy*pr
2026 g_mkrdyp = 0.5*g_xkmhd(i,k,j+1)*msfv(i,j+1)*rdy*pr+0.5*g_xkmhd(i,k,j)*msfv(i,j+1)*rdy*pr
2027 mkrdyp = msfv(i,j+1)*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*rdy*pr
2028 mrdy = msft(i,j)*rdy
2029 g_rcoup = g_mu(i,j)
2030 rcoup = mu(i,j)
2031 g_tendency(i,k,j) = g_field(i,k,j-1)*rcoup*mrdy*mkrdym+g_field(i,k,j+1)*rcoup*mrdy*mkrdyp+g_field(i-1,k,j)*rcoup*mrdx*mkrdxm+&
2032 &g_field(i+1,k,j)*rcoup*mrdx*mkrdxp+g_field(i,k,j)*rcoup*((-(mrdx*(mkrdxp+mkrdxm)))-mrdy*(mkrdyp+mkrdym))-g_mkrdxm*rcoup*&
2033 &mrdx*(field(i,k,j)-field(i-1,k,j)-base_3d(i,k,j)+base_3d(i-1,k,j))+g_mkrdxp*rcoup*mrdx*(field(i+1,k,j)-field(i,k,j)-&
2034 &base_3d(i+1,k,j)+base_3d(i,k,j))-g_mkrdym*rcoup*mrdy*(field(i,k,j)-field(i,k,j-1)-base_3d(i,k,j)+base_3d(i,k,j-1))+g_mkrdyp*&
2035 &rcoup*mrdy*(field(i,k,j+1)-field(i,k,j)-base_3d(i,k,j+1)+base_3d(i,k,j))+g_rcoup*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j)-&
2036 &base_3d(i+1,k,j)+base_3d(i,k,j))-mkrdxm*(field(i,k,j)-field(i-1,k,j)-base_3d(i,k,j)+base_3d(i-1,k,j)))+mrdy*(mkrdyp*&
2037 &(field(i,k,j+1)-field(i,k,j)-base_3d(i,k,j+1)+base_3d(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1)-base_3d(i,k,j)+base_3d(i,&
2038 &k,j-1))))+g_tendency(i,k,j)
2039 tendency(i,k,j) = tendency(i,k,j)+rcoup*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j)-base_3d(i+1,k,j)+base_3d(i,k,j))-mkrdxm*&
2040 &(field(i,k,j)-field(i-1,k,j)-base_3d(i,k,j)+base_3d(i-1,k,j)))+mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j)-base_3d(i,k,j+1)+&
2041 &base_3d(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1)-base_3d(i,k,j)+base_3d(i,k,j-1))))
2042 end do
2043 end do
2044 end do
2045
2046 end subroutine g_horizontal_diffusion_3dmp
2047
2048
2049 subroutine g_horizontal_pressure_gradient( ru_tend, g_ru_tend, rv_tend, g_rv_tend, ph, g_ph, alt, g_alt, p, g_p, pb, al, g_al, php,&
2050 & g_php, cqu, g_cqu, cqv, g_cqv, muu, g_muu, muv, g_muv, mu, g_mu, fnm, fnp, rdnw, cf1, cf2, cf3, rdx, rdy, config_flags, &
2051 &non_hydrostatic, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kte )
2052 !******************************************************************
2053 !******************************************************************
2054 !** This routine was generated by Automatic differentiation. **
2055 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
2056 !******************************************************************
2057 !******************************************************************
2058 !==============================================
2059 ! all entries are defined explicitly
2060 !==============================================
2061 implicit none
2062
2063 !==============================================
2064 ! declare arguments
2065 !==============================================
2066 integer, intent(in) :: ime
2067 integer, intent(in) :: ims
2068 integer, intent(in) :: jme
2069 integer, intent(in) :: jms
2070 integer, intent(in) :: kme
2071 integer, intent(in) :: kms
2072 real, intent(in) :: al(ims:ime,kms:kme,jms:jme)
2073 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
2074 real, intent(in) :: cf1
2075 real, intent(in) :: cf2
2076 real, intent(in) :: cf3
2077 type (grid_config_rec_type), intent(in) :: config_flags
2078 real, intent(in) :: cqu(ims:ime,kms:kme,jms:jme)
2079 real, intent(in) :: cqv(ims:ime,kms:kme,jms:jme)
2080 real, intent(in) :: fnm(kms:kme)
2081 real, intent(in) :: fnp(kms:kme)
2082 real, intent(in) :: g_al(ims:ime,kms:kme,jms:jme)
2083 real, intent(in) :: g_alt(ims:ime,kms:kme,jms:jme)
2084 real, intent(in) :: g_cqu(ims:ime,kms:kme,jms:jme)
2085 real, intent(in) :: g_cqv(ims:ime,kms:kme,jms:jme)
2086 real, intent(in) :: g_mu(ims:ime,jms:jme)
2087 real, intent(in) :: g_muu(ims:ime,jms:jme)
2088 real, intent(in) :: g_muv(ims:ime,jms:jme)
2089 real, intent(in) :: g_p(ims:ime,kms:kme,jms:jme)
2090 real, intent(in) :: g_ph(ims:ime,kms:kme,jms:jme)
2091 real, intent(in) :: g_php(ims:ime,kms:kme,jms:jme)
2092 real, intent(inout) :: g_ru_tend(ims:ime,kms:kme,jms:jme)
2093 real, intent(inout) :: g_rv_tend(ims:ime,kms:kme,jms:jme)
2094 integer, intent(in) :: ide
2095 integer, intent(in) :: ids
2096 integer, intent(in) :: ite
2097 integer, intent(in) :: its
2098 integer, intent(in) :: jde
2099 integer, intent(in) :: jds
2100 integer, intent(in) :: jte
2101 integer, intent(in) :: jts
2102 integer, intent(in) :: kde
2103 integer, intent(in) :: kte
2104 real, intent(in) :: mu(ims:ime,jms:jme)
2105 real, intent(in) :: muu(ims:ime,jms:jme)
2106 real, intent(in) :: muv(ims:ime,jms:jme)
2107 logical, intent(in) :: non_hydrostatic
2108 real, intent(in) :: p(ims:ime,kms:kme,jms:jme)
2109 real, intent(in) :: pb(ims:ime,kms:kme,jms:jme)
2110 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
2111 real, intent(in) :: php(ims:ime,kms:kme,jms:jme)
2112 real, intent(in) :: rdnw(kms:kme)
2113 real, intent(in) :: rdx
2114 real, intent(in) :: rdy
2115 real, intent(inout) :: ru_tend(ims:ime,kms:kme,jms:jme)
2116 real, intent(inout) :: rv_tend(ims:ime,kms:kme,jms:jme)
2117
2118 !==============================================
2119 ! declare local variables
2120 !==============================================
2121 real dpn(ims:ime,kms:kme)
2122 real dpx
2123 real dpy
2124 real g_dpn(ims:ime,kms:kme)
2125 real g_dpx
2126 real g_dpy
2127 integer i
2128 integer i_start
2129 integer itf
2130 integer j
2131 integer j_start
2132 integer jtf
2133 integer k
2134 integer ktf
2135 logical specified
2136
2137 !----------------------------------------------
2138 ! TANGENT LINEAR AND FUNCTION STATEMENTS
2139 !----------------------------------------------
2140 specified = .false.
2141 if (config_flags%specified .or. config_flags%nested) then
2142 specified = .true.
2143 endif
2144 itf = min(ite,ide-1)
2145 jtf = jte
2146 ktf = min(kte,kde-1)
2147 i_start = its
2148 j_start = jts
2149 if ((config_flags%open_ys .or. specified .or. config_flags%nested) .and. jts .eq. jds) then
2150 j_start = jts+1
2151 endif
2152 if ((config_flags%open_ye .or. specified .or. config_flags%nested) .and. jte .eq. jde) then
2153 jtf = jtf-1
2154 endif
2155 do j = j_start, jtf
2156 if (non_hydrostatic) then
2157 k = 1
2158 do i = i_start, itf
2159 g_dpn(i,k) = 0.5*g_p(i,k+2,j-1)*cf3+0.5*g_p(i,k+2,j)*cf3+0.5*g_p(i,k+1,j-1)*cf2+0.5*g_p(i,k+1,j)*cf2+0.5*g_p(i,k,j-1)*cf1+&
2160 &0.5*g_p(i,k,j)*cf1
2161 dpn(i,k) = 0.5*(cf1*(p(i,k,j-1)+p(i,k,j))+cf2*(p(i,k+1,j-1)+p(i,k+1,j))+cf3*(p(i,k+2,j-1)+p(i,k+2,j)))
2162 g_dpn(i,kde) = 0.
2163 dpn(i,kde) = 0.
2164 end do
2165 do k = 2, ktf
2166 do i = i_start, itf
2167 g_dpn(i,k) = 0.5*g_p(i,k-1,j-1)*fnp(k)+0.5*g_p(i,k-1,j)*fnp(k)+0.5*g_p(i,k,j-1)*fnm(k)+0.5*g_p(i,k,j)*fnm(k)
2168 dpn(i,k) = 0.5*(fnm(k)*(p(i,k,j-1)+p(i,k,j))+fnp(k)*(p(i,k-1,j-1)+p(i,k-1,j)))
2169 end do
2170 end do
2171 do k = 1, ktf
2172 do i = i_start, itf
2173 g_dpy = 0.5*g_al(i,k,j-1)*rdy*muv(i,j)*(pb(i,k,j)-pb(i,k,j-1))+0.5*g_al(i,k,j)*rdy*muv(i,j)*(pb(i,k,j)-pb(i,k,j-1))+0.5*&
2174 &g_alt(i,k,j-1)*rdy*muv(i,j)*(p(i,k,j)-p(i,k,j-1))+0.5*g_alt(i,k,j)*rdy*muv(i,j)*(p(i,k,j)-p(i,k,j-1))+0.5*g_muv(i,j)*rdy*&
2175 &(ph(i,k+1,j)-ph(i,k+1,j-1)+ph(i,k,j)-ph(i,k,j-1)+(alt(i,k,j)+alt(i,k,j-1))*(p(i,k,j)-p(i,k,j-1))+(al(i,k,j)+al(i,k,j-1))*&
2176 &(pb(i,k,j)-pb(i,k,j-1)))-0.5*g_p(i,k,j-1)*rdy*muv(i,j)*(alt(i,k,j)+alt(i,k,j-1))+0.5*g_p(i,k,j)*rdy*muv(i,j)*(alt(i,k,j)+&
2177 &alt(i,k,j-1))-0.5*g_ph(i,k+1,j-1)*rdy*muv(i,j)+0.5*g_ph(i,k+1,j)*rdy*muv(i,j)-0.5*g_ph(i,k,j-1)*rdy*muv(i,j)+0.5*g_ph(i,k,&
2178 &j)*rdy*muv(i,j)
2179 dpy = 0.5*rdy*muv(i,j)*(ph(i,k+1,j)-ph(i,k+1,j-1)+ph(i,k,j)-ph(i,k,j-1)+(alt(i,k,j)+alt(i,k,j-1))*(p(i,k,j)-p(i,k,j-1))+&
2180 &(al(i,k,j)+al(i,k,j-1))*(pb(i,k,j)-pb(i,k,j-1)))
2181 g_dpy = g_dpn(i,k+1)*rdy*(php(i,k,j)-php(i,k,j-1))*rdnw(k)-g_dpn(i,k)*rdy*(php(i,k,j)-php(i,k,j-1))*rdnw(k)+g_dpy-0.5*&
2182 &g_mu(i,j-1)*rdy*(php(i,k,j)-php(i,k,j-1))-0.5*g_mu(i,j)*rdy*(php(i,k,j)-php(i,k,j-1))-g_php(i,k,j-1)*rdy*(rdnw(k)*(dpn(i,&
2183 &k+1)-dpn(i,k))-0.5*(mu(i,j-1)+mu(i,j)))+g_php(i,k,j)*rdy*(rdnw(k)*(dpn(i,k+1)-dpn(i,k))-0.5*(mu(i,j-1)+mu(i,j)))
2184 dpy = dpy+rdy*(php(i,k,j)-php(i,k,j-1))*(rdnw(k)*(dpn(i,k+1)-dpn(i,k))-0.5*(mu(i,j-1)+mu(i,j)))
2185 g_rv_tend(i,k,j) = (-(g_cqv(i,k,j)*dpy))-g_dpy*cqv(i,k,j)+g_rv_tend(i,k,j)
2186 rv_tend(i,k,j) = rv_tend(i,k,j)-cqv(i,k,j)*dpy
2187 end do
2188 end do
2189 else
2190 do k = 1, ktf
2191 do i = i_start, itf
2192 g_dpy = 0.5*g_al(i,k,j-1)*rdy*muv(i,j)*(pb(i,k,j)-pb(i,k,j-1))+0.5*g_al(i,k,j)*rdy*muv(i,j)*(pb(i,k,j)-pb(i,k,j-1))+0.5*&
2193 &g_alt(i,k,j-1)*rdy*muv(i,j)*(p(i,k,j)-p(i,k,j-1))+0.5*g_alt(i,k,j)*rdy*muv(i,j)*(p(i,k,j)-p(i,k,j-1))+0.5*g_muv(i,j)*rdy*&
2194 &(ph(i,k+1,j)-ph(i,k+1,j-1)+ph(i,k,j)-ph(i,k,j-1)+(alt(i,k,j)+alt(i,k,j-1))*(p(i,k,j)-p(i,k,j-1))+(al(i,k,j)+al(i,k,j-1))*&
2195 &(pb(i,k,j)-pb(i,k,j-1)))-0.5*g_p(i,k,j-1)*rdy*muv(i,j)*(alt(i,k,j)+alt(i,k,j-1))+0.5*g_p(i,k,j)*rdy*muv(i,j)*(alt(i,k,j)+&
2196 &alt(i,k,j-1))-0.5*g_ph(i,k+1,j-1)*rdy*muv(i,j)+0.5*g_ph(i,k+1,j)*rdy*muv(i,j)-0.5*g_ph(i,k,j-1)*rdy*muv(i,j)+0.5*g_ph(i,k,&
2197 &j)*rdy*muv(i,j)
2198 dpy = 0.5*rdy*muv(i,j)*(ph(i,k+1,j)-ph(i,k+1,j-1)+ph(i,k,j)-ph(i,k,j-1)+(alt(i,k,j)+alt(i,k,j-1))*(p(i,k,j)-p(i,k,j-1))+&
2199 &(al(i,k,j)+al(i,k,j-1))*(pb(i,k,j)-pb(i,k,j-1)))
2200 g_rv_tend(i,k,j) = (-(g_cqv(i,k,j)*dpy))-g_dpy*cqv(i,k,j)+g_rv_tend(i,k,j)
2201 rv_tend(i,k,j) = rv_tend(i,k,j)-cqv(i,k,j)*dpy
2202 end do
2203 end do
2204 endif
2205 end do
2206 itf = ite
2207 jtf = min(jte,jde-1)
2208 ktf = min(kte,kde-1)
2209 i_start = its
2210 j_start = jts
2211 if ((config_flags%open_xs .or. specified .or. config_flags%nested) .and. its .eq. ids) then
2212 i_start = its+1
2213 endif
2214 if ((config_flags%open_xe .or. specified .or. config_flags%nested) .and. ite .eq. ide) then
2215 itf = itf-1
2216 endif
2217 do j = j_start, jtf
2218 if (non_hydrostatic) then
2219 k = 1
2220 do i = i_start, itf
2221 g_dpn(i,k) = 0.5*g_p(i-1,k+2,j)*cf3+0.5*g_p(i,k+2,j)*cf3+0.5*g_p(i-1,k+1,j)*cf2+0.5*g_p(i,k+1,j)*cf2+0.5*g_p(i-1,k,j)*cf1+&
2222 &0.5*g_p(i,k,j)*cf1
2223 dpn(i,k) = 0.5*(cf1*(p(i-1,k,j)+p(i,k,j))+cf2*(p(i-1,k+1,j)+p(i,k+1,j))+cf3*(p(i-1,k+2,j)+p(i,k+2,j)))
2224 g_dpn(i,kde) = 0.
2225 dpn(i,kde) = 0.
2226 end do
2227 do k = 2, ktf
2228 do i = i_start, itf
2229 g_dpn(i,k) = 0.5*g_p(i-1,k-1,j)*fnp(k)+0.5*g_p(i,k-1,j)*fnp(k)+0.5*g_p(i-1,k,j)*fnm(k)+0.5*g_p(i,k,j)*fnm(k)
2230 dpn(i,k) = 0.5*(fnm(k)*(p(i-1,k,j)+p(i,k,j))+fnp(k)*(p(i-1,k-1,j)+p(i,k-1,j)))
2231 end do
2232 end do
2233 do k = 1, ktf
2234 do i = i_start, itf
2235 g_dpx = 0.5*g_al(i-1,k,j)*rdx*muu(i,j)*(pb(i,k,j)-pb(i-1,k,j))+0.5*g_al(i,k,j)*rdx*muu(i,j)*(pb(i,k,j)-pb(i-1,k,j))+0.5*&
2236 &g_alt(i-1,k,j)*rdx*muu(i,j)*(p(i,k,j)-p(i-1,k,j))+0.5*g_alt(i,k,j)*rdx*muu(i,j)*(p(i,k,j)-p(i-1,k,j))+0.5*g_muu(i,j)*rdx*&
2237 &(ph(i,k+1,j)-ph(i-1,k+1,j)+ph(i,k,j)-ph(i-1,k,j)+(alt(i,k,j)+alt(i-1,k,j))*(p(i,k,j)-p(i-1,k,j))+(al(i,k,j)+al(i-1,k,j))*&
2238 &(pb(i,k,j)-pb(i-1,k,j)))-0.5*g_p(i-1,k,j)*rdx*muu(i,j)*(alt(i,k,j)+alt(i-1,k,j))+0.5*g_p(i,k,j)*rdx*muu(i,j)*(alt(i,k,j)+&
2239 &alt(i-1,k,j))-0.5*g_ph(i-1,k+1,j)*rdx*muu(i,j)+0.5*g_ph(i,k+1,j)*rdx*muu(i,j)-0.5*g_ph(i-1,k,j)*rdx*muu(i,j)+0.5*g_ph(i,k,&
2240 &j)*rdx*muu(i,j)
2241 dpx = 0.5*rdx*muu(i,j)*(ph(i,k+1,j)-ph(i-1,k+1,j)+ph(i,k,j)-ph(i-1,k,j)+(alt(i,k,j)+alt(i-1,k,j))*(p(i,k,j)-p(i-1,k,j))+&
2242 &(al(i,k,j)+al(i-1,k,j))*(pb(i,k,j)-pb(i-1,k,j)))
2243 g_dpx = g_dpn(i,k+1)*rdx*(php(i,k,j)-php(i-1,k,j))*rdnw(k)-g_dpn(i,k)*rdx*(php(i,k,j)-php(i-1,k,j))*rdnw(k)+g_dpx-0.5*&
2244 &g_mu(i-1,j)*rdx*(php(i,k,j)-php(i-1,k,j))-0.5*g_mu(i,j)*rdx*(php(i,k,j)-php(i-1,k,j))-g_php(i-1,k,j)*rdx*(rdnw(k)*(dpn(i,&
2245 &k+1)-dpn(i,k))-0.5*(mu(i-1,j)+mu(i,j)))+g_php(i,k,j)*rdx*(rdnw(k)*(dpn(i,k+1)-dpn(i,k))-0.5*(mu(i-1,j)+mu(i,j)))
2246 dpx = dpx+rdx*(php(i,k,j)-php(i-1,k,j))*(rdnw(k)*(dpn(i,k+1)-dpn(i,k))-0.5*(mu(i-1,j)+mu(i,j)))
2247 g_ru_tend(i,k,j) = (-(g_cqu(i,k,j)*dpx))-g_dpx*cqu(i,k,j)+g_ru_tend(i,k,j)
2248 ru_tend(i,k,j) = ru_tend(i,k,j)-cqu(i,k,j)*dpx
2249 end do
2250 end do
2251 else
2252 do k = 1, ktf
2253 do i = i_start, itf
2254 g_dpx = 0.5*g_al(i-1,k,j)*rdx*muu(i,j)*(pb(i,k,j)-pb(i-1,k,j))+0.5*g_al(i,k,j)*rdx*muu(i,j)*(pb(i,k,j)-pb(i-1,k,j))+0.5*&
2255 &g_alt(i-1,k,j)*rdx*muu(i,j)*(p(i,k,j)-p(i-1,k,j))+0.5*g_alt(i,k,j)*rdx*muu(i,j)*(p(i,k,j)-p(i-1,k,j))+0.5*g_muu(i,j)*rdx*&
2256 &(ph(i,k+1,j)-ph(i-1,k+1,j)+ph(i,k,j)-ph(i-1,k,j)+(alt(i,k,j)+alt(i-1,k,j))*(p(i,k,j)-p(i-1,k,j))+(al(i,k,j)+al(i-1,k,j))*&
2257 &(pb(i,k,j)-pb(i-1,k,j)))-0.5*g_p(i-1,k,j)*rdx*muu(i,j)*(alt(i,k,j)+alt(i-1,k,j))+0.5*g_p(i,k,j)*rdx*muu(i,j)*(alt(i,k,j)+&
2258 &alt(i-1,k,j))-0.5*g_ph(i-1,k+1,j)*rdx*muu(i,j)+0.5*g_ph(i,k+1,j)*rdx*muu(i,j)-0.5*g_ph(i-1,k,j)*rdx*muu(i,j)+0.5*g_ph(i,k,&
2259 &j)*rdx*muu(i,j)
2260 dpx = 0.5*rdx*muu(i,j)*(ph(i,k+1,j)-ph(i-1,k+1,j)+ph(i,k,j)-ph(i-1,k,j)+(alt(i,k,j)+alt(i-1,k,j))*(p(i,k,j)-p(i-1,k,j))+&
2261 &(al(i,k,j)+al(i-1,k,j))*(pb(i,k,j)-pb(i-1,k,j)))
2262 g_ru_tend(i,k,j) = (-(g_cqu(i,k,j)*dpx))-g_dpx*cqu(i,k,j)+g_ru_tend(i,k,j)
2263 ru_tend(i,k,j) = ru_tend(i,k,j)-cqu(i,k,j)*dpx
2264 end do
2265 end do
2266 endif
2267 end do
2268
2269 end subroutine g_horizontal_pressure_gradient
2270
2271
2272 subroutine g_perturbation_coriolis( ru_in, g_ru_in, rv_in, g_rv_in, rw, g_rw, ru_tend, g_ru_tend, rv_tend, g_rv_tend, rw_tend, &
2273 &g_rw_tend, config_flags, u_base, v_base, z_base, muu, g_muu, muv, g_muv, phb, ph, g_ph, f, e, sina, cosa, fzm, fzp, ids, ide, jds,&
2274 & jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
2275 !******************************************************************
2276 !******************************************************************
2277 !** This routine was generated by Automatic differentiation. **
2278 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
2279 !******************************************************************
2280 !******************************************************************
2281 !==============================================
2282 ! all entries are defined explicitly
2283 !==============================================
2284 implicit none
2285
2286 !==============================================
2287 ! declare arguments
2288 !==============================================
2289 type (grid_config_rec_type), intent(in) :: config_flags
2290 integer, intent(in) :: ime
2291 integer, intent(in) :: ims
2292 integer, intent(in) :: jme
2293 integer, intent(in) :: jms
2294 real, intent(in) :: cosa(ims:ime,jms:jme)
2295 real, intent(in) :: e(ims:ime,jms:jme)
2296 real, intent(in) :: f(ims:ime,jms:jme)
2297 integer, intent(in) :: kme
2298 integer, intent(in) :: kms
2299 real, intent(in) :: fzm(kms:kme)
2300 real, intent(in) :: fzp(kms:kme)
2301 real, intent(in) :: g_muu(ims:ime,jms:jme)
2302 real, intent(in) :: g_muv(ims:ime,jms:jme)
2303 real, intent(in) :: g_ph(ims:ime,kms:kme,jms:jme)
2304 real, intent(in) :: g_ru_in(ims:ime,kms:kme,jms:jme)
2305 real, intent(inout) :: g_ru_tend(ims:ime,kms:kme,jms:jme)
2306 real, intent(in) :: g_rv_in(ims:ime,kms:kme,jms:jme)
2307 real, intent(inout) :: g_rv_tend(ims:ime,kms:kme,jms:jme)
2308 real, intent(in) :: g_rw(ims:ime,kms:kme,jms:jme)
2309 real, intent(inout) :: g_rw_tend(ims:ime,kms:kme,jms:jme)
2310 integer, intent(in) :: ide
2311 integer, intent(in) :: ids
2312 integer, intent(in) :: ite
2313 integer, intent(in) :: its
2314 integer, intent(in) :: jde
2315 integer, intent(in) :: jds
2316 integer, intent(in) :: jte
2317 integer, intent(in) :: jts
2318 integer, intent(in) :: kde
2319 integer, intent(in) :: kte
2320 integer, intent(in) :: kts
2321 real, intent(in) :: muu(ims:ime,jms:jme)
2322 real, intent(in) :: muv(ims:ime,jms:jme)
2323 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
2324 real, intent(in) :: phb(ims:ime,kms:kme,jms:jme)
2325 real, intent(in) :: ru_in(ims:ime,kms:kme,jms:jme)
2326 real, intent(inout) :: ru_tend(ims:ime,kms:kme,jms:jme)
2327 real, intent(in) :: rv_in(ims:ime,kms:kme,jms:jme)
2328 real, intent(inout) :: rv_tend(ims:ime,kms:kme,jms:jme)
2329 real, intent(in) :: rw(ims:ime,kms:kme,jms:jme)
2330 real, intent(inout) :: rw_tend(ims:ime,kms:kme,jms:jme)
2331 real, intent(in) :: sina(ims:ime,jms:jme)
2332 real, intent(in) :: u_base(kms:kme)
2333 real, intent(in) :: v_base(kms:kme)
2334 real, intent(in) :: z_base(kms:kme)
2335
2336 !==============================================
2337 ! declare local variables
2338 !==============================================
2339 real g_ru(ims:ime,kms:kme,jms:jme)
2340 real g_rv(ims:ime,kms:kme,jms:jme)
2341 real g_wk
2342 real g_wkm1
2343 real g_wkp1
2344 real g_z_at_u
2345 real g_z_at_v
2346 integer i
2347 integer i_end
2348 integer i_start
2349 integer j
2350 integer j_end
2351 integer j_start
2352 integer k
2353 integer ktf
2354 real ru(ims:ime,kms:kme,jms:jme)
2355 real rv(ims:ime,kms:kme,jms:jme)
2356 logical specified
2357 real wk
2358 real wkm1
2359 real wkp1
2360 real z_at_u
2361 real z_at_v
2362
2363 !----------------------------------------------
2364 ! TANGENT LINEAR AND FUNCTION STATEMENTS
2365 !----------------------------------------------
2366 specified = .false.
2367 if (config_flags%specified .or. config_flags%nested) then
2368 specified = .true.
2369 endif
2370 ktf = min(kte,kde-1)
2371 i_start = its
2372 i_end = ite
2373 if (config_flags%open_xs .or. specified .or. config_flags%nested) then
2374 i_start = max(ids+1,its)
2375 endif
2376 if (config_flags%open_xe .or. specified .or. config_flags%nested) then
2377 i_end = min(ide-1,ite)
2378 endif
2379 do j = jts, min(jte,jde-1)+1
2380 do k = kts+1, ktf-1
2381 do i = i_start-1, i_end
2382 g_z_at_v = (g_ph(i,k+1,j-1)+g_ph(i,k+1,j)+g_ph(i,k,j-1)+g_ph(i,k,j))*(0.25/g)
2383 z_at_v = 0.25*(phb(i,k,j)+phb(i,k+1,j)+phb(i,k,j-1)+phb(i,k+1,j-1)+ph(i,k,j)+ph(i,k+1,j)+ph(i,k,j-1)+ph(i,k+1,j-1))/g
2384 g_wkp1 = g_z_at_v*(0.5-sign(0.5,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k))-1.))*((0.5-sign(0.5,0.-(z_at_v-z_base(k))))/&
2385 &(z_base(k+1)-z_base(k)))
2386 wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k)))
2387 g_wkm1 = -(g_z_at_v*(0.5-sign(0.5,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1))-1.))*((0.5-sign(0.5,0.-(z_base(k)-z_at_v))&
2388 &)/(z_base(k)-z_base(k-1))))
2389 wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1)))
2390 g_wk = (-g_wkm1)-g_wkp1
2391 wk = 1.-wkp1-wkm1
2392 g_rv(i,k,j) = (-(g_muv(i,j)*(wkm1*v_base(k-1)+wk*v_base(k)+wkp1*v_base(k+1))))+g_rv_in(i,k,j)-g_wk*muv(i,j)*v_base(k)-g_wkm1*&
2393 &muv(i,j)*v_base(k-1)-g_wkp1*muv(i,j)*v_base(k+1)
2394 rv(i,k,j) = rv_in(i,k,j)-muv(i,j)*(wkm1*v_base(k-1)+wk*v_base(k)+wkp1*v_base(k+1))
2395 end do
2396 end do
2397 end do
2398 do j = jts, min(jte,jde-1)+1
2399 do i = i_start-1, i_end
2400 k = kts
2401 g_z_at_v = (g_ph(i,k+1,j-1)+g_ph(i,k+1,j)+g_ph(i,k,j-1)+g_ph(i,k,j))*(0.25/g)
2402 z_at_v = 0.25*(phb(i,k,j)+phb(i,k+1,j)+phb(i,k,j-1)+phb(i,k+1,j-1)+ph(i,k,j)+ph(i,k+1,j)+ph(i,k,j-1)+ph(i,k+1,j-1))/g
2403 g_wkp1 = g_z_at_v*(0.5-sign(0.5,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k))-1.))*((0.5-sign(0.5,0.-(z_at_v-z_base(k))))/&
2404 &(z_base(k+1)-z_base(k)))
2405 wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k)))
2406 g_wk = -g_wkp1
2407 wk = 1.-wkp1
2408 g_rv(i,k,j) = (-(g_muv(i,j)*(wk*v_base(k)+wkp1*v_base(k+1))))+g_rv_in(i,k,j)-g_wk*muv(i,j)*v_base(k)-g_wkp1*muv(i,j)*v_base(k+1)
2409 rv(i,k,j) = rv_in(i,k,j)-muv(i,j)*(wk*v_base(k)+wkp1*v_base(k+1))
2410 k = ktf
2411 g_z_at_v = (g_ph(i,k+1,j-1)+g_ph(i,k+1,j)+g_ph(i,k,j-1)+g_ph(i,k,j))*(0.25/g)
2412 z_at_v = 0.25*(phb(i,k,j)+phb(i,k+1,j)+phb(i,k,j-1)+phb(i,k+1,j-1)+ph(i,k,j)+ph(i,k+1,j)+ph(i,k,j-1)+ph(i,k+1,j-1))/g
2413 g_wkm1 = -(g_z_at_v*(0.5-sign(0.5,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1))-1.))*((0.5-sign(0.5,0.-(z_base(k)-z_at_v)))/&
2414 &(z_base(k)-z_base(k-1))))
2415 wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1)))
2416 g_wk = -g_wkm1
2417 wk = 1.-wkm1
2418 g_rv(i,k,j) = (-(g_muv(i,j)*(wkm1*v_base(k-1)+wk*v_base(k))))+g_rv_in(i,k,j)-g_wk*muv(i,j)*v_base(k)-g_wkm1*muv(i,j)*v_base(k-1)
2419 rv(i,k,j) = rv_in(i,k,j)-muv(i,j)*(wkm1*v_base(k-1)+wk*v_base(k))
2420 end do
2421 end do
2422 do j = jts, min(jte,jde-1)
2423 do k = kts, ktf
2424 do i = i_start, i_end
2425 g_ru_tend(i,k,j) = g_ru_tend(i,k,j)+0.125*g_rv(i-1,k,j+1)*(f(i,j)+f(i-1,j))+0.125*g_rv(i,k,j+1)*(f(i,j)+f(i-1,j))+0.125*&
2426 &g_rv(i-1,k,j)*(f(i,j)+f(i-1,j))+0.125*g_rv(i,k,j)*(f(i,j)+f(i-1,j))-0.0625*g_rw(i-1,k+1,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+&
2427 &cosa(i-1,j))-0.0625*g_rw(i,k+1,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+cosa(i-1,j))-0.0625*g_rw(i-1,k,j)*(e(i,j)+e(i-1,j))*(cosa(i,&
2428 &j)+cosa(i-1,j))-0.0625*g_rw(i,k,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+cosa(i-1,j))
2429 ru_tend(i,k,j) = ru_tend(i,k,j)+0.5*(f(i,j)+f(i-1,j))*0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j))-0.5*(e(i,j)+e(i-&
2430 &1,j))*0.5*(cosa(i,j)+cosa(i-1,j))*0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j))
2431 end do
2432 end do
2433 if (config_flags%open_xs .and. its .eq. ids) then
2434 do k = kts, ktf
2435 g_ru_tend(its,k,j) = g_ru_tend(its,k,j)+0.5*g_rv(its,k,j+1)*f(its,j)+0.5*g_rv(its,k,j)*f(its,j)-0.5*g_rw(its,k+1,j)*e(its,j)*&
2436 &cosa(its,j)-0.5*g_rw(its,k,j)*e(its,j)*cosa(its,j)
2437 ru_tend(its,k,j) = ru_tend(its,k,j)+0.5*(f(its,j)+f(its,j))*0.25*(rv(its,k,j+1)+rv(its,k,j+1)+rv(its,k,j)+rv(its,k,j))-0.5*&
2438 &(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j))*0.25*(rw(its,k+1,j)+rw(its,k,j)+rw(its,k+1,j)+rw(its,k,j))
2439 end do
2440 endif
2441 if (config_flags%open_xe .and. ite .eq. ide) then
2442 do k = kts, ktf
2443 g_ru_tend(ite,k,j) = g_ru_tend(ite,k,j)+0.5*g_rv(ite-1,k,j+1)*f(ite-1,j)+0.5*g_rv(ite-1,k,j)*f(ite-1,j)-0.5*g_rw(ite-1,k+1,j)&
2444 &*e(ite-1,j)*cosa(ite-1,j)-0.5*g_rw(ite-1,k,j)*e(ite-1,j)*cosa(ite-1,j)
2445 ru_tend(ite,k,j) = ru_tend(ite,k,j)+0.5*(f(ite-1,j)+f(ite-1,j))*0.25*(rv(ite-1,k,j+1)+rv(ite-1,k,j+1)+rv(ite-1,k,j)+rv(ite-1,&
2446 &k,j))-0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j))*0.25*(rw(ite-1,k+1,j)+rw(ite-1,k,j)+rw(ite-1,k+1,j)+&
2447 &rw(ite-1,k,j))
2448 end do
2449 endif
2450 end do
2451 j_start = jts
2452 j_end = jte
2453 if (config_flags%open_ys .or. specified .or. config_flags%nested) then
2454 j_start = max(jds+1,jts)
2455 endif
2456 if (config_flags%open_ye .or. specified .or. config_flags%nested) then
2457 j_end = min(jde-1,jte)
2458 endif
2459 do j = j_start-1, j_end
2460 do k = kts+1, ktf-1
2461 do i = its, min(ite,ide-1)+1
2462 g_z_at_u = (g_ph(i-1,k+1,j)+g_ph(i,k+1,j)+g_ph(i-1,k,j)+g_ph(i,k,j))*(0.25/g)
2463 z_at_u = 0.25*(phb(i,k,j)+phb(i,k+1,j)+phb(i-1,k,j)+phb(i-1,k+1,j)+ph(i,k,j)+ph(i,k+1,j)+ph(i-1,k,j)+ph(i-1,k+1,j))/g
2464 g_wkp1 = g_z_at_u*(0.5-sign(0.5,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k))-1.))*((0.5-sign(0.5,0.-(z_at_u-z_base(k))))/&
2465 &(z_base(k+1)-z_base(k)))
2466 wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k)))
2467 g_wkm1 = -(g_z_at_u*(0.5-sign(0.5,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1))-1.))*((0.5-sign(0.5,0.-(z_base(k)-z_at_u))&
2468 &)/(z_base(k)-z_base(k-1))))
2469 wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1)))
2470 g_wk = (-g_wkm1)-g_wkp1
2471 wk = 1.-wkp1-wkm1
2472 g_ru(i,k,j) = (-(g_muu(i,j)*(wkm1*u_base(k-1)+wk*u_base(k)+wkp1*u_base(k+1))))+g_ru_in(i,k,j)-g_wk*muu(i,j)*u_base(k)-g_wkm1*&
2473 &muu(i,j)*u_base(k-1)-g_wkp1*muu(i,j)*u_base(k+1)
2474 ru(i,k,j) = ru_in(i,k,j)-muu(i,j)*(wkm1*u_base(k-1)+wk*u_base(k)+wkp1*u_base(k+1))
2475 end do
2476 end do
2477 end do
2478 do j = j_start-1, j_end
2479 do i = its, min(ite,ide-1)+1
2480 k = kts
2481 g_z_at_u = (g_ph(i-1,k+1,j)+g_ph(i,k+1,j)+g_ph(i-1,k,j)+g_ph(i,k,j))*(0.25/g)
2482 z_at_u = 0.25*(phb(i,k,j)+phb(i,k+1,j)+phb(i-1,k,j)+phb(i-1,k+1,j)+ph(i,k,j)+ph(i,k+1,j)+ph(i-1,k,j)+ph(i-1,k+1,j))/g
2483 g_wkp1 = g_z_at_u*(0.5-sign(0.5,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k))-1.))*((0.5-sign(0.5,0.-(z_at_u-z_base(k))))/&
2484 &(z_base(k+1)-z_base(k)))
2485 wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k)))
2486 g_wk = -g_wkp1
2487 wk = 1.-wkp1
2488 g_ru(i,k,j) = (-(g_muu(i,j)*(wk*u_base(k)+wkp1*u_base(k+1))))+g_ru_in(i,k,j)-g_wk*muu(i,j)*u_base(k)-g_wkp1*muu(i,j)*u_base(k+1)
2489 ru(i,k,j) = ru_in(i,k,j)-muu(i,j)*(wk*u_base(k)+wkp1*u_base(k+1))
2490 k = ktf
2491 g_z_at_u = (g_ph(i-1,k+1,j)+g_ph(i,k+1,j)+g_ph(i-1,k,j)+g_ph(i,k,j))*(0.25/g)
2492 z_at_u = 0.25*(phb(i,k,j)+phb(i,k+1,j)+phb(i-1,k,j)+phb(i-1,k+1,j)+ph(i,k,j)+ph(i,k+1,j)+ph(i-1,k,j)+ph(i-1,k+1,j))/g
2493 g_wkm1 = -(g_z_at_u*(0.5-sign(0.5,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1))-1.))*((0.5-sign(0.5,0.-(z_base(k)-z_at_u)))/&
2494 &(z_base(k)-z_base(k-1))))
2495 wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1)))
2496 g_wk = -g_wkm1
2497 wk = 1.-wkm1
2498 g_ru(i,k,j) = (-(g_muu(i,j)*(wkm1*u_base(k-1)+wk*u_base(k))))+g_ru_in(i,k,j)-g_wk*muu(i,j)*u_base(k)-g_wkm1*muu(i,j)*u_base(k-1)
2499 ru(i,k,j) = ru_in(i,k,j)-muu(i,j)*(wkm1*u_base(k-1)+wk*u_base(k))
2500 end do
2501 end do
2502 if (config_flags%open_ys .and. jts .eq. jds) then
2503 do k = kts, ktf
2504 do i = its, min(ide-1,ite)
2505 g_rv_tend(i,k,jts) = (-(0.5*g_ru(i+1,k,jts)*f(i,jts)))-0.5*g_ru(i,k,jts)*f(i,jts)+g_rv_tend(i,k,jts)+0.5*g_rw(i,k+1,jts)*e(i,&
2506 &jts)*sina(i,jts)+0.5*g_rw(i,k,jts)*e(i,jts)*sina(i,jts)
2507 rv_tend(i,k,jts) = rv_tend(i,k,jts)-0.5*(f(i,jts)+f(i,jts))*0.25*(ru(i,k,jts)+ru(i+1,k,jts)+ru(i,k,jts)+ru(i+1,k,jts))+0.5*&
2508 &(e(i,jts)+e(i,jts))*0.5*(sina(i,jts)+sina(i,jts))*0.25*(rw(i,k+1,jts)+rw(i,k,jts)+rw(i,k+1,jts)+rw(i,k,jts))
2509 end do
2510 end do
2511 endif
2512 do j = j_start, j_end
2513 do k = kts, ktf
2514 do i = its, min(ide-1,ite)
2515 g_rv_tend(i,k,j) = (-(0.125*g_ru(i+1,k,j-1)*(f(i,j)+f(i,j-1))))-0.125*g_ru(i,k,j-1)*(f(i,j)+f(i,j-1))-0.125*g_ru(i+1,k,j)*&
2516 &(f(i,j)+f(i,j-1))-0.125*g_ru(i,k,j)*(f(i,j)+f(i,j-1))+g_rv_tend(i,k,j)+0.0625*g_rw(i,k+1,j-1)*(e(i,j)+e(i,j-1))*(sina(i,j)+&
2517 &sina(i,j-1))+0.0625*g_rw(i,k+1,j)*(e(i,j)+e(i,j-1))*(sina(i,j)+sina(i,j-1))+0.0625*g_rw(i,k,j-1)*(e(i,j)+e(i,j-1))*(sina(i,&
2518 &j)+sina(i,j-1))+0.0625*g_rw(i,k,j)*(e(i,j)+e(i,j-1))*(sina(i,j)+sina(i,j-1))
2519 rv_tend(i,k,j) = rv_tend(i,k,j)-0.5*(f(i,j)+f(i,j-1))*0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1))+0.5*(e(i,j)+e(i,&
2520 &j-1))*0.5*(sina(i,j)+sina(i,j-1))*0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j))
2521 end do
2522 end do
2523 end do
2524 if (config_flags%open_ye .and. jte .eq. jde) then
2525 do k = kts, ktf
2526 do i = its, min(ide-1,ite)
2527 g_rv_tend(i,k,jte) = (-(0.5*g_ru(i+1,k,jte-1)*f(i,jte-1)))-0.5*g_ru(i,k,jte-1)*f(i,jte-1)+g_rv_tend(i,k,jte)+0.5*g_rw(i,k+1,&
2528 &jte-1)*e(i,jte-1)*sina(i,jte-1)+0.5*g_rw(i,k,jte-1)*e(i,jte-1)*sina(i,jte-1)
2529 rv_tend(i,k,jte) = rv_tend(i,k,jte)-0.5*(f(i,jte-1)+f(i,jte-1))*0.25*(ru(i,k,jte-1)+ru(i+1,k,jte-1)+ru(i,k,jte-1)+ru(i+1,k,&
2530 &jte-1))+0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i,jte-1)+sina(i,jte-1))*0.25*(rw(i,k+1,jte-1)+rw(i,k,jte-1)+rw(i,k+1,jte-1)+&
2531 &rw(i,k,jte-1))
2532 end do
2533 end do
2534 endif
2535 do j = jts, min(jte,jde-1)
2536 do k = kts+1, ktf
2537 do i = its, min(ite,ide-1)
2538 g_rw_tend(i,k,j) = 0.5*g_ru(i+1,k-1,j)*e(i,j)*cosa(i,j)*fzp(k)+0.5*g_ru(i,k-1,j)*e(i,j)*cosa(i,j)*fzp(k)+0.5*g_ru(i+1,k,j)*&
2539 &e(i,j)*cosa(i,j)*fzm(k)+0.5*g_ru(i,k,j)*e(i,j)*cosa(i,j)*fzm(k)-0.5*g_rv(i,k-1,j+1)*e(i,j)*sina(i,j)*fzp(k)-0.5*g_rv(i,k-1,&
2540 &j)*e(i,j)*sina(i,j)*fzp(k)-0.5*g_rv(i,k,j+1)*e(i,j)*sina(i,j)*fzm(k)-0.5*g_rv(i,k,j)*e(i,j)*sina(i,j)*fzm(k)+g_rw_tend(i,k,j)
2541 rw_tend(i,k,j) = rw_tend(i,k,j)+e(i,j)*(cosa(i,j)*0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j))+fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j)))-&
2542 &sina(i,j)*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1))+fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1))))
2543 end do
2544 end do
2545 end do
2546
2547 end subroutine g_perturbation_coriolis
2548
2549
2550 subroutine g_pg_buoy_w( rw_tend, g_rw_tend, p, g_p, cqw, g_cqw, mu, g_mu, mub, rdnw, rdn, g, msft, ide, jde, kde, ims, ime, jms, &
2551 &jme, kms, kme, its, ite, jts, jte )
2552 !******************************************************************
2553 !******************************************************************
2554 !** This routine was generated by Automatic differentiation. **
2555 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
2556 !******************************************************************
2557 !******************************************************************
2558 !==============================================
2559 ! all entries are defined explicitly
2560 !==============================================
2561 implicit none
2562
2563 !==============================================
2564 ! declare arguments
2565 !==============================================
2566 integer, intent(in) :: ime
2567 integer, intent(in) :: ims
2568 integer, intent(in) :: jme
2569 integer, intent(in) :: jms
2570 integer, intent(in) :: kme
2571 integer, intent(in) :: kms
2572 real, intent(inout) :: cqw(ims:ime,kms:kme,jms:jme)
2573 real, intent(in) :: g
2574 real, intent(inout) :: g_cqw(ims:ime,kms:kme,jms:jme)
2575 real, intent(in) :: g_mu(ims:ime,jms:jme)
2576 real, intent(in) :: g_p(ims:ime,kms:kme,jms:jme)
2577 real, intent(inout) :: g_rw_tend(ims:ime,kms:kme,jms:jme)
2578 integer, intent(in) :: ide
2579 integer, intent(in) :: ite
2580 integer, intent(in) :: its
2581 integer, intent(in) :: jde
2582 integer, intent(in) :: jte
2583 integer, intent(in) :: jts
2584 integer, intent(in) :: kde
2585 real, intent(in) :: msft(ims:ime,jms:jme)
2586 real, intent(in) :: mu(ims:ime,jms:jme)
2587 real, intent(in) :: mub(ims:ime,jms:jme)
2588 real, intent(in) :: p(ims:ime,kms:kme,jms:jme)
2589 real, intent(in) :: rdn(kms:kme)
2590 real, intent(in) :: rdnw(kms:kme)
2591 real, intent(inout) :: rw_tend(ims:ime,kms:kme,jms:jme)
2592
2593 !==============================================
2594 ! declare local variables
2595 !==============================================
2596 real cq1
2597 real cq2
2598 real g_cq1
2599 real g_cq2
2600 integer i
2601 integer itf
2602 integer j
2603 integer jtf
2604 integer k
2605
2606 !----------------------------------------------
2607 ! TANGENT LINEAR AND FUNCTION STATEMENTS
2608 !----------------------------------------------
2609 itf = min(ite,ide-1)
2610 jtf = min(jte,jde-1)
2611 do j = jts, jtf
2612 k = kde
2613 do i = its, itf
2614 g_cq1 = -(g_cqw(i,k-1,j)/((1.+cqw(i,k-1,j))*(1.+cqw(i,k-1,j))))
2615 cq1 = 1./(1.+cqw(i,k-1,j))
2616 g_cq2 = g_cq1*cqw(i,k-1,j)+g_cqw(i,k-1,j)*cq1
2617 cq2 = cqw(i,k-1,j)*cq1
2618 g_rw_tend(i,k,j) = (-(2*g_cq1*1./msft(i,j)*g*rdnw(k-1)*p(i,k-1,j)))-g_cq2*1./msft(i,j)*g*mub(i,j)-g_mu(i,j)*1./msft(i,j)*g-2*&
2619 &g_p(i,k-1,j)*1./msft(i,j)*g*cq1*rdnw(k-1)+g_rw_tend(i,k,j)
2620 rw_tend(i,k,j) = rw_tend(i,k,j)+1./msft(i,j)*g*(cq1*2.*rdnw(k-1)*(-p(i,k-1,j))-mu(i,j)-cq2*mub(i,j))
2621 end do
2622 do k = 2, kde-1
2623 do i = its, itf
2624 g_cq1 = -(g_cqw(i,k,j)/((1.+cqw(i,k,j))*(1.+cqw(i,k,j))))
2625 cq1 = 1./(1.+cqw(i,k,j))
2626 g_cq2 = g_cq1*cqw(i,k,j)+g_cqw(i,k,j)*cq1
2627 cq2 = cqw(i,k,j)*cq1
2628 g_cqw(i,k,j) = g_cq1
2629 cqw(i,k,j) = cq1
2630 g_rw_tend(i,k,j) = g_cq1*1./msft(i,j)*g*rdn(k)*(p(i,k,j)-p(i,k-1,j))-g_cq2*1./msft(i,j)*g*mub(i,j)-g_mu(i,j)*1./msft(i,j)*g-&
2631 &g_p(i,k-1,j)*1./msft(i,j)*g*cq1*rdn(k)+g_p(i,k,j)*1./msft(i,j)*g*cq1*rdn(k)+g_rw_tend(i,k,j)
2632 rw_tend(i,k,j) = rw_tend(i,k,j)+1./msft(i,j)*g*(cq1*rdn(k)*(p(i,k,j)-p(i,k-1,j))-mu(i,j)-cq2*mub(i,j))
2633 end do
2634 end do
2635 end do
2636
2637 end subroutine g_pg_buoy_w
2638
2639
2640 subroutine g_phy_prep( p, g_p, pb, ph, g_ph, phb, t, g_t, mu_3d, rho, th_phy, g_th_phy, p_phy, g_p_phy, pi_phy, g_pi_phy, u_phy, &
2641 &v_phy, p8w, g_p8w, t_phy, g_t_phy, t8w, g_t8w, z, g_z, z_at_w, g_z_at_w, dz8w, fzm, fzp, rthraten, rthblten, rublten, rvblten, &
2642 &rqvblten, rqcblten, rqiblten, rthcuten, rqvcuten, rqccuten, rqrcuten, rqicuten, rqscuten, rthften, rqvften, ide, jde, kde, ims, &
2643 &ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
2644 !******************************************************************
2645 !******************************************************************
2646 !** This routine was generated by Automatic differentiation. **
2647 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
2648 !******************************************************************
2649 !******************************************************************
2650 !==============================================
2651 ! all entries are defined explicitly
2652 !==============================================
2653 implicit none
2654
2655 !==============================================
2656 ! declare arguments
2657 !==============================================
2658 integer, intent(in) :: ime
2659 integer, intent(in) :: ims
2660 integer, intent(in) :: jme
2661 integer, intent(in) :: jms
2662 integer, intent(in) :: kme
2663 integer, intent(in) :: kms
2664 real, intent(out) :: dz8w(ims:ime,kms:kme,jms:jme)
2665 real, intent(in) :: fzm(kms:kme)
2666 real, intent(in) :: fzp(kms:kme)
2667 real, intent(in) :: g_p(ims:ime,kms:kme,jms:jme)
2668 real, intent(out) :: g_p8w(ims:ime,kms:kme,jms:jme)
2669 real, intent(out) :: g_p_phy(ims:ime,kms:kme,jms:jme)
2670 real, intent(in) :: g_ph(ims:ime,kms:kme,jms:jme)
2671 real, intent(out) :: g_pi_phy(ims:ime,kms:kme,jms:jme)
2672 real, intent(in) :: g_t(ims:ime,kms:kme,jms:jme)
2673 real, intent(out) :: g_t8w(ims:ime,kms:kme,jms:jme)
2674 real, intent(out) :: g_t_phy(ims:ime,kms:kme,jms:jme)
2675 real, intent(out) :: g_th_phy(ims:ime,kms:kme,jms:jme)
2676 real, intent(out) :: g_z(ims:ime,kms:kme,jms:jme)
2677 real, intent(out) :: g_z_at_w(ims:ime,kms:kme,jms:jme)
2678 integer, intent(in) :: ide
2679 integer, intent(in) :: ite
2680 integer, intent(in) :: its
2681 integer, intent(in) :: jde
2682 integer, intent(in) :: jte
2683 integer, intent(in) :: jts
2684 integer, intent(in) :: kde
2685 integer, intent(in) :: kte
2686 integer, intent(in) :: kts
2687 real, intent(out) :: mu_3d(ims:ime,kms:kme,jms:jme)
2688 real, intent(in) :: p(ims:ime,kms:kme,jms:jme)
2689 real, intent(out) :: p8w(ims:ime,kms:kme,jms:jme)
2690 real, intent(out) :: p_phy(ims:ime,kms:kme,jms:jme)
2691 real, intent(in) :: pb(ims:ime,kms:kme,jms:jme)
2692 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
2693 real, intent(in) :: phb(ims:ime,kms:kme,jms:jme)
2694 real, intent(out) :: pi_phy(ims:ime,kms:kme,jms:jme)
2695 real, intent(out) :: rho(ims:ime,kms:kme,jms:jme)
2696 real, intent(inout) :: rqcblten(ims:ime,kms:kme,jms:jme)
2697 real, intent(inout) :: rqccuten(ims:ime,kms:kme,jms:jme)
2698 real, intent(inout) :: rqiblten(ims:ime,kms:kme,jms:jme)
2699 real, intent(inout) :: rqicuten(ims:ime,kms:kme,jms:jme)
2700 real, intent(inout) :: rqrcuten(ims:ime,kms:kme,jms:jme)
2701 real, intent(inout) :: rqscuten(ims:ime,kms:kme,jms:jme)
2702 real, intent(inout) :: rqvblten(ims:ime,kms:kme,jms:jme)
2703 real, intent(inout) :: rqvcuten(ims:ime,kms:kme,jms:jme)
2704 real, intent(inout) :: rqvften(ims:ime,kms:kme,jms:jme)
2705 real, intent(inout) :: rthblten(ims:ime,kms:kme,jms:jme)
2706 real, intent(inout) :: rthcuten(ims:ime,kms:kme,jms:jme)
2707 real, intent(inout) :: rthften(ims:ime,kms:kme,jms:jme)
2708 real, intent(inout) :: rthraten(ims:ime,kms:kme,jms:jme)
2709 real, intent(inout) :: rublten(ims:ime,kms:kme,jms:jme)
2710 real, intent(inout) :: rvblten(ims:ime,kms:kme,jms:jme)
2711 real, intent(in) :: t(ims:ime,kms:kme,jms:jme)
2712 real, intent(out) :: t8w(ims:ime,kms:kme,jms:jme)
2713 real, intent(out) :: t_phy(ims:ime,kms:kme,jms:jme)
2714 real, intent(out) :: th_phy(ims:ime,kms:kme,jms:jme)
2715 real, intent(out) :: u_phy(ims:ime,kms:kme,jms:jme)
2716 real, intent(out) :: v_phy(ims:ime,kms:kme,jms:jme)
2717 real, intent(out) :: z(ims:ime,kms:kme,jms:jme)
2718 real, intent(out) :: z_at_w(ims:ime,kms:kme,jms:jme)
2719
2720 !==============================================
2721 ! declare local variables
2722 !==============================================
2723 real g_w1
2724 real g_w2
2725 real g_z0
2726 real g_z1
2727 real g_z2
2728 integer i
2729 integer i_end
2730 integer i_start
2731 integer j
2732 integer j_end
2733 integer j_start
2734 integer k
2735 integer k_end
2736 integer k_start
2737 real w1
2738 real w2
2739 real z0
2740 real z1
2741 real z2
2742
2743 !----------------------------------------------
2744 ! TANGENT LINEAR AND FUNCTION STATEMENTS
2745 !----------------------------------------------
2746 i_start = its
2747 i_end = min(ite,ide-1)
2748 j_start = jts
2749 j_end = min(jte,jde-1)
2750 k_start = kts
2751 k_end = min(kte,kde-1)
2752 do j = j_start, j_end
2753 do k = k_start, k_end
2754 do i = i_start, i_end
2755 g_th_phy(i,k,j) = g_t(i,k,j)
2756 th_phy(i,k,j) = t(i,k,j)+t0
2757 g_p_phy(i,k,j) = g_p(i,k,j)
2758 p_phy(i,k,j) = p(i,k,j)+pb(i,k,j)
2759 g_pi_phy(i,k,j) = g_p_phy(i,k,j)/p1000mb*rcp*(p_phy(i,k,j)/p1000mb)**(rcp-1)
2760 pi_phy(i,k,j) = (p_phy(i,k,j)/p1000mb)**rcp
2761 g_t_phy(i,k,j) = g_pi_phy(i,k,j)*th_phy(i,k,j)+g_th_phy(i,k,j)*pi_phy(i,k,j)
2762 t_phy(i,k,j) = th_phy(i,k,j)*pi_phy(i,k,j)
2763 end do
2764 end do
2765 end do
2766 do j = j_start, j_end
2767 do k = k_start, kte
2768 do i = i_start, i_end
2769 g_z_at_w(i,k,j) = g_ph(i,k,j)/g
2770 z_at_w(i,k,j) = (phb(i,k,j)+ph(i,k,j))/g
2771 end do
2772 end do
2773 end do
2774 do j = j_start, j_end
2775 do k = k_start, k_end
2776 do i = i_start, i_end
2777 g_z(i,k,j) = 0.5*g_z_at_w(i,k+1,j)+0.5*g_z_at_w(i,k,j)
2778 z(i,k,j) = 0.5*(z_at_w(i,k,j)+z_at_w(i,k+1,j))
2779 end do
2780 end do
2781 end do
2782 do j = j_start, j_end
2783 do k = 2, k_end
2784 do i = i_start, i_end
2785 g_p8w(i,k,j) = g_p_phy(i,k-1,j)*fzp(k)+g_p_phy(i,k,j)*fzm(k)
2786 p8w(i,k,j) = fzm(k)*p_phy(i,k,j)+fzp(k)*p_phy(i,k-1,j)
2787 g_t8w(i,k,j) = g_t_phy(i,k-1,j)*fzp(k)+g_t_phy(i,k,j)*fzm(k)
2788 t8w(i,k,j) = fzm(k)*t_phy(i,k,j)+fzp(k)*t_phy(i,k-1,j)
2789 end do
2790 end do
2791 end do
2792 do j = j_start, j_end
2793 do i = i_start, i_end
2794 g_z0 = g_z_at_w(i,1,j)
2795 z0 = z_at_w(i,1,j)
2796 g_z1 = g_z(i,1,j)
2797 z1 = z(i,1,j)
2798 g_z2 = g_z(i,2,j)
2799 z2 = z(i,2,j)
2800 g_w1 = g_z0/(z1-z2)-g_z1*((z0-z2)/((z1-z2)*(z1-z2)))+g_z2*((-1)/(z1-z2)+(z0-z2)/((z1-z2)*(z1-z2)))
2801 w1 = (z0-z2)/(z1-z2)
2802 g_w2 = -g_w1
2803 w2 = 1.-w1
2804 g_p8w(i,1,j) = g_p_phy(i,2,j)*w2+g_p_phy(i,1,j)*w1+g_w1*p_phy(i,1,j)+g_w2*p_phy(i,2,j)
2805 p8w(i,1,j) = w1*p_phy(i,1,j)+w2*p_phy(i,2,j)
2806 g_t8w(i,1,j) = g_t_phy(i,2,j)*w2+g_t_phy(i,1,j)*w1+g_w1*t_phy(i,1,j)+g_w2*t_phy(i,2,j)
2807 t8w(i,1,j) = w1*t_phy(i,1,j)+w2*t_phy(i,2,j)
2808 g_z0 = g_z_at_w(i,kte,j)
2809 z0 = z_at_w(i,kte,j)
2810 g_z1 = g_z(i,k_end,j)
2811 z1 = z(i,k_end,j)
2812 g_z2 = g_z(i,k_end-1,j)
2813 z2 = z(i,k_end-1,j)
2814 g_w1 = g_z0/(z1-z2)-g_z1*((z0-z2)/((z1-z2)*(z1-z2)))+g_z2*((-1)/(z1-z2)+(z0-z2)/((z1-z2)*(z1-z2)))
2815 w1 = (z0-z2)/(z1-z2)
2816 g_w2 = -g_w1
2817 w2 = 1.-w1
2818 g_p8w(i,kde,j) = (g_p_phy(i,kde-2,j)*w2*(1./p_phy(i,kde-2,j))+g_p_phy(i,kde-1,j)*w1*(1./p_phy(i,kde-1,j)))*exp(w1*log(p_phy(i,&
2819 &kde-1,j))+w2*log(p_phy(i,kde-2,j)))+g_w1*exp(w1*log(p_phy(i,kde-1,j))+w2*log(p_phy(i,kde-2,j)))*log(p_phy(i,kde-1,j))+g_w2*&
2820 &exp(w1*log(p_phy(i,kde-1,j))+w2*log(p_phy(i,kde-2,j)))*log(p_phy(i,kde-2,j))
2821 p8w(i,kde,j) = exp(w1*log(p_phy(i,kde-1,j))+w2*log(p_phy(i,kde-2,j)))
2822 g_t8w(i,kde,j) = g_t_phy(i,kde-2,j)*w2+g_t_phy(i,kde-1,j)*w1+g_w1*t_phy(i,kde-1,j)+g_w2*t_phy(i,kde-2,j)
2823 t8w(i,kde,j) = w1*t_phy(i,kde-1,j)+w2*t_phy(i,kde-2,j)
2824 end do
2825 end do
2826
2827 end subroutine g_phy_prep
2828
2829
2830 subroutine g_rhs_ph( ph_tend, g_ph_tend, u, g_u, v, g_v, ww, g_ww, ph, g_ph, ph_old, g_ph_old, phb, w, g_w, mut, g_mut, muu, g_muu,&
2831 & muv, g_muv, fnm, fnp, rdnw, cfn, cfn1, rdx, rdy, msft, non_hydrostatic, config_flags, ids, ide, jds, jde, kde, ims, ime, jms, &
2832 &jme, kms, kme, its, ite, jts, jte, kts, kte )
2833 !******************************************************************
2834 !******************************************************************
2835 !** This routine was generated by Automatic differentiation. **
2836 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
2837 !******************************************************************
2838 !******************************************************************
2839 !==============================================
2840 ! all entries are defined explicitly
2841 !==============================================
2842 implicit none
2843
2844 !==============================================
2845 ! declare arguments
2846 !==============================================
2847 real, intent(in) :: cfn
2848 real, intent(in) :: cfn1
2849 type (grid_config_rec_type), intent(in) :: config_flags
2850 integer, intent(in) :: kme
2851 integer, intent(in) :: kms
2852 real, intent(in) :: fnm(kms:kme)
2853 real, intent(in) :: fnp(kms:kme)
2854 integer, intent(in) :: ime
2855 integer, intent(in) :: ims
2856 integer, intent(in) :: jme
2857 integer, intent(in) :: jms
2858 real, intent(in) :: g_mut(ims:ime,jms:jme)
2859 real, intent(in) :: g_muu(ims:ime,jms:jme)
2860 real, intent(in) :: g_muv(ims:ime,jms:jme)
2861 real, intent(in) :: g_ph(ims:ime,kms:kme,jms:jme)
2862 real, intent(in) :: g_ph_old(ims:ime,kms:kme,jms:jme)
2863 real, intent(inout) :: g_ph_tend(ims:ime,kms:kme,jms:jme)
2864 real, intent(in) :: g_u(ims:ime,kms:kme,jms:jme)
2865 real, intent(in) :: g_v(ims:ime,kms:kme,jms:jme)
2866 real, intent(in) :: g_w(ims:ime,kms:kme,jms:jme)
2867 real, intent(in) :: g_ww(ims:ime,kms:kme,jms:jme)
2868 integer, intent(in) :: ide
2869 integer, intent(in) :: ids
2870 integer, intent(in) :: ite
2871 integer, intent(in) :: its
2872 integer, intent(in) :: jde
2873 integer, intent(in) :: jds
2874 integer, intent(in) :: jte
2875 integer, intent(in) :: jts
2876 integer, intent(in) :: kde
2877 integer, intent(in) :: kte
2878 integer, intent(in) :: kts
2879 real, intent(in) :: msft(ims:ime,jms:jme)
2880 real, intent(in) :: mut(ims:ime,jms:jme)
2881 real, intent(in) :: muu(ims:ime,jms:jme)
2882 real, intent(in) :: muv(ims:ime,jms:jme)
2883 logical, intent(in) :: non_hydrostatic
2884 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
2885 real, intent(in) :: ph_old(ims:ime,kms:kme,jms:jme)
2886 real, intent(inout) :: ph_tend(ims:ime,kms:kme,jms:jme)
2887 real, intent(in) :: phb(ims:ime,kms:kme,jms:jme)
2888 real, intent(in) :: rdnw(kms:kme)
2889 real, intent(in) :: rdx
2890 real, intent(in) :: rdy
2891 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
2892 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
2893 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
2894 real, intent(in) :: ww(ims:ime,kms:kme,jms:jme)
2895
2896 !==============================================
2897 ! declare local variables
2898 !==============================================
2899 integer advective_order
2900 real g_ub
2901 real g_ul
2902 real g_ur
2903 real g_vb
2904 real g_vl
2905 real g_vr
2906 real g_wdwn(its:ite,kts:kte)
2907 integer i
2908 integer i_start
2909 integer itf
2910 integer j
2911 integer j_start
2912 integer jtf
2913 integer k
2914 integer kz
2915 logical specified
2916 real ub
2917 real ul
2918 real ur
2919 real vb
2920 real vl
2921 real vr
2922 real wdwn(its:ite,kts:kte)
2923
2924 !----------------------------------------------
2925 ! TANGENT LINEAR AND FUNCTION STATEMENTS
2926 !----------------------------------------------
2927 specified = .false.
2928 if (config_flags%specified .or. config_flags%nested) then
2929 specified = .true.
2930 endif
2931 advective_order = config_flags%h_sca_adv_order
2932 itf = min(ite,ide-1)
2933 jtf = min(jte,jde-1)
2934 do j = jts, jtf
2935 do k = 2, kte
2936 do i = its, itf
2937 g_wdwn(i,k) = (-0.5)*g_ph(i,k-1,j)*(ww(i,k,j)+ww(i,k-1,j))*rdnw(k-1)+0.5*g_ph(i,k,j)*(ww(i,k,j)+ww(i,k-1,j))*rdnw(k-1)+0.5*&
2938 &g_ww(i,k-1,j)*rdnw(k-1)*(ph(i,k,j)-ph(i,k-1,j)+phb(i,k,j)-phb(i,k-1,j))+0.5*g_ww(i,k,j)*rdnw(k-1)*(ph(i,k,j)-ph(i,k-1,j)+&
2939 &phb(i,k,j)-phb(i,k-1,j))
2940 wdwn(i,k) = 0.5*(ww(i,k,j)+ww(i,k-1,j))*rdnw(k-1)*(ph(i,k,j)-ph(i,k-1,j)+phb(i,k,j)-phb(i,k-1,j))
2941 end do
2942 end do
2943 do k = 2, kte-1
2944 do i = its, itf
2945 g_ph_tend(i,k,j) = g_ph_tend(i,k,j)-g_wdwn(i,k+1)*fnm(k)-g_wdwn(i,k)*fnp(k)
2946 ph_tend(i,k,j) = ph_tend(i,k,j)-(fnm(k)*wdwn(i,k+1)+fnp(k)*wdwn(i,k))
2947 end do
2948 end do
2949 end do
2950 if (non_hydrostatic) then
2951 do j = jts, jtf
2952 do i = its, itf
2953 g_ph_tend(i,kde,j) = 0.
2954 ph_tend(i,kde,j) = 0.
2955 end do
2956 do k = 2, kte
2957 do i = its, itf
2958 g_ph_tend(i,k,j) = g_mut(i,j)*(g*w(i,k,j)/msft(i,j))+g_ph_tend(i,k,j)+g_w(i,k,j)*(mut(i,j)*g/msft(i,j))
2959 ph_tend(i,k,j) = ph_tend(i,k,j)+mut(i,j)*g*w(i,k,j)/msft(i,j)
2960 end do
2961 end do
2962 end do
2963 endif
2964 if (advective_order .le. 2) then
2965 i_start = its
2966 j_start = jts
2967 itf = min(ite,ide-1)
2968 jtf = min(jte,jde-1)
2969 if (config_flags%open_ys .and. jts .eq. jds) then
2970 j_start = jts+1
2971 endif
2972 if (config_flags%open_ye .and. jte .eq. jde) then
2973 jtf = jtf-1
2974 endif
2975 do j = j_start, jtf
2976 do k = 2, kte-1
2977 do i = i_start, itf
2978 g_ph_tend(i,k,j) = (-(0.25*g_muv(i,j+1)*rdy*(v(i,k,j+1)+v(i,k-1,j+1))*(phb(i,k,j+1)-phb(i,k,j)+ph(i,k,j+1)-ph(i,k,j))))-&
2979 &0.25*g_muv(i,j)*rdy*(v(i,k,j)+v(i,k-1,j))*(phb(i,k,j)-phb(i,k,j-1)+ph(i,k,j)-ph(i,k,j-1))+0.25*g_ph(i,k,j-1)*rdy*muv(i,j)*&
2980 &(v(i,k,j)+v(i,k-1,j))-0.25*g_ph(i,k,j+1)*rdy*muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))-0.25*g_ph(i,k,j)*rdy*((-(muv(i,j+1)*&
2981 &(v(i,k,j+1)+v(i,k-1,j+1))))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))+g_ph_tend(i,k,j)-0.25*g_v(i,k-1,j+1)*rdy*muv(i,j+1)*(phb(i,k,&
2982 &j+1)-phb(i,k,j)+ph(i,k,j+1)-ph(i,k,j))-0.25*g_v(i,k-1,j)*rdy*muv(i,j)*(phb(i,k,j)-phb(i,k,j-1)+ph(i,k,j)-ph(i,k,j-1))-&
2983 &0.25*g_v(i,k,j+1)*rdy*muv(i,j+1)*(phb(i,k,j+1)-phb(i,k,j)+ph(i,k,j+1)-ph(i,k,j))-0.25*g_v(i,k,j)*rdy*muv(i,j)*(phb(i,k,j)-&
2984 &phb(i,k,j-1)+ph(i,k,j)-ph(i,k,j-1))
2985 ph_tend(i,k,j) = ph_tend(i,k,j)-0.25*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*(phb(i,k,j+1)-phb(i,k,j)+ph(i,k,j+1)-ph(i,k,&
2986 &j))+muv(i,j)*(v(i,k,j)+v(i,k-1,j))*(phb(i,k,j)-phb(i,k,j-1)+ph(i,k,j)-ph(i,k,j-1)))
2987 end do
2988 end do
2989 k = kte
2990 do i = i_start, itf
2991 g_ph_tend(i,k,j) = (-(0.5*g_muv(i,j+1)*rdy*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*(phb(i,k,j+1)-phb(i,k,j)+ph(i,k,j+1)-ph(i,k,&
2992 &j))))-0.5*g_muv(i,j)*rdy*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j))*(phb(i,k,j)-phb(i,k,j-1)+ph(i,k,j)-ph(i,k,j-1))+0.5*g_ph(i,k,j-1)*&
2993 &rdy*muv(i,j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j))-0.5*g_ph(i,k,j+1)*rdy*muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))-0.5*&
2994 &g_ph(i,k,j)*rdy*((-(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))))+muv(i,j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))+&
2995 &g_ph_tend(i,k,j)-0.5*g_v(i,k-2,j+1)*rdy*muv(i,j+1)*cfn1*(phb(i,k,j+1)-phb(i,k,j)+ph(i,k,j+1)-ph(i,k,j))-0.5*g_v(i,k-2,j)*&
2996 &rdy*muv(i,j)*cfn1*(phb(i,k,j)-phb(i,k,j-1)+ph(i,k,j)-ph(i,k,j-1))-0.5*g_v(i,k-1,j+1)*rdy*muv(i,j+1)*cfn*(phb(i,k,j+1)-phb(i,&
2997 &k,j)+ph(i,k,j+1)-ph(i,k,j))-0.5*g_v(i,k-1,j)*rdy*muv(i,j)*cfn*(phb(i,k,j)-phb(i,k,j-1)+ph(i,k,j)-ph(i,k,j-1))
2998 ph_tend(i,k,j) = ph_tend(i,k,j)-0.5*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*(phb(i,k,j+1)-phb(i,k,j)+ph(i,k,j+1)&
2999 &-ph(i,k,j))+muv(i,j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j))*(phb(i,k,j)-phb(i,k,j-1)+ph(i,k,j)-ph(i,k,j-1)))
3000 end do
3001 end do
3002 i_start = its
3003 j_start = jts
3004 itf = min(ite,ide-1)
3005 jtf = min(jte,jde-1)
3006 if (config_flags%open_xs .and. its .eq. ids) then
3007 i_start = its+1
3008 endif
3009 if (config_flags%open_xe .and. ite .eq. ide) then
3010 itf = itf-1
3011 endif
3012 do j = j_start, jtf
3013 do k = 2, kte-1
3014 do i = i_start, itf
3015 g_ph_tend(i,k,j) = (-(0.25*g_muu(i+1,j)*rdx*(u(i+1,k,j)+u(i+1,k-1,j))*(phb(i+1,k,j)-phb(i,k,j)+ph(i+1,k,j)-ph(i,k,j))))-&
3016 &0.25*g_muu(i,j)*rdx*(u(i,k,j)+u(i,k-1,j))*(phb(i,k,j)-phb(i-1,k,j)+ph(i,k,j)-ph(i-1,k,j))+0.25*g_ph(i-1,k,j)*rdx*muu(i,j)*&
3017 &(u(i,k,j)+u(i,k-1,j))-0.25*g_ph(i+1,k,j)*rdx*muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))-0.25*g_ph(i,k,j)*rdx*((-(muu(i+1,j)*&
3018 &(u(i+1,k,j)+u(i+1,k-1,j))))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))+g_ph_tend(i,k,j)-0.25*g_u(i+1,k-1,j)*rdx*muu(i+1,j)*(phb(i+1,&
3019 &k,j)-phb(i,k,j)+ph(i+1,k,j)-ph(i,k,j))-0.25*g_u(i,k-1,j)*rdx*muu(i,j)*(phb(i,k,j)-phb(i-1,k,j)+ph(i,k,j)-ph(i-1,k,j))-&
3020 &0.25*g_u(i+1,k,j)*rdx*muu(i+1,j)*(phb(i+1,k,j)-phb(i,k,j)+ph(i+1,k,j)-ph(i,k,j))-0.25*g_u(i,k,j)*rdx*muu(i,j)*(phb(i,k,j)-&
3021 &phb(i-1,k,j)+ph(i,k,j)-ph(i-1,k,j))
3022 ph_tend(i,k,j) = ph_tend(i,k,j)-0.25*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*(phb(i+1,k,j)-phb(i,k,j)+ph(i+1,k,j)-ph(i,k,&
3023 &j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j))*(phb(i,k,j)-phb(i-1,k,j)+ph(i,k,j)-ph(i-1,k,j)))
3024 end do
3025 end do
3026 k = kte
3027 do i = i_start, itf
3028 g_ph_tend(i,k,j) = (-(0.5*g_muu(i+1,j)*rdx*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*(phb(i+1,k,j)-phb(i,k,j)+ph(i+1,k,j)-ph(i,k,&
3029 &j))))-0.5*g_muu(i,j)*rdx*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j))*(phb(i,k,j)-phb(i-1,k,j)+ph(i,k,j)-ph(i-1,k,j))+0.5*g_ph(i-1,k,j)*&
3030 &rdx*muu(i,j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j))-0.5*g_ph(i+1,k,j)*rdx*muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))-0.5*&
3031 &g_ph(i,k,j)*rdx*((-(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))))+muu(i,j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))+&
3032 &g_ph_tend(i,k,j)-0.5*g_u(i+1,k-2,j)*rdx*muu(i+1,j)*cfn1*(phb(i+1,k,j)-phb(i,k,j)+ph(i+1,k,j)-ph(i,k,j))-0.5*g_u(i,k-2,j)*&
3033 &rdx*muu(i,j)*cfn1*(phb(i,k,j)-phb(i-1,k,j)+ph(i,k,j)-ph(i-1,k,j))-0.5*g_u(i+1,k-1,j)*rdx*muu(i+1,j)*cfn*(phb(i+1,k,j)-phb(i,&
3034 &k,j)+ph(i+1,k,j)-ph(i,k,j))-0.5*g_u(i,k-1,j)*rdx*muu(i,j)*cfn*(phb(i,k,j)-phb(i-1,k,j)+ph(i,k,j)-ph(i-1,k,j))
3035 ph_tend(i,k,j) = ph_tend(i,k,j)-0.5*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*(phb(i+1,k,j)-phb(i,k,j)+ph(i+1,k,j)&
3036 &-ph(i,k,j))+muu(i,j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j))*(phb(i,k,j)-phb(i-1,k,j)+ph(i,k,j)-ph(i-1,k,j)))
3037 end do
3038 end do
3039 else if (advective_order .le. 4) then
3040 i_start = its
3041 j_start = jts
3042 itf = min(ite,ide-1)
3043 jtf = min(jte,jde-1)
3044 if (config_flags%open_ys .and. jts .eq. jds) then
3045 j_start = jts+1
3046 endif
3047 if (config_flags%open_ye .and. jte .eq. jde) then
3048 jtf = jtf-1
3049 endif
3050 do j = j_start, jtf
3051 do k = 2, kte-1
3052 do i = i_start, itf
3053 g_ph_tend(i,k,j) = (-(0.083333333*0.25*g_muv(i,j+1)*rdy*(v(i,k,j+1)+v(i,k-1,j+1))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+&
3054 &2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))))-0.083333333*0.25*g_muv(i,j)*rdy*(v(i,k,j)+&
3055 &v(i,k-1,j))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,&
3056 &j-2)))-0.083333333*0.25*g_ph(i,k,j-2)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-(-&
3057 &0.66666667)*0.25*g_ph(i,k,j-1)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-(-0.083333333)*&
3058 &0.25*g_ph(i,k,j+2)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-0.66666667*0.25*g_ph(i,k,j+1)&
3059 &*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))+g_ph_tend(i,k,j)-0.083333333*0.25*g_v(i,k-1,j+&
3060 &1)*rdy*muv(i,j+1)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-&
3061 &phb(i,k,j-2)))-0.083333333*0.25*g_v(i,k-1,j)*rdy*muv(i,j)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*&
3062 &(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))-0.083333333*0.25*g_v(i,k,j+1)*rdy*muv(i,j+1)*(8.*(ph(i,k,j+1)-&
3063 &ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))-0.083333333*0.25*g_v(i,&
3064 &k,j)*rdy*muv(i,j)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-&
3065 &phb(i,k,j-2)))
3066 ph_tend(i,k,j) = ph_tend(i,k,j)-0.25*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))*(1./12.)*&
3067 &(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
3068 end do
3069 end do
3070 k = kte
3071 do i = i_start, itf
3072 g_ph_tend(i,k,j) = (-(0.083333333*0.5*g_muv(i,j+1)*rdy*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-&
3073 &(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))))-0.083333333*0.5*g_muv(i,j)*rdy*(cfn*&
3074 &v(i,k-1,j)+cfn1*v(i,k-2,j))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,&
3075 &j+2)-phb(i,k,j-2)))-0.083333333*0.5*g_ph(i,k,j-2)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*v(i,k-&
3076 &1,j)+cfn1*v(i,k-2,j)))-(-0.66666667)*0.5*g_ph(i,k,j-1)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*&
3077 &v(i,k-1,j)+cfn1*v(i,k-2,j)))-(-0.083333333)*0.5*g_ph(i,k,j+2)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*&
3078 &(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))-0.66666667*0.5*g_ph(i,k,j+1)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)&
3079 &*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))+g_ph_tend(i,k,j)-0.083333333*0.5*g_v(i,k-2,j+1)*rdy*muv(i,j+1)*cfn1*(8.*(ph(i,k,j+1)-&
3080 &ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))-0.083333333*0.5*g_v(i,k-&
3081 &2,j)*rdy*muv(i,j)*cfn1*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-&
3082 &phb(i,k,j-2)))-0.083333333*0.5*g_v(i,k-1,j+1)*rdy*muv(i,j+1)*cfn*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*&
3083 &(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))-0.083333333*0.5*g_v(i,k-1,j)*rdy*muv(i,j)*cfn*(8.*(ph(i,k,j+1)-&
3084 &ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
3085 ph_tend(i,k,j) = ph_tend(i,k,j)-0.5*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-&
3086 &2,j)))*(1./12.)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
3087 end do
3088 end do
3089 i_start = its
3090 j_start = jts
3091 itf = min(ite,ide-1)
3092 jtf = min(jte,jde-1)
3093 if (config_flags%open_xs .and. its .eq. ids) then
3094 i_start = its+1
3095 endif
3096 if (config_flags%open_xe .and. ite .eq. ide) then
3097 itf = itf-1
3098 endif
3099 do j = j_start, jtf
3100 do k = 2, kte-1
3101 do i = i_start, itf
3102 g_ph_tend(i,k,j) = (-(0.083333333*0.25*g_muu(i+1,j)*rdx*(u(i+1,k,j)+u(i+1,k-1,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,&
3103 &j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))))-0.083333333*0.25*g_muu(i,j)*rdx*(u(i,k,j)+&
3104 &u(i,k-1,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,&
3105 &k,j)))-0.083333333*0.25*g_ph(i-2,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-(-&
3106 &0.66666667)*0.25*g_ph(i-1,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-(-0.083333333)*&
3107 &0.25*g_ph(i+2,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-0.66666667*0.25*g_ph(i+1,k,j)&
3108 &*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))+g_ph_tend(i,k,j)-0.083333333*0.25*g_u(i+1,k-1,&
3109 &j)*rdx*muu(i+1,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-&
3110 &phb(i-2,k,j)))-0.083333333*0.25*g_u(i,k-1,j)*rdx*muu(i,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*&
3111 &(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))-0.083333333*0.25*g_u(i+1,k,j)*rdx*muu(i+1,j)*(8.*(ph(i+1,k,j)-&
3112 &ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))-0.083333333*0.25*g_u(i,&
3113 &k,j)*rdx*muu(i,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-&
3114 &phb(i-2,k,j)))
3115 ph_tend(i,k,j) = ph_tend(i,k,j)-0.25*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))*(1./12.)*&
3116 &(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
3117 end do
3118 end do
3119 k = kte
3120 do i = i_start, itf
3121 g_ph_tend(i,k,j) = (-(0.083333333*0.5*g_muu(i+1,j)*rdx*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-&
3122 &(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))))-0.083333333*0.5*g_muu(i,j)*rdx*(cfn*&
3123 &u(i,k-1,j)+cfn1*u(i,k-2,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,&
3124 &k,j)-phb(i-2,k,j)))-0.083333333*0.5*g_ph(i-2,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*u(i,k-&
3125 &1,j)+cfn1*u(i,k-2,j)))-(-0.66666667)*0.5*g_ph(i-1,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*&
3126 &u(i,k-1,j)+cfn1*u(i,k-2,j)))-(-0.083333333)*0.5*g_ph(i+2,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*&
3127 &(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))-0.66666667*0.5*g_ph(i+1,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)&
3128 &*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))+g_ph_tend(i,k,j)-0.083333333*0.5*g_u(i+1,k-2,j)*rdx*muu(i+1,j)*cfn1*(8.*(ph(i+1,k,j)-&
3129 &ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))-0.083333333*0.5*g_u(i,k-&
3130 &2,j)*rdx*muu(i,j)*cfn1*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-&
3131 &phb(i-2,k,j)))-0.083333333*0.5*g_u(i+1,k-1,j)*rdx*muu(i+1,j)*cfn*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*&
3132 &(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))-0.083333333*0.5*g_u(i,k-1,j)*rdx*muu(i,j)*cfn*(8.*(ph(i+1,k,j)-&
3133 &ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
3134 ph_tend(i,k,j) = ph_tend(i,k,j)-0.5*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-&
3135 &2,j)))*(1./12.)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
3136 end do
3137 end do
3138 else if (advective_order .le. 6) then
3139 i_start = its
3140 j_start = jts
3141 itf = min(ite,ide-1)
3142 jtf = min(jte,jde-1)
3143 if (config_flags%open_ys .or. specified) then
3144 j_start = max(jts,jds+2)
3145 endif
3146 if (config_flags%open_ye .or. specified) then
3147 jtf = min(jtf,jde-3)
3148 endif
3149 do j = j_start, jtf
3150 do k = 2, kte-1
3151 do i = i_start, itf
3152 g_ph_tend(i,k,j) = (-(0.016666667*0.25*g_muv(i,j+1)*rdy*(v(i,k,j+1)+v(i,k-1,j+1))*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,&
3153 &k,j+2)-ph(i,k,j-2))+ph(i,k,j+3)-ph(i,k,j-3)+45.*(phb(i,k,j+1)-phb(i,k,j-1))-9.*(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,j+3)-&
3154 &phb(i,k,j-3))))-0.016666667*0.25*g_muv(i,j)*rdy*(v(i,k,j)+v(i,k-1,j))*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)-ph(i,&
3155 &k,j-2))+ph(i,k,j+3)-ph(i,k,j-3)+45.*(phb(i,k,j+1)-phb(i,k,j-1))-9.*(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,j+3)-phb(i,k,j-3))-&
3156 &(-0.016666667)*0.25*g_ph(i,k,j-3)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-0.15*0.25*&
3157 &g_ph(i,k,j-2)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-(-0.75)*0.25*g_ph(i,k,j-1)*rdy*&
3158 &(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-0.016666667*0.25*g_ph(i,k,j+3)*rdy*(muv(i,j+1)*(v(i,&
3159 &k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-(-0.15)*0.25*g_ph(i,k,j+2)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+&
3160 &muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-0.75*0.25*g_ph(i,k,j+1)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,&
3161 &k-1,j)))+g_ph_tend(i,k,j)-0.016666667*0.25*g_v(i,k-1,j+1)*rdy*muv(i,j+1)*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)-&
3162 &ph(i,k,j-2))+ph(i,k,j+3)-ph(i,k,j-3)+45.*(phb(i,k,j+1)-phb(i,k,j-1))-9.*(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,j+3)-phb(i,k,&
3163 &j-3))-0.016666667*0.25*g_v(i,k-1,j)*rdy*muv(i,j)*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)-ph(i,k,j-2))+ph(i,k,j+3)-&
3164 &ph(i,k,j-3)+45.*(phb(i,k,j+1)-phb(i,k,j-1))-9.*(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,j+3)-phb(i,k,j-3))-0.016666667*0.25*&
3165 &g_v(i,k,j+1)*rdy*muv(i,j+1)*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)-ph(i,k,j-2))+ph(i,k,j+3)-ph(i,k,j-3)+45.*&
3166 &(phb(i,k,j+1)-phb(i,k,j-1))-9.*(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,j+3)-phb(i,k,j-3))-0.016666667*0.25*g_v(i,k,j)*rdy*&
3167 &muv(i,j)*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)-ph(i,k,j-2))+ph(i,k,j+3)-ph(i,k,j-3)+45.*(phb(i,k,j+1)-phb(i,k,j-&
3168 &1))-9.*(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,j+3)-phb(i,k,j-3))
3169 ph_tend(i,k,j) = ph_tend(i,k,j)-0.25*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))*(1./60.)*&
3170 &(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)-ph(i,k,j-2))+ph(i,k,j+3)-ph(i,k,j-3)+45.*(phb(i,k,j+1)-phb(i,k,j-1))-9.*&
3171 &(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,j+3)-phb(i,k,j-3))
3172 end do
3173 end do
3174 k = kte
3175 do i = i_start, itf
3176 g_ph_tend(i,k,j) = (-(0.016666667*0.5*g_muv(i,j+1)*rdy*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-&
3177 &9.*(ph(i,k,j+2)-ph(i,k,j-2))+ph(i,k,j+3)-ph(i,k,j-3)+45.*(phb(i,k,j+1)-phb(i,k,j-1))-9.*(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,&
3178 &j+3)-phb(i,k,j-3))))-0.016666667*0.5*g_muv(i,j)*rdy*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j))*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*&
3179 &(ph(i,k,j+2)-ph(i,k,j-2))+ph(i,k,j+3)-ph(i,k,j-3)+45.*(phb(i,k,j+1)-phb(i,k,j-1))-9.*(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,j+&
3180 &3)-phb(i,k,j-3))-(-0.016666667)*0.5*g_ph(i,k,j-3)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*v(i,k-&
3181 &1,j)+cfn1*v(i,k-2,j)))-0.15*0.5*g_ph(i,k,j-2)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*v(i,k-1,j)+&
3182 &cfn1*v(i,k-2,j)))-(-0.75)*0.5*g_ph(i,k,j-1)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*v(i,k-1,j)+&
3183 &cfn1*v(i,k-2,j)))-0.016666667*0.5*g_ph(i,k,j+3)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*v(i,k-1,&
3184 &j)+cfn1*v(i,k-2,j)))-(-0.15)*0.5*g_ph(i,k,j+2)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*v(i,k-1,j)&
3185 &+cfn1*v(i,k-2,j)))-0.75*0.5*g_ph(i,k,j+1)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*v(i,k-1,j)+&
3186 &cfn1*v(i,k-2,j)))+g_ph_tend(i,k,j)-0.016666667*0.5*g_v(i,k-2,j+1)*rdy*muv(i,j+1)*cfn1*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*&
3187 &(ph(i,k,j+2)-ph(i,k,j-2))+ph(i,k,j+3)-ph(i,k,j-3)+45.*(phb(i,k,j+1)-phb(i,k,j-1))-9.*(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,j+&
3188 &3)-phb(i,k,j-3))-0.016666667*0.5*g_v(i,k-2,j)*rdy*muv(i,j)*cfn1*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)-ph(i,k,j-2))+&
3189 &ph(i,k,j+3)-ph(i,k,j-3)+45.*(phb(i,k,j+1)-phb(i,k,j-1))-9.*(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,j+3)-phb(i,k,j-3))-&
3190 &0.016666667*0.5*g_v(i,k-1,j+1)*rdy*muv(i,j+1)*cfn*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)-ph(i,k,j-2))+ph(i,k,j+3)-&
3191 &ph(i,k,j-3)+45.*(phb(i,k,j+1)-phb(i,k,j-1))-9.*(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,j+3)-phb(i,k,j-3))-0.016666667*0.5*g_v(i,&
3192 &k-1,j)*rdy*muv(i,j)*cfn*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)-ph(i,k,j-2))+ph(i,k,j+3)-ph(i,k,j-3)+45.*(phb(i,k,j+&
3193 &1)-phb(i,k,j-1))-9.*(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,j+3)-phb(i,k,j-3))
3194 ph_tend(i,k,j) = ph_tend(i,k,j)-0.5*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-&
3195 &2,j)))*(1./60.)*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)-ph(i,k,j-2))+ph(i,k,j+3)-ph(i,k,j-3)+45.*(phb(i,k,j+1)-phb(i,&
3196 &k,j-1))-9.*(phb(i,k,j+2)-phb(i,k,j-2))+phb(i,k,j+3)-phb(i,k,j-3))
3197 end do
3198 end do
3199 if (config_flags%open_ys .and. jts .le. jds+1) then
3200 j = jds+1
3201 do k = 2, kte-1
3202 do i = i_start, itf
3203 g_ph_tend(i,k,j) = (-(0.083333333*0.25*g_muv(i,j+1)*rdy*(v(i,k,j+1)+v(i,k-1,j+1))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+&
3204 &2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))))-0.083333333*0.25*g_muv(i,j)*rdy*(v(i,k,j)+&
3205 &v(i,k-1,j))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,&
3206 &j-2)))-0.083333333*0.25*g_ph(i,k,j-2)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-(-&
3207 &0.66666667)*0.25*g_ph(i,k,j-1)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-(-0.083333333)*&
3208 &0.25*g_ph(i,k,j+2)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-0.66666667*0.25*g_ph(i,k,j+1)&
3209 &*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))+g_ph_tend(i,k,j)-0.083333333*0.25*g_v(i,k-1,j+&
3210 &1)*rdy*muv(i,j+1)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-&
3211 &phb(i,k,j-2)))-0.083333333*0.25*g_v(i,k-1,j)*rdy*muv(i,j)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*&
3212 &(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))-0.083333333*0.25*g_v(i,k,j+1)*rdy*muv(i,j+1)*(8.*(ph(i,k,j+1)-&
3213 &ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))-0.083333333*0.25*g_v(i,&
3214 &k,j)*rdy*muv(i,j)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-&
3215 &phb(i,k,j-2)))
3216 ph_tend(i,k,j) = ph_tend(i,k,j)-0.25*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))*(1./12.)*&
3217 &(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
3218 end do
3219 end do
3220 k = kte
3221 do i = i_start, itf
3222 g_ph_tend(i,k,j) = (-(0.083333333*0.5*g_muv(i,j+1)*rdy*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-&
3223 &(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))))-0.083333333*0.5*g_muv(i,j)*rdy*(cfn*&
3224 &v(i,k-1,j)+cfn1*v(i,k-2,j))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,&
3225 &j+2)-phb(i,k,j-2)))-0.083333333*0.5*g_ph(i,k,j-2)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*v(i,k-&
3226 &1,j)+cfn1*v(i,k-2,j)))-(-0.66666667)*0.5*g_ph(i,k,j-1)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*&
3227 &v(i,k-1,j)+cfn1*v(i,k-2,j)))-(-0.083333333)*0.5*g_ph(i,k,j+2)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*&
3228 &(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))-0.66666667*0.5*g_ph(i,k,j+1)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)&
3229 &*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))+g_ph_tend(i,k,j)-0.083333333*0.5*g_v(i,k-2,j+1)*rdy*muv(i,j+1)*cfn1*(8.*(ph(i,k,j+1)-&
3230 &ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))-0.083333333*0.5*g_v(i,k-&
3231 &2,j)*rdy*muv(i,j)*cfn1*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-&
3232 &phb(i,k,j-2)))-0.083333333*0.5*g_v(i,k-1,j+1)*rdy*muv(i,j+1)*cfn*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*&
3233 &(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))-0.083333333*0.5*g_v(i,k-1,j)*rdy*muv(i,j)*cfn*(8.*(ph(i,k,j+1)-&
3234 &ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
3235 ph_tend(i,k,j) = ph_tend(i,k,j)-0.5*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-&
3236 &2,j)))*(1./12.)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
3237 end do
3238 endif
3239 if (config_flags%open_ye .and. jte .ge. jde-2) then
3240 j = jde-2
3241 do k = 2, kte-1
3242 do i = i_start, itf
3243 g_ph_tend(i,k,j) = (-(0.083333333*0.25*g_muv(i,j+1)*rdy*(v(i,k,j+1)+v(i,k-1,j+1))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+&
3244 &2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))))-0.083333333*0.25*g_muv(i,j)*rdy*(v(i,k,j)+&
3245 &v(i,k-1,j))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,&
3246 &j-2)))-0.083333333*0.25*g_ph(i,k,j-2)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-(-&
3247 &0.66666667)*0.25*g_ph(i,k,j-1)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-(-0.083333333)*&
3248 &0.25*g_ph(i,k,j+2)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))-0.66666667*0.25*g_ph(i,k,j+1)&
3249 &*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))+g_ph_tend(i,k,j)-0.083333333*0.25*g_v(i,k-1,j+&
3250 &1)*rdy*muv(i,j+1)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-&
3251 &phb(i,k,j-2)))-0.083333333*0.25*g_v(i,k-1,j)*rdy*muv(i,j)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*&
3252 &(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))-0.083333333*0.25*g_v(i,k,j+1)*rdy*muv(i,j+1)*(8.*(ph(i,k,j+1)-&
3253 &ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))-0.083333333*0.25*g_v(i,&
3254 &k,j)*rdy*muv(i,j)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-&
3255 &phb(i,k,j-2)))
3256 ph_tend(i,k,j) = ph_tend(i,k,j)-0.25*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+v(i,k-1,j)))*(1./12.)*&
3257 &(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
3258 end do
3259 end do
3260 k = kte
3261 do i = i_start, itf
3262 g_ph_tend(i,k,j) = (-(0.083333333*0.5*g_muv(i,j+1)*rdy*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-&
3263 &(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))))-0.083333333*0.5*g_muv(i,j)*rdy*(cfn*&
3264 &v(i,k-1,j)+cfn1*v(i,k-2,j))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,&
3265 &j+2)-phb(i,k,j-2)))-0.083333333*0.5*g_ph(i,k,j-2)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*v(i,k-&
3266 &1,j)+cfn1*v(i,k-2,j)))-(-0.66666667)*0.5*g_ph(i,k,j-1)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*&
3267 &v(i,k-1,j)+cfn1*v(i,k-2,j)))-(-0.083333333)*0.5*g_ph(i,k,j+2)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*&
3268 &(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))-0.66666667*0.5*g_ph(i,k,j+1)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)&
3269 &*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))+g_ph_tend(i,k,j)-0.083333333*0.5*g_v(i,k-2,j+1)*rdy*muv(i,j+1)*cfn1*(8.*(ph(i,k,j+1)-&
3270 &ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))-0.083333333*0.5*g_v(i,k-&
3271 &2,j)*rdy*muv(i,j)*cfn1*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-&
3272 &phb(i,k,j-2)))-0.083333333*0.5*g_v(i,k-1,j+1)*rdy*muv(i,j+1)*cfn*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*&
3273 &(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))-0.083333333*0.5*g_v(i,k-1,j)*rdy*muv(i,j)*cfn*(8.*(ph(i,k,j+1)-&
3274 &ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
3275 ph_tend(i,k,j) = ph_tend(i,k,j)-0.5*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-&
3276 &2,j)))*(1./12.)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
3277 end do
3278 endif
3279 i_start = its
3280 j_start = jts
3281 itf = min(ite,ide-1)
3282 jtf = min(jte,jde-1)
3283 if (config_flags%open_xs .or. specified) then
3284 i_start = max(its,ids+2)
3285 endif
3286 if (config_flags%open_xe .or. specified) then
3287 itf = min(itf,ide-3)
3288 endif
3289 do j = j_start, jtf
3290 do k = 2, kte-1
3291 do i = i_start, itf
3292 g_ph_tend(i,k,j) = (-(0.016666667*0.25*g_muu(i+1,j)*rdx*(u(i+1,k,j)+u(i+1,k-1,j))*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+&
3293 &2,k,j)-ph(i-2,k,j))+ph(i+3,k,j)-ph(i-3,k,j)+45.*(phb(i+1,k,j)-phb(i-1,k,j))-9.*(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,k,j)-&
3294 &phb(i-3,k,j))))-0.016666667*0.25*g_muu(i,j)*rdx*(u(i,k,j)+u(i,k-1,j))*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)-ph(i-&
3295 &2,k,j))+ph(i+3,k,j)-ph(i-3,k,j)+45.*(phb(i+1,k,j)-phb(i-1,k,j))-9.*(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,k,j)-phb(i-3,k,j))-&
3296 &(-0.016666667)*0.25*g_ph(i-3,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-0.15*0.25*&
3297 &g_ph(i-2,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-(-0.75)*0.25*g_ph(i-1,k,j)*rdx*&
3298 &(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-0.016666667*0.25*g_ph(i+3,k,j)*rdx*(muu(i+1,j)*(u(i+&
3299 &1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-(-0.15)*0.25*g_ph(i+2,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+&
3300 &muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-0.75*0.25*g_ph(i+1,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,&
3301 &k-1,j)))+g_ph_tend(i,k,j)-0.016666667*0.25*g_u(i+1,k-1,j)*rdx*muu(i+1,j)*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)-&
3302 &ph(i-2,k,j))+ph(i+3,k,j)-ph(i-3,k,j)+45.*(phb(i+1,k,j)-phb(i-1,k,j))-9.*(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,k,j)-phb(i-3,&
3303 &k,j))-0.016666667*0.25*g_u(i,k-1,j)*rdx*muu(i,j)*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)-ph(i-2,k,j))+ph(i+3,k,j)-&
3304 &ph(i-3,k,j)+45.*(phb(i+1,k,j)-phb(i-1,k,j))-9.*(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,k,j)-phb(i-3,k,j))-0.016666667*0.25*&
3305 &g_u(i+1,k,j)*rdx*muu(i+1,j)*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)-ph(i-2,k,j))+ph(i+3,k,j)-ph(i-3,k,j)+45.*&
3306 &(phb(i+1,k,j)-phb(i-1,k,j))-9.*(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,k,j)-phb(i-3,k,j))-0.016666667*0.25*g_u(i,k,j)*rdx*&
3307 &muu(i,j)*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)-ph(i-2,k,j))+ph(i+3,k,j)-ph(i-3,k,j)+45.*(phb(i+1,k,j)-phb(i-1,k,&
3308 &j))-9.*(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,k,j)-phb(i-3,k,j))
3309 ph_tend(i,k,j) = ph_tend(i,k,j)-0.25*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))*(1./60.)*&
3310 &(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)-ph(i-2,k,j))+ph(i+3,k,j)-ph(i-3,k,j)+45.*(phb(i+1,k,j)-phb(i-1,k,j))-9.*&
3311 &(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,k,j)-phb(i-3,k,j))
3312 end do
3313 end do
3314 k = kte
3315 do i = i_start, itf
3316 g_ph_tend(i,k,j) = (-(0.016666667*0.5*g_muu(i+1,j)*rdx*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-&
3317 &9.*(ph(i+2,k,j)-ph(i-2,k,j))+ph(i+3,k,j)-ph(i-3,k,j)+45.*(phb(i+1,k,j)-phb(i-1,k,j))-9.*(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,&
3318 &k,j)-phb(i-3,k,j))))-0.016666667*0.5*g_muu(i,j)*rdx*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j))*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*&
3319 &(ph(i+2,k,j)-ph(i-2,k,j))+ph(i+3,k,j)-ph(i-3,k,j)+45.*(phb(i+1,k,j)-phb(i-1,k,j))-9.*(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,k,&
3320 &j)-phb(i-3,k,j))-(-0.016666667)*0.5*g_ph(i-3,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*u(i,k-&
3321 &1,j)+cfn1*u(i,k-2,j)))-0.15*0.5*g_ph(i-2,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*u(i,k-1,j)+&
3322 &cfn1*u(i,k-2,j)))-(-0.75)*0.5*g_ph(i-1,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*u(i,k-1,j)+&
3323 &cfn1*u(i,k-2,j)))-0.016666667*0.5*g_ph(i+3,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*u(i,k-1,&
3324 &j)+cfn1*u(i,k-2,j)))-(-0.15)*0.5*g_ph(i+2,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*u(i,k-1,j)&
3325 &+cfn1*u(i,k-2,j)))-0.75*0.5*g_ph(i+1,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*u(i,k-1,j)+&
3326 &cfn1*u(i,k-2,j)))+g_ph_tend(i,k,j)-0.016666667*0.5*g_u(i+1,k-2,j)*rdx*muu(i+1,j)*cfn1*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*&
3327 &(ph(i+2,k,j)-ph(i-2,k,j))+ph(i+3,k,j)-ph(i-3,k,j)+45.*(phb(i+1,k,j)-phb(i-1,k,j))-9.*(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,k,&
3328 &j)-phb(i-3,k,j))-0.016666667*0.5*g_u(i,k-2,j)*rdx*muu(i,j)*cfn1*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)-ph(i-2,k,j))+&
3329 &ph(i+3,k,j)-ph(i-3,k,j)+45.*(phb(i+1,k,j)-phb(i-1,k,j))-9.*(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,k,j)-phb(i-3,k,j))-&
3330 &0.016666667*0.5*g_u(i+1,k-1,j)*rdx*muu(i+1,j)*cfn*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)-ph(i-2,k,j))+ph(i+3,k,j)-&
3331 &ph(i-3,k,j)+45.*(phb(i+1,k,j)-phb(i-1,k,j))-9.*(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,k,j)-phb(i-3,k,j))-0.016666667*0.5*g_u(i,&
3332 &k-1,j)*rdx*muu(i,j)*cfn*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)-ph(i-2,k,j))+ph(i+3,k,j)-ph(i-3,k,j)+45.*(phb(i+1,k,&
3333 &j)-phb(i-1,k,j))-9.*(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,k,j)-phb(i-3,k,j))
3334 ph_tend(i,k,j) = ph_tend(i,k,j)-0.5*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-&
3335 &2,j)))*(1./60.)*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)-ph(i-2,k,j))+ph(i+3,k,j)-ph(i-3,k,j)+45.*(phb(i+1,k,j)-phb(i-&
3336 &1,k,j))-9.*(phb(i+2,k,j)-phb(i-2,k,j))+phb(i+3,k,j)-phb(i-3,k,j))
3337 end do
3338 end do
3339 if (config_flags%open_xs .and. its .le. ids+1) then
3340 i = ids+1
3341 do j = j_start, jtf
3342 do k = 2, kte-1
3343 g_ph_tend(i,k,j) = (-(0.083333333*0.25*g_muu(i+1,j)*rdx*(u(i+1,k,j)+u(i+1,k-1,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,&
3344 &j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))))-0.083333333*0.25*g_muu(i,j)*rdx*(u(i,k,j)+&
3345 &u(i,k-1,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,&
3346 &k,j)))-0.083333333*0.25*g_ph(i-2,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-(-&
3347 &0.66666667)*0.25*g_ph(i-1,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-(-0.083333333)*&
3348 &0.25*g_ph(i+2,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-0.66666667*0.25*g_ph(i+1,k,j)&
3349 &*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))+g_ph_tend(i,k,j)-0.083333333*0.25*g_u(i+1,k-1,&
3350 &j)*rdx*muu(i+1,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-&
3351 &phb(i-2,k,j)))-0.083333333*0.25*g_u(i,k-1,j)*rdx*muu(i,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*&
3352 &(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))-0.083333333*0.25*g_u(i+1,k,j)*rdx*muu(i+1,j)*(8.*(ph(i+1,k,j)-&
3353 &ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))-0.083333333*0.25*g_u(i,&
3354 &k,j)*rdx*muu(i,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-&
3355 &phb(i-2,k,j)))
3356 ph_tend(i,k,j) = ph_tend(i,k,j)-0.25*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))*(1./12.)*&
3357 &(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
3358 end do
3359 k = kte
3360 g_ph_tend(i,k,j) = (-(0.083333333*0.5*g_muu(i+1,j)*rdx*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-&
3361 &(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))))-0.083333333*0.5*g_muu(i,j)*rdx*(cfn*&
3362 &u(i,k-1,j)+cfn1*u(i,k-2,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,&
3363 &k,j)-phb(i-2,k,j)))-0.083333333*0.5*g_ph(i-2,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*u(i,k-&
3364 &1,j)+cfn1*u(i,k-2,j)))-(-0.66666667)*0.5*g_ph(i-1,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*&
3365 &u(i,k-1,j)+cfn1*u(i,k-2,j)))-(-0.083333333)*0.5*g_ph(i+2,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*&
3366 &(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))-0.66666667*0.5*g_ph(i+1,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)&
3367 &*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))+g_ph_tend(i,k,j)-0.083333333*0.5*g_u(i+1,k-2,j)*rdx*muu(i+1,j)*cfn1*(8.*(ph(i+1,k,j)-&
3368 &ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))-0.083333333*0.5*g_u(i,k-&
3369 &2,j)*rdx*muu(i,j)*cfn1*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-&
3370 &phb(i-2,k,j)))-0.083333333*0.5*g_u(i+1,k-1,j)*rdx*muu(i+1,j)*cfn*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*&
3371 &(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))-0.083333333*0.5*g_u(i,k-1,j)*rdx*muu(i,j)*cfn*(8.*(ph(i+1,k,j)-&
3372 &ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
3373 ph_tend(i,k,j) = ph_tend(i,k,j)-0.5*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-&
3374 &2,j)))*(1./12.)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
3375 end do
3376 endif
3377 if (config_flags%open_xe .and. ite .ge. ide-2) then
3378 i = ide-2
3379 do j = j_start, jtf
3380 do k = 2, kte-1
3381 g_ph_tend(i,k,j) = (-(0.083333333*0.25*g_muu(i+1,j)*rdx*(u(i+1,k,j)+u(i+1,k-1,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,&
3382 &j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))))-0.083333333*0.25*g_muu(i,j)*rdx*(u(i,k,j)+&
3383 &u(i,k-1,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,&
3384 &k,j)))-0.083333333*0.25*g_ph(i-2,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-(-&
3385 &0.66666667)*0.25*g_ph(i-1,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-(-0.083333333)*&
3386 &0.25*g_ph(i+2,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))-0.66666667*0.25*g_ph(i+1,k,j)&
3387 &*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))+g_ph_tend(i,k,j)-0.083333333*0.25*g_u(i+1,k-1,&
3388 &j)*rdx*muu(i+1,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-&
3389 &phb(i-2,k,j)))-0.083333333*0.25*g_u(i,k-1,j)*rdx*muu(i,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*&
3390 &(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))-0.083333333*0.25*g_u(i+1,k,j)*rdx*muu(i+1,j)*(8.*(ph(i+1,k,j)-&
3391 &ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))-0.083333333*0.25*g_u(i,&
3392 &k,j)*rdx*muu(i,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-&
3393 &phb(i-2,k,j)))
3394 ph_tend(i,k,j) = ph_tend(i,k,j)-0.25*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,j)+u(i,k-1,j)))*(1./12.)*&
3395 &(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
3396 end do
3397 k = kte
3398 g_ph_tend(i,k,j) = (-(0.083333333*0.5*g_muu(i+1,j)*rdx*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-&
3399 &(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))))-0.083333333*0.5*g_muu(i,j)*rdx*(cfn*&
3400 &u(i,k-1,j)+cfn1*u(i,k-2,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,&
3401 &k,j)-phb(i-2,k,j)))-0.083333333*0.5*g_ph(i-2,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*u(i,k-&
3402 &1,j)+cfn1*u(i,k-2,j)))-(-0.66666667)*0.5*g_ph(i-1,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*&
3403 &u(i,k-1,j)+cfn1*u(i,k-2,j)))-(-0.083333333)*0.5*g_ph(i+2,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*&
3404 &(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))-0.66666667*0.5*g_ph(i+1,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)&
3405 &*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))+g_ph_tend(i,k,j)-0.083333333*0.5*g_u(i+1,k-2,j)*rdx*muu(i+1,j)*cfn1*(8.*(ph(i+1,k,j)-&
3406 &ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))-0.083333333*0.5*g_u(i,k-&
3407 &2,j)*rdx*muu(i,j)*cfn1*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-&
3408 &phb(i-2,k,j)))-0.083333333*0.5*g_u(i+1,k-1,j)*rdx*muu(i+1,j)*cfn*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*&
3409 &(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))-0.083333333*0.5*g_u(i,k-1,j)*rdx*muu(i,j)*cfn*(8.*(ph(i+1,k,j)-&
3410 &ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
3411 ph_tend(i,k,j) = ph_tend(i,k,j)-0.5*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-&
3412 &2,j)))*(1./12.)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
3413 end do
3414 endif
3415 endif
3416 itf = min(ite,ide-1)
3417 if (config_flags%open_ys .and. jts .eq. jds) then
3418 j = jts
3419 do k = 2, kde
3420 kz = min(k,kde-1)
3421 do i = its, itf
3422 g_vb = 0.5*g_v(i,kz-1,j+1)*fnp(kz)+0.5*g_v(i,kz-1,j)*fnp(kz)+0.5*g_v(i,kz,j+1)*fnm(kz)+0.5*g_v(i,kz,j)*fnm(kz)
3423 vb = 0.5*(fnm(kz)*(v(i,kz,j+1)+v(i,kz,j))+fnp(kz)*(v(i,kz-1,j+1)+v(i,kz-1,j)))
3424 g_vl = g_vb*(0.5+sign(0.5,0.-vb))
3425 vl = amin1(vb,0.)
3426 g_ph_tend(i,k,j) = (-(g_mut(i,j)*rdy*vl*(ph_old(i,k,j+1)-ph_old(i,k,j))))-g_ph_old(i,k,j+1)*rdy*mut(i,j)*vl+g_ph_old(i,k,j)*&
3427 &rdy*mut(i,j)*vl+g_ph_tend(i,k,j)-g_vl*rdy*mut(i,j)*(ph_old(i,k,j+1)-ph_old(i,k,j))
3428 ph_tend(i,k,j) = ph_tend(i,k,j)-rdy*mut(i,j)*vl*(ph_old(i,k,j+1)-ph_old(i,k,j))
3429 end do
3430 end do
3431 endif
3432 if (config_flags%open_ye .and. jte .eq. jde) then
3433 j = jte-1
3434 do k = 2, kde
3435 kz = min(k,kde-1)
3436 do i = its, itf
3437 g_vb = 0.5*g_v(i,kz-1,j+1)*fnp(kz)+0.5*g_v(i,kz-1,j)*fnp(kz)+0.5*g_v(i,kz,j+1)*fnm(kz)+0.5*g_v(i,kz,j)*fnm(kz)
3438 vb = 0.5*(fnm(kz)*(v(i,kz,j+1)+v(i,kz,j))+fnp(kz)*(v(i,kz-1,j+1)+v(i,kz-1,j)))
3439 g_vr = g_vb*(0.5+sign(0.5,vb-0.))
3440 vr = amax1(vb,0.)
3441 g_ph_tend(i,k,j) = (-(g_mut(i,j)*rdy*vr*(ph_old(i,k,j)-ph_old(i,k,j-1))))+g_ph_old(i,k,j-1)*rdy*mut(i,j)*vr-g_ph_old(i,k,j)*&
3442 &rdy*mut(i,j)*vr+g_ph_tend(i,k,j)-g_vr*rdy*mut(i,j)*(ph_old(i,k,j)-ph_old(i,k,j-1))
3443 ph_tend(i,k,j) = ph_tend(i,k,j)-rdy*mut(i,j)*vr*(ph_old(i,k,j)-ph_old(i,k,j-1))
3444 end do
3445 end do
3446 endif
3447 jtf = min(jte,jde-1)
3448 if (config_flags%open_xs .and. its .eq. ids) then
3449 i = its
3450 do j = jts, jtf
3451 do k = 2, kde-1
3452 kz = k
3453 g_ub = 0.5*g_u(i+1,kz-1,j)*fnp(kz)+0.5*g_u(i,kz-1,j)*fnp(kz)+0.5*g_u(i+1,kz,j)*fnm(kz)+0.5*g_u(i,kz,j)*fnm(kz)
3454 ub = 0.5*(fnm(kz)*(u(i+1,kz,j)+u(i,kz,j))+fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)))
3455 g_ul = g_ub*(0.5+sign(0.5,0.-ub))
3456 ul = amin1(ub,0.)
3457 g_ph_tend(i,k,j) = (-(g_mut(i,j)*rdx*ul*(ph_old(i+1,k,j)-ph_old(i,k,j))))-g_ph_old(i+1,k,j)*rdx*mut(i,j)*ul+g_ph_old(i,k,j)*&
3458 &rdx*mut(i,j)*ul+g_ph_tend(i,k,j)-g_ul*rdx*mut(i,j)*(ph_old(i+1,k,j)-ph_old(i,k,j))
3459 ph_tend(i,k,j) = ph_tend(i,k,j)-rdx*mut(i,j)*ul*(ph_old(i+1,k,j)-ph_old(i,k,j))
3460 end do
3461 k = kde
3462 kz = k
3463 g_ub = 0.5*g_u(i+1,kz-1,j)*fnp(kz)+0.5*g_u(i,kz-1,j)*fnp(kz)+0.5*g_u(i+1,kz,j)*fnm(kz)+0.5*g_u(i,kz,j)*fnm(kz)
3464 ub = 0.5*(fnm(kz)*(u(i+1,kz,j)+u(i,kz,j))+fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)))
3465 g_ul = g_ub*(0.5+sign(0.5,0.-ub))
3466 ul = amin1(ub,0.)
3467 g_ph_tend(i,k,j) = (-(g_mut(i,j)*rdx*ul*(ph_old(i+1,k,j)-ph_old(i,k,j))))-g_ph_old(i+1,k,j)*rdx*mut(i,j)*ul+g_ph_old(i,k,j)*&
3468 &rdx*mut(i,j)*ul+g_ph_tend(i,k,j)-g_ul*rdx*mut(i,j)*(ph_old(i+1,k,j)-ph_old(i,k,j))
3469 ph_tend(i,k,j) = ph_tend(i,k,j)-rdx*mut(i,j)*ul*(ph_old(i+1,k,j)-ph_old(i,k,j))
3470 end do
3471 endif
3472 if (config_flags%open_xe .and. ite .eq. ide) then
3473 i = ite-1
3474 do j = jts, jtf
3475 do k = 2, kde-1
3476 kz = k
3477 g_ub = 0.5*g_u(i+1,kz-1,j)*fnp(kz)+0.5*g_u(i,kz-1,j)*fnp(kz)+0.5*g_u(i+1,kz,j)*fnm(kz)+0.5*g_u(i,kz,j)*fnm(kz)
3478 ub = 0.5*(fnm(kz)*(u(i+1,kz,j)+u(i,kz,j))+fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)))
3479 g_ur = g_ub*(0.5+sign(0.5,ub-0.))
3480 ur = amax1(ub,0.)
3481 g_ph_tend(i,k,j) = (-(g_mut(i,j)*rdx*ur*(ph_old(i,k,j)-ph_old(i-1,k,j))))+g_ph_old(i-1,k,j)*rdx*mut(i,j)*ur-g_ph_old(i,k,j)*&
3482 &rdx*mut(i,j)*ur+g_ph_tend(i,k,j)-g_ur*rdx*mut(i,j)*(ph_old(i,k,j)-ph_old(i-1,k,j))
3483 ph_tend(i,k,j) = ph_tend(i,k,j)-rdx*mut(i,j)*ur*(ph_old(i,k,j)-ph_old(i-1,k,j))
3484 end do
3485 k = kde
3486 kz = k-1
3487 g_ub = 0.5*g_u(i+1,kz-1,j)*fnp(kz)+0.5*g_u(i,kz-1,j)*fnp(kz)+0.5*g_u(i+1,kz,j)*fnm(kz)+0.5*g_u(i,kz,j)*fnm(kz)
3488 ub = 0.5*(fnm(kz)*(u(i+1,kz,j)+u(i,kz,j))+fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)))
3489 g_ur = g_ub*(0.5+sign(0.5,ub-0.))
3490 ur = amax1(ub,0.)
3491 g_ph_tend(i,k,j) = (-(g_mut(i,j)*rdx*ur*(ph_old(i,k,j)-ph_old(i-1,k,j))))+g_ph_old(i-1,k,j)*rdx*mut(i,j)*ur-g_ph_old(i,k,j)*&
3492 &rdx*mut(i,j)*ur+g_ph_tend(i,k,j)-g_ur*rdx*mut(i,j)*(ph_old(i,k,j)-ph_old(i-1,k,j))
3493 ph_tend(i,k,j) = ph_tend(i,k,j)-rdx*mut(i,j)*ur*(ph_old(i,k,j)-ph_old(i-1,k,j))
3494 end do
3495 endif
3496
3497 end subroutine g_rhs_ph
3498
3499
3500 subroutine g_vertical_diffusion( name, field, g_field, tendency, g_tendency, alt, g_alt, mut, g_mut, rdn, rdnw, kvdif, ide, jde, &
3501 &kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
3502 !******************************************************************
3503 !******************************************************************
3504 !** This routine was generated by Automatic differentiation. **
3505 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
3506 !******************************************************************
3507 !******************************************************************
3508 !==============================================
3509 ! all entries are defined explicitly
3510 !==============================================
3511 implicit none
3512
3513 !==============================================
3514 ! declare arguments
3515 !==============================================
3516 integer, intent(in) :: ime
3517 integer, intent(in) :: ims
3518 integer, intent(in) :: jme
3519 integer, intent(in) :: jms
3520 integer, intent(in) :: kme
3521 integer, intent(in) :: kms
3522 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
3523 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
3524 real, intent(in) :: g_alt(ims:ime,kms:kme,jms:jme)
3525 real, intent(in) :: g_field(ims:ime,kms:kme,jms:jme)
3526 real, intent(in) :: g_mut(ims:ime,jms:jme)
3527 real, intent(inout) :: g_tendency(ims:ime,kms:kme,jms:jme)
3528 integer, intent(in) :: ide
3529 integer, intent(in) :: ite
3530 integer, intent(in) :: its
3531 integer, intent(in) :: jde
3532 integer, intent(in) :: jte
3533 integer, intent(in) :: jts
3534 integer, intent(in) :: kde
3535 integer, intent(in) :: kte
3536 integer, intent(in) :: kts
3537 real, intent(in) :: kvdif
3538 real, intent(in) :: mut(ims:ime,jms:jme)
3539 character*(1), intent(in) :: name
3540 real, intent(in) :: rdn(kms:kme)
3541 real, intent(in) :: rdnw(kms:kme)
3542 real, intent(inout) :: tendency(ims:ime,kms:kme,jms:jme)
3543
3544 !==============================================
3545 ! declare local variables
3546 !==============================================
3547 real g_vflux(its:ite,0:kte+1)
3548 integer i
3549 integer i_end
3550 integer i_start
3551 integer j
3552 integer j_end
3553 integer j_start
3554 integer k
3555 integer ktf
3556 real vflux(its:ite,0:kte+1)
3557
3558 !----------------------------------------------
3559 ! TANGENT LINEAR AND FUNCTION STATEMENTS
3560 !----------------------------------------------
3561 ktf = min(kte,kde-1)
3562 if (name .eq. 'w') then
3563 i_start = its
3564 i_end = min(ite,ide-1)
3565 j_start = jts
3566 j_end = min(jte,jde-1)
3567 j_loop_w: do j = j_start, j_end
3568 do k = kts, ktf-1
3569 do i = i_start, i_end
3570 g_vflux(i,k) = (-(g_alt(i,k,j)*kvdif/(alt(i,k,j)*alt(i,k,j))*rdnw(k)*(field(i,k+1,j)-field(i,k,j))))+g_field(i,k+1,j)*&
3571 &kvdif/alt(i,k,j)*rdnw(k)-g_field(i,k,j)*kvdif/alt(i,k,j)*rdnw(k)
3572 vflux(i,k) = kvdif/alt(i,k,j)*rdnw(k)*(field(i,k+1,j)-field(i,k,j))
3573 end do
3574 end do
3575 do i = i_start, i_end
3576 g_vflux(i,ktf) = 0.
3577 vflux(i,ktf) = 0.
3578 end do
3579 do k = kts+1, ktf
3580 do i = i_start, i_end
3581 g_tendency(i,k,j) = (-(g_alt(i,k-1,j)*0.5*(rdn(k)*g*g/mut(i,j))/(0.5*0.5*(alt(i,k,j)+alt(i,k-1,j))*(alt(i,k,j)+alt(i,k-1,j)&
3582 &))*(vflux(i,k)-vflux(i,k-1))))-g_alt(i,k,j)*0.5*(rdn(k)*g*g/mut(i,j))/(0.5*0.5*(alt(i,k,j)+alt(i,k-1,j))*(alt(i,k,j)+&
3583 &alt(i,k-1,j)))*(vflux(i,k)-vflux(i,k-1))-g_mut(i,j)*rdn(k)*g*g/(mut(i,j)*mut(i,j))/(0.5*(alt(i,k,j)+alt(i,k-1,j)))*&
3584 &(vflux(i,k)-vflux(i,k-1))+g_tendency(i,k,j)-g_vflux(i,k-1)*(rdn(k)*g*g/mut(i,j)/(0.5*(alt(i,k,j)+alt(i,k-1,j))))+&
3585 &g_vflux(i,k)*(rdn(k)*g*g/mut(i,j)/(0.5*(alt(i,k,j)+alt(i,k-1,j))))
3586 tendency(i,k,j) = tendency(i,k,j)+rdn(k)*g*g/mut(i,j)/(0.5*(alt(i,k,j)+alt(i,k-1,j)))*(vflux(i,k)-vflux(i,k-1))
3587 end do
3588 end do
3589 end do j_loop_w
3590 else if (name .eq. 'm') then
3591 i_start = its
3592 i_end = min(ite,ide-1)
3593 j_start = jts
3594 j_end = min(jte,jde-1)
3595 j_loop_s: do j = j_start, j_end
3596 do k = kts, ktf-1
3597 do i = i_start, i_end
3598 g_vflux(i,k) = (-(g_alt(i,k+1,j)*0.5*kvdif*rdn(k+1)/(0.5*0.5*(alt(i,k,j)+alt(i,k+1,j))*(alt(i,k,j)+alt(i,k+1,j)))*(field(i,&
3599 &k+1,j)-field(i,k,j))))-g_alt(i,k,j)*0.5*kvdif*rdn(k+1)/(0.5*0.5*(alt(i,k,j)+alt(i,k+1,j))*(alt(i,k,j)+alt(i,k+1,j)))*&
3600 &(field(i,k+1,j)-field(i,k,j))+g_field(i,k+1,j)*(kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))))-g_field(i,k,j)*(kvdif*&
3601 &rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))))
3602 vflux(i,k) = kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j)))*(field(i,k+1,j)-field(i,k,j))
3603 end do
3604 end do
3605 do i = i_start, i_end
3606 g_vflux(i,0) = g_vflux(i,1)
3607 vflux(i,0) = vflux(i,1)
3608 end do
3609 do i = i_start, i_end
3610 g_vflux(i,ktf) = 0.
3611 vflux(i,ktf) = 0.
3612 end do
3613 do k = kts, ktf
3614 do i = i_start, i_end
3615 g_tendency(i,k,j) = (-(g_alt(i,k,j)*g*g/mut(i,j)/(alt(i,k,j)*alt(i,k,j))*rdnw(k)*(vflux(i,k)-vflux(i,k-1))))-g_mut(i,j)*g*&
3616 &g/(mut(i,j)*mut(i,j))/alt(i,k,j)*rdnw(k)*(vflux(i,k)-vflux(i,k-1))+g_tendency(i,k,j)-g_vflux(i,k-1)*g*g/mut(i,j)/alt(i,k,&
3617 &j)*rdnw(k)+g_vflux(i,k)*g*g/mut(i,j)/alt(i,k,j)*rdnw(k)
3618 tendency(i,k,j) = tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j)*rdnw(k)*(vflux(i,k)-vflux(i,k-1))
3619 end do
3620 end do
3621 end do j_loop_s
3622 endif
3623
3624 end subroutine g_vertical_diffusion
3625
3626
3627 subroutine g_vertical_diffusion_3dmp( field, g_field, tendency, g_tendency, base_3d, alt, g_alt, mut, g_mut, rdn, rdnw, kvdif, ide,&
3628 & jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
3629 !******************************************************************
3630 !******************************************************************
3631 !** This routine was generated by Automatic differentiation. **
3632 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
3633 !******************************************************************
3634 !******************************************************************
3635 !==============================================
3636 ! all entries are defined explicitly
3637 !==============================================
3638 implicit none
3639
3640 !==============================================
3641 ! declare arguments
3642 !==============================================
3643 integer, intent(in) :: ime
3644 integer, intent(in) :: ims
3645 integer, intent(in) :: jme
3646 integer, intent(in) :: jms
3647 integer, intent(in) :: kme
3648 integer, intent(in) :: kms
3649 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
3650 real, intent(in) :: base_3d(ims:ime,kms:kme,jms:jme)
3651 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
3652 real, intent(in) :: g_alt(ims:ime,kms:kme,jms:jme)
3653 real, intent(in) :: g_field(ims:ime,kms:kme,jms:jme)
3654 real, intent(in) :: g_mut(ims:ime,jms:jme)
3655 real, intent(inout) :: g_tendency(ims:ime,kms:kme,jms:jme)
3656 integer, intent(in) :: ide
3657 integer, intent(in) :: ite
3658 integer, intent(in) :: its
3659 integer, intent(in) :: jde
3660 integer, intent(in) :: jte
3661 integer, intent(in) :: jts
3662 integer, intent(in) :: kde
3663 integer, intent(in) :: kte
3664 integer, intent(in) :: kts
3665 real, intent(in) :: kvdif
3666 real, intent(in) :: mut(ims:ime,jms:jme)
3667 real, intent(in) :: rdn(kms:kme)
3668 real, intent(in) :: rdnw(kms:kme)
3669 real, intent(inout) :: tendency(ims:ime,kms:kme,jms:jme)
3670
3671 !==============================================
3672 ! declare local variables
3673 !==============================================
3674 real g_vflux(its:ite,0:kte+1)
3675 integer i
3676 integer i_end
3677 integer i_start
3678 integer j
3679 integer j_end
3680 integer j_start
3681 integer k
3682 integer ktf
3683 real vflux(its:ite,0:kte+1)
3684
3685 !----------------------------------------------
3686 ! TANGENT LINEAR AND FUNCTION STATEMENTS
3687 !----------------------------------------------
3688 ktf = min(kte,kde-1)
3689 i_start = its
3690 i_end = min(ite,ide-1)
3691 j_start = jts
3692 j_end = min(jte,jde-1)
3693 j_loop_s: do j = j_start, j_end
3694 do k = kts, ktf-1
3695 do i = i_start, i_end
3696 g_vflux(i,k) = (-(g_alt(i,k+1,j)*0.5*kvdif*rdn(k+1)/(0.5*0.5*(alt(i,k,j)+alt(i,k+1,j))*(alt(i,k,j)+alt(i,k+1,j)))*(field(i,k+&
3697 &1,j)-field(i,k,j)-base_3d(i,k+1,j)+base_3d(i,k,j))))-g_alt(i,k,j)*0.5*kvdif*rdn(k+1)/(0.5*0.5*(alt(i,k,j)+alt(i,k+1,j))*&
3698 &(alt(i,k,j)+alt(i,k+1,j)))*(field(i,k+1,j)-field(i,k,j)-base_3d(i,k+1,j)+base_3d(i,k,j))+g_field(i,k+1,j)*(kvdif*rdn(k+1)/&
3699 &(0.5*(alt(i,k,j)+alt(i,k+1,j))))-g_field(i,k,j)*(kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))))
3700 vflux(i,k) = kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j)))*(field(i,k+1,j)-field(i,k,j)-base_3d(i,k+1,j)+base_3d(i,k,j))
3701 end do
3702 end do
3703 do i = i_start, i_end
3704 g_vflux(i,0) = g_vflux(i,1)
3705 vflux(i,0) = vflux(i,1)
3706 end do
3707 do i = i_start, i_end
3708 g_vflux(i,ktf) = 0.
3709 vflux(i,ktf) = 0.
3710 end do
3711 do k = kts, ktf
3712 do i = i_start, i_end
3713 g_tendency(i,k,j) = (-(g_alt(i,k,j)*g*g/mut(i,j)/(alt(i,k,j)*alt(i,k,j))*rdnw(k)*(vflux(i,k)-vflux(i,k-1))))-g_mut(i,j)*g*g/&
3714 &(mut(i,j)*mut(i,j))/alt(i,k,j)*rdnw(k)*(vflux(i,k)-vflux(i,k-1))+g_tendency(i,k,j)-g_vflux(i,k-1)*g*g/mut(i,j)/alt(i,k,j)*&
3715 &rdnw(k)+g_vflux(i,k)*g*g/mut(i,j)/alt(i,k,j)*rdnw(k)
3716 tendency(i,k,j) = tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j)*rdnw(k)*(vflux(i,k)-vflux(i,k-1))
3717 end do
3718 end do
3719 end do j_loop_s
3720
3721 end subroutine g_vertical_diffusion_3dmp
3722
3723
3724 subroutine g_vertical_diffusion_mp( field, g_field, tendency, g_tendency, base, alt, g_alt, mut, g_mut, rdn, rdnw, kvdif, ide, jde,&
3725 & kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
3726 !******************************************************************
3727 !******************************************************************
3728 !** This routine was generated by Automatic differentiation. **
3729 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
3730 !******************************************************************
3731 !******************************************************************
3732 !==============================================
3733 ! all entries are defined explicitly
3734 !==============================================
3735 implicit none
3736
3737 !==============================================
3738 ! declare arguments
3739 !==============================================
3740 integer, intent(in) :: ime
3741 integer, intent(in) :: ims
3742 integer, intent(in) :: jme
3743 integer, intent(in) :: jms
3744 integer, intent(in) :: kme
3745 integer, intent(in) :: kms
3746 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
3747 real, intent(in) :: base(kms:kme)
3748 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
3749 real, intent(in) :: g_alt(ims:ime,kms:kme,jms:jme)
3750 real, intent(in) :: g_field(ims:ime,kms:kme,jms:jme)
3751 real, intent(in) :: g_mut(ims:ime,jms:jme)
3752 real, intent(inout) :: g_tendency(ims:ime,kms:kme,jms:jme)
3753 integer, intent(in) :: ide
3754 integer, intent(in) :: ite
3755 integer, intent(in) :: its
3756 integer, intent(in) :: jde
3757 integer, intent(in) :: jte
3758 integer, intent(in) :: jts
3759 integer, intent(in) :: kde
3760 integer, intent(in) :: kte
3761 integer, intent(in) :: kts
3762 real, intent(in) :: kvdif
3763 real, intent(in) :: mut(ims:ime,jms:jme)
3764 real, intent(in) :: rdn(kms:kme)
3765 real, intent(in) :: rdnw(kms:kme)
3766 real, intent(inout) :: tendency(ims:ime,kms:kme,jms:jme)
3767
3768 !==============================================
3769 ! declare local variables
3770 !==============================================
3771 real g_vflux(its:ite,0:kte+1)
3772 integer i
3773 integer i_end
3774 integer i_start
3775 integer j
3776 integer j_end
3777 integer j_start
3778 integer k
3779 integer ktf
3780 real vflux(its:ite,0:kte+1)
3781
3782 !----------------------------------------------
3783 ! TANGENT LINEAR AND FUNCTION STATEMENTS
3784 !----------------------------------------------
3785 ktf = min(kte,kde-1)
3786 i_start = its
3787 i_end = min(ite,ide-1)
3788 j_start = jts
3789 j_end = min(jte,jde-1)
3790 j_loop_s: do j = j_start, j_end
3791 do k = kts, ktf-1
3792 do i = i_start, i_end
3793 g_vflux(i,k) = (-(g_alt(i,k+1,j)*0.5*kvdif*rdn(k+1)/(0.5*0.5*(alt(i,k,j)+alt(i,k+1,j))*(alt(i,k,j)+alt(i,k+1,j)))*(field(i,k+&
3794 &1,j)-field(i,k,j)-base(k+1)+base(k))))-g_alt(i,k,j)*0.5*kvdif*rdn(k+1)/(0.5*0.5*(alt(i,k,j)+alt(i,k+1,j))*(alt(i,k,j)+alt(i,&
3795 &k+1,j)))*(field(i,k+1,j)-field(i,k,j)-base(k+1)+base(k))+g_field(i,k+1,j)*(kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))))-&
3796 &g_field(i,k,j)*(kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))))
3797 vflux(i,k) = kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j)))*(field(i,k+1,j)-field(i,k,j)-base(k+1)+base(k))
3798 end do
3799 end do
3800 do i = i_start, i_end
3801 g_vflux(i,0) = g_vflux(i,1)
3802 vflux(i,0) = vflux(i,1)
3803 end do
3804 do i = i_start, i_end
3805 g_vflux(i,ktf) = 0.
3806 vflux(i,ktf) = 0.
3807 end do
3808 do k = kts, ktf
3809 do i = i_start, i_end
3810 g_tendency(i,k,j) = (-(g_alt(i,k,j)*g*g/mut(i,j)/(alt(i,k,j)*alt(i,k,j))*rdnw(k)*(vflux(i,k)-vflux(i,k-1))))-g_mut(i,j)*g*g/&
3811 &(mut(i,j)*mut(i,j))/alt(i,k,j)*rdnw(k)*(vflux(i,k)-vflux(i,k-1))+g_tendency(i,k,j)-g_vflux(i,k-1)*g*g/mut(i,j)/alt(i,k,j)*&
3812 &rdnw(k)+g_vflux(i,k)*g*g/mut(i,j)/alt(i,k,j)*rdnw(k)
3813 tendency(i,k,j) = tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j)*rdnw(k)*(vflux(i,k)-vflux(i,k-1))
3814 end do
3815 end do
3816 end do j_loop_s
3817
3818 end subroutine g_vertical_diffusion_mp
3819
3820
3821 subroutine g_vertical_diffusion_u( field, g_field, tendency, g_tendency, config_flags, u_base, alt, g_alt, muu, g_muu, rdn, rdnw, &
3822 &kvdif, ids, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
3823 !******************************************************************
3824 !******************************************************************
3825 !** This routine was generated by Automatic differentiation. **
3826 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
3827 !******************************************************************
3828 !******************************************************************
3829 !==============================================
3830 ! all entries are defined explicitly
3831 !==============================================
3832 implicit none
3833
3834 !==============================================
3835 ! declare arguments
3836 !==============================================
3837 integer, intent(in) :: ime
3838 integer, intent(in) :: ims
3839 integer, intent(in) :: jme
3840 integer, intent(in) :: jms
3841 integer, intent(in) :: kme
3842 integer, intent(in) :: kms
3843 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
3844 type (grid_config_rec_type), intent(in) :: config_flags
3845 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
3846 real, intent(in) :: g_alt(ims:ime,kms:kme,jms:jme)
3847 real, intent(in) :: g_field(ims:ime,kms:kme,jms:jme)
3848 real, intent(in) :: g_muu(ims:ime,jms:jme)
3849 real, intent(inout) :: g_tendency(ims:ime,kms:kme,jms:jme)
3850 integer, intent(in) :: ide
3851 integer, intent(in) :: ids
3852 integer, intent(in) :: ite
3853 integer, intent(in) :: its
3854 integer, intent(in) :: jde
3855 integer, intent(in) :: jte
3856 integer, intent(in) :: jts
3857 integer, intent(in) :: kde
3858 integer, intent(in) :: kte
3859 integer, intent(in) :: kts
3860 real, intent(in) :: kvdif
3861 real, intent(in) :: muu(ims:ime,jms:jme)
3862 real, intent(in) :: rdn(kms:kme)
3863 real, intent(in) :: rdnw(kms:kme)
3864 real, intent(inout) :: tendency(ims:ime,kms:kme,jms:jme)
3865 real, intent(in) :: u_base(kms:kme)
3866
3867 !==============================================
3868 ! declare local variables
3869 !==============================================
3870 real g_vflux(its:ite,0:kte+1)
3871 integer i
3872 integer i_end
3873 integer i_start
3874 integer j
3875 integer j_end
3876 integer j_start
3877 integer k
3878 integer ktf
3879 logical specified
3880 real vflux(its:ite,0:kte+1)
3881
3882 !----------------------------------------------
3883 ! TANGENT LINEAR AND FUNCTION STATEMENTS
3884 !----------------------------------------------
3885 specified = .false.
3886 if (config_flags%specified .or. config_flags%nested) then
3887 specified = .true.
3888 endif
3889 ktf = min(kte,kde-1)
3890 i_start = its
3891 i_end = ite
3892 j_start = jts
3893 j_end = min(jte,jde-1)
3894 if (config_flags%open_xs .or. specified) then
3895 i_start = max(ids+1,its)
3896 endif
3897 if (config_flags%open_xe .or. specified) then
3898 i_end = min(ide-1,ite)
3899 endif
3900 j_loop_u: do j = j_start, j_end
3901 do k = kts, ktf-1
3902 do i = i_start, i_end
3903 g_vflux(i,k) = (-(g_alt(i-1,k+1,j)*0.25*kvdif*rdn(k+1)/(0.25*0.25*(alt(i,k,j)+alt(i-1,k,j)+alt(i,k+1,j)+alt(i-1,k+1,j))*&
3904 &(alt(i,k,j)+alt(i-1,k,j)+alt(i,k+1,j)+alt(i-1,k+1,j)))*(field(i,k+1,j)-field(i,k,j)-u_base(k+1)+u_base(k))))-g_alt(i,k+1,j)*&
3905 &0.25*kvdif*rdn(k+1)/(0.25*0.25*(alt(i,k,j)+alt(i-1,k,j)+alt(i,k+1,j)+alt(i-1,k+1,j))*(alt(i,k,j)+alt(i-1,k,j)+alt(i,k+1,j)+&
3906 &alt(i-1,k+1,j)))*(field(i,k+1,j)-field(i,k,j)-u_base(k+1)+u_base(k))-g_alt(i-1,k,j)*0.25*kvdif*rdn(k+1)/(0.25*0.25*(alt(i,k,&
3907 &j)+alt(i-1,k,j)+alt(i,k+1,j)+alt(i-1,k+1,j))*(alt(i,k,j)+alt(i-1,k,j)+alt(i,k+1,j)+alt(i-1,k+1,j)))*(field(i,k+1,j)-field(i,&
3908 &k,j)-u_base(k+1)+u_base(k))-g_alt(i,k,j)*0.25*kvdif*rdn(k+1)/(0.25*0.25*(alt(i,k,j)+alt(i-1,k,j)+alt(i,k+1,j)+alt(i-1,k+1,j)&
3909 &)*(alt(i,k,j)+alt(i-1,k,j)+alt(i,k+1,j)+alt(i-1,k+1,j)))*(field(i,k+1,j)-field(i,k,j)-u_base(k+1)+u_base(k))+g_field(i,k+1,&
3910 &j)*(kvdif*rdn(k+1)/(0.25*(alt(i,k,j)+alt(i-1,k,j)+alt(i,k+1,j)+alt(i-1,k+1,j))))-g_field(i,k,j)*(kvdif*rdn(k+1)/(0.25*&
3911 &(alt(i,k,j)+alt(i-1,k,j)+alt(i,k+1,j)+alt(i-1,k+1,j))))
3912 vflux(i,k) = kvdif*rdn(k+1)/(0.25*(alt(i,k,j)+alt(i-1,k,j)+alt(i,k+1,j)+alt(i-1,k+1,j)))*(field(i,k+1,j)-field(i,k,j)-&
3913 &u_base(k+1)+u_base(k))
3914 end do
3915 end do
3916 do i = i_start, i_end
3917 g_vflux(i,0) = g_vflux(i,1)
3918 vflux(i,0) = vflux(i,1)
3919 end do
3920 do i = i_start, i_end
3921 g_vflux(i,ktf) = 0.
3922 vflux(i,ktf) = 0.
3923 end do
3924 do k = kts, ktf-1
3925 do i = i_start, i_end
3926 g_tendency(i,k,j) = (-(g_alt(i-1,k,j)*0.5*(g*g*rdnw(k)/muu(i,j))/(0.5*0.5*(alt(i-1,k,j)+alt(i,k,j))*(alt(i-1,k,j)+alt(i,k,j))&
3927 &)*(vflux(i,k)-vflux(i,k-1))))-g_alt(i,k,j)*0.5*(g*g*rdnw(k)/muu(i,j))/(0.5*0.5*(alt(i-1,k,j)+alt(i,k,j))*(alt(i-1,k,j)+&
3928 &alt(i,k,j)))*(vflux(i,k)-vflux(i,k-1))-g_muu(i,j)*g*g*rdnw(k)/(muu(i,j)*muu(i,j))/(0.5*(alt(i-1,k,j)+alt(i,k,j)))*(vflux(i,&
3929 &k)-vflux(i,k-1))+g_tendency(i,k,j)-g_vflux(i,k-1)*(g*g*rdnw(k)/muu(i,j)/(0.5*(alt(i-1,k,j)+alt(i,k,j))))+g_vflux(i,k)*(g*g*&
3930 &rdnw(k)/muu(i,j)/(0.5*(alt(i-1,k,j)+alt(i,k,j))))
3931 tendency(i,k,j) = tendency(i,k,j)+g*g*rdnw(k)/muu(i,j)/(0.5*(alt(i-1,k,j)+alt(i,k,j)))*(vflux(i,k)-vflux(i,k-1))
3932 end do
3933 end do
3934 end do j_loop_u
3935
3936 end subroutine g_vertical_diffusion_u
3937
3938
3939 subroutine g_vertical_diffusion_v( field, g_field, tendency, g_tendency, config_flags, v_base, alt, g_alt, muv, g_muv, rdn, rdnw, &
3940 &kvdif, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
3941 !******************************************************************
3942 !******************************************************************
3943 !** This routine was generated by Automatic differentiation. **
3944 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
3945 !******************************************************************
3946 !******************************************************************
3947 !==============================================
3948 ! all entries are defined explicitly
3949 !==============================================
3950 implicit none
3951
3952 !==============================================
3953 ! declare arguments
3954 !==============================================
3955 integer, intent(in) :: ime
3956 integer, intent(in) :: ims
3957 integer, intent(in) :: jme
3958 integer, intent(in) :: jms
3959 integer, intent(in) :: kme
3960 integer, intent(in) :: kms
3961 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
3962 type (grid_config_rec_type), intent(in) :: config_flags
3963 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
3964 real, intent(in) :: g_alt(ims:ime,kms:kme,jms:jme)
3965 real, intent(in) :: g_field(ims:ime,kms:kme,jms:jme)
3966 real, intent(in) :: g_muv(ims:ime,jms:jme)
3967 real, intent(inout) :: g_tendency(ims:ime,kms:kme,jms:jme)
3968 integer, intent(in) :: ide
3969 integer, intent(in) :: ite
3970 integer, intent(in) :: its
3971 integer, intent(in) :: jde
3972 integer, intent(in) :: jds
3973 integer, intent(in) :: jte
3974 integer, intent(in) :: jts
3975 integer, intent(in) :: kde
3976 integer, intent(in) :: kte
3977 integer, intent(in) :: kts
3978 real, intent(in) :: kvdif
3979 real, intent(in) :: muv(ims:ime,jms:jme)
3980 real, intent(in) :: rdn(kms:kme)
3981 real, intent(in) :: rdnw(kms:kme)
3982 real, intent(inout) :: tendency(ims:ime,kms:kme,jms:jme)
3983 real, intent(in) :: v_base(kms:kme)
3984
3985 !==============================================
3986 ! declare local variables
3987 !==============================================
3988 real g_vflux(its:ite,0:kte+1)
3989 integer i
3990 integer i_end
3991 integer i_start
3992 integer j
3993 integer j_end
3994 integer j_start
3995 integer jm1
3996 integer k
3997 integer ktf
3998 logical specified
3999 real vflux(its:ite,0:kte+1)
4000
4001 !----------------------------------------------
4002 ! TANGENT LINEAR AND FUNCTION STATEMENTS
4003 !----------------------------------------------
4004 specified = .false.
4005 if (config_flags%specified .or. config_flags%nested) then
4006 specified = .true.
4007 endif
4008 ktf = min(kte,kde-1)
4009 i_start = its
4010 i_end = min(ite,ide-1)
4011 j_start = jts
4012 j_end = min(jte,jde-1)
4013 if (config_flags%open_ys .or. specified) then
4014 j_start = max(jds+1,jts)
4015 endif
4016 if (config_flags%open_ye .or. specified) then
4017 j_end = min(jde-1,jte)
4018 endif
4019 j_loop_v: do j = j_start, j_end
4020 jm1 = j-1
4021 do k = kts, ktf-1
4022 do i = i_start, i_end
4023 g_vflux(i,k) = (-(g_alt(i,k+1,j)*0.25*kvdif*rdn(k+1)/(0.25*0.25*(alt(i,k,j)+alt(i,k,jm1)+alt(i,k+1,j)+alt(i,k+1,jm1))*(alt(i,&
4024 &k,j)+alt(i,k,jm1)+alt(i,k+1,j)+alt(i,k+1,jm1)))*(field(i,k+1,j)-field(i,k,j)-v_base(k+1)+v_base(k))))-g_alt(i,k+1,jm1)*0.25*&
4025 &kvdif*rdn(k+1)/(0.25*0.25*(alt(i,k,j)+alt(i,k,jm1)+alt(i,k+1,j)+alt(i,k+1,jm1))*(alt(i,k,j)+alt(i,k,jm1)+alt(i,k+1,j)+alt(i,&
4026 &k+1,jm1)))*(field(i,k+1,j)-field(i,k,j)-v_base(k+1)+v_base(k))-g_alt(i,k,j)*0.25*kvdif*rdn(k+1)/(0.25*0.25*(alt(i,k,j)+&
4027 &alt(i,k,jm1)+alt(i,k+1,j)+alt(i,k+1,jm1))*(alt(i,k,j)+alt(i,k,jm1)+alt(i,k+1,j)+alt(i,k+1,jm1)))*(field(i,k+1,j)-field(i,k,&
4028 &j)-v_base(k+1)+v_base(k))-g_alt(i,k,jm1)*0.25*kvdif*rdn(k+1)/(0.25*0.25*(alt(i,k,j)+alt(i,k,jm1)+alt(i,k+1,j)+alt(i,k+1,jm1)&
4029 &)*(alt(i,k,j)+alt(i,k,jm1)+alt(i,k+1,j)+alt(i,k+1,jm1)))*(field(i,k+1,j)-field(i,k,j)-v_base(k+1)+v_base(k))+g_field(i,k+1,&
4030 &j)*(kvdif*rdn(k+1)/(0.25*(alt(i,k,j)+alt(i,k,jm1)+alt(i,k+1,j)+alt(i,k+1,jm1))))-g_field(i,k,j)*(kvdif*rdn(k+1)/(0.25*&
4031 &(alt(i,k,j)+alt(i,k,jm1)+alt(i,k+1,j)+alt(i,k+1,jm1))))
4032 vflux(i,k) = kvdif*rdn(k+1)/(0.25*(alt(i,k,j)+alt(i,k,jm1)+alt(i,k+1,j)+alt(i,k+1,jm1)))*(field(i,k+1,j)-field(i,k,j)-&
4033 &v_base(k+1)+v_base(k))
4034 end do
4035 end do
4036 do i = i_start, i_end
4037 g_vflux(i,0) = g_vflux(i,1)
4038 vflux(i,0) = vflux(i,1)
4039 end do
4040 do i = i_start, i_end
4041 g_vflux(i,ktf) = 0.
4042 vflux(i,ktf) = 0.
4043 end do
4044 do k = kts, ktf-1
4045 do i = i_start, i_end
4046 g_tendency(i,k,j) = (-(g_alt(i,k,j)*0.5*(g*g*rdnw(k)/muv(i,j))/(0.5*0.5*(alt(i,k,jm1)+alt(i,k,j))*(alt(i,k,jm1)+alt(i,k,j)))*&
4047 &(vflux(i,k)-vflux(i,k-1))))-g_alt(i,k,jm1)*0.5*(g*g*rdnw(k)/muv(i,j))/(0.5*0.5*(alt(i,k,jm1)+alt(i,k,j))*(alt(i,k,jm1)+&
4048 &alt(i,k,j)))*(vflux(i,k)-vflux(i,k-1))-g_muv(i,j)*g*g*rdnw(k)/(muv(i,j)*muv(i,j))/(0.5*(alt(i,k,jm1)+alt(i,k,j)))*(vflux(i,&
4049 &k)-vflux(i,k-1))+g_tendency(i,k,j)-g_vflux(i,k-1)*(g*g*rdnw(k)/muv(i,j)/(0.5*(alt(i,k,jm1)+alt(i,k,j))))+g_vflux(i,k)*(g*g*&
4050 &rdnw(k)/muv(i,j)/(0.5*(alt(i,k,jm1)+alt(i,k,j))))
4051 tendency(i,k,j) = tendency(i,k,j)+g*g*rdnw(k)/muv(i,j)/(0.5*(alt(i,k,jm1)+alt(i,k,j)))*(vflux(i,k)-vflux(i,k-1))
4052 end do
4053 end do
4054 end do j_loop_v
4055
4056 end subroutine g_vertical_diffusion_v
4057
4058
4059 subroutine g_w_damp( rw_tend, g_rw_tend, ww, g_ww, w, g_w, mut, g_mut, rdnw, dt, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, &
4060 &ite, jts, jte )
4061 !******************************************************************
4062 !******************************************************************
4063 !** This routine was generated by Automatic differentiation. **
4064 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
4065 !******************************************************************
4066 !******************************************************************
4067 !==============================================
4068 ! all entries are defined explicitly
4069 !==============================================
4070 implicit none
4071
4072 !==============================================
4073 ! declare arguments
4074 !==============================================
4075 real, intent(in) :: dt
4076 integer, intent(in) :: ime
4077 integer, intent(in) :: ims
4078 integer, intent(in) :: jme
4079 integer, intent(in) :: jms
4080 real, intent(in) :: g_mut(ims:ime,jms:jme)
4081 integer, intent(in) :: kme
4082 integer, intent(in) :: kms
4083 real, intent(inout) :: g_rw_tend(ims:ime,kms:kme,jms:jme)
4084 real, intent(in) :: g_w(ims:ime,kms:kme,jms:jme)
4085 real, intent(in) :: g_ww(ims:ime,kms:kme,jms:jme)
4086 integer, intent(in) :: ide
4087 integer, intent(in) :: ite
4088 integer, intent(in) :: its
4089 integer, intent(in) :: jde
4090 integer, intent(in) :: jte
4091 integer, intent(in) :: jts
4092 integer, intent(in) :: kde
4093 real, intent(in) :: mut(ims:ime,jms:jme)
4094 real, intent(in) :: rdnw(kms:kme)
4095 real, intent(inout) :: rw_tend(ims:ime,kms:kme,jms:jme)
4096 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
4097 real, intent(in) :: ww(ims:ime,kms:kme,jms:jme)
4098
4099 !==============================================
4100 ! declare local variables
4101 !==============================================
4102 real cf_d
4103 real cf_n
4104 real cfl
4105 real g_cf_d
4106 real g_cf_n
4107 integer i
4108 integer itf
4109 integer j
4110 integer jtf
4111 integer k
4112
4113 !----------------------------------------------
4114 ! TANGENT LINEAR AND FUNCTION STATEMENTS
4115 !----------------------------------------------
4116 itf = min(ite,ide-1)
4117 jtf = min(jte,jde-1)
4118 do j = jts, jtf
4119 do k = 2, kde-1
4120 do i = its, itf
4121 g_cf_n = g_ww(i,k,j)*sign(1.,ww(i,k,j))
4122 cf_n = abs(ww(i,k,j))
4123 g_cf_d = g_mut(i,j)*rdnw(k)*dt*sign(1.,mut(i,j)*rdnw(k)*dt)
4124 cf_d = abs(mut(i,j)*rdnw(k)*dt)
4125 if (cf_n .gt. cf_d*w_beta) then
4126 g_rw_tend(i,k,j) = (-(g_mut(i,j)*w_alpha*(cfl-w_beta)*sign(1.,w(i,k,j))))+g_rw_tend(i,k,j)
4127 rw_tend(i,k,j) = rw_tend(i,k,j)-sign(1.,w(i,k,j))*w_alpha*(cfl-w_beta)*mut(i,j)
4128 endif
4129 end do
4130 end do
4131 end do
4132
4133 end subroutine g_w_damp
4134
4135
4136 subroutine g_zero_tend( tendency, g_tendency, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
4137 !******************************************************************
4138 !******************************************************************
4139 !** This routine was generated by Automatic differentiation. **
4140 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
4141 !******************************************************************
4142 !******************************************************************
4143 !==============================================
4144 ! all entries are defined explicitly
4145 !==============================================
4146 implicit none
4147
4148 !==============================================
4149 ! declare arguments
4150 !==============================================
4151 integer, intent(in) :: ime
4152 integer, intent(in) :: ims
4153 integer, intent(in) :: jme
4154 integer, intent(in) :: jms
4155 integer, intent(in) :: kme
4156 integer, intent(in) :: kms
4157 real, intent(inout) :: g_tendency(ims:ime,kms:kme,jms:jme)
4158 integer, intent(in) :: ite
4159 integer, intent(in) :: its
4160 integer, intent(in) :: jte
4161 integer, intent(in) :: jts
4162 integer, intent(in) :: kte
4163 integer, intent(in) :: kts
4164 real, intent(inout) :: tendency(ims:ime,kms:kme,jms:jme)
4165
4166 !==============================================
4167 ! declare local variables
4168 !==============================================
4169 integer i
4170 integer j
4171 integer k
4172
4173 !----------------------------------------------
4174 ! TANGENT LINEAR AND FUNCTION STATEMENTS
4175 !----------------------------------------------
4176 do j = jts, jte
4177 do k = kts, kte
4178 do i = its, ite
4179 g_tendency(i,k,j) = 0.
4180 tendency(i,k,j) = 0.
4181 end do
4182 end do
4183 end do
4184
4185 end subroutine g_zero_tend
4186
4187 end module g_module_big_step_utilities_em
4188