module_big_step_utilities_em_ad.F
References to this file elsewhere.
1 ! DISCLAIMER
2 !
3 ! This file was generated by TAF version 1.7.18
4 !
5 ! FASTOPT DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED,
6 ! INCLUDING (WITHOUT LIMITATION) ALL IMPLIED WARRANTIES OF
7 ! MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, WITH
8 ! RESPECT TO THE SOFTWARE AND USER PROGRAMS. IN NO EVENT
9 ! SHALL FASTOPT BE LIABLE FOR ANY LOST OR ANTICIPATED PROF-
10 ! ITS, OR ANY INDIRECT, INCIDENTAL, EXEMPLARY, SPECIAL, OR
11 ! CONSEQUENTIAL DAMAGES, WHETHER OR NOT FASTOPT WAS ADVISED
12 ! OF THE POSSIBILITY OF SUCH DAMAGES.
13 !
14 ! Haftungsbeschraenkung
15 ! FastOpt gibt ausdruecklich keine Gewaehr, explizit oder indirekt,
16 ! bezueglich der Brauchbarkeit der Software fuer einen bestimmten
17 ! Zweck. Unter keinen Umstaenden ist FastOpt haftbar fuer
18 ! irgendeinen Verlust oder nicht eintretenden erwarteten Gewinn und
19 ! allen indirekten, zufaelligen, exemplarischen oder speziellen
20 ! Schaeden oder Folgeschaeden unabhaengig von einer eventuellen
21 ! Mitteilung darueber an FastOpt.
22 !
23 module a_module_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 a_calc_alt( a_alt, a_al, 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(inout) :: a_al(ims:ime,kms:kme,jms:jme)
67 real, intent(inout) :: a_alt(ims:ime,kms:kme,jms:jme)
68 integer, intent(in) :: ide
69 integer, intent(in) :: ite
70 integer, intent(in) :: its
71 integer, intent(in) :: jde
72 integer, intent(in) :: jte
73 integer, intent(in) :: jts
74 integer, intent(in) :: kde
75 integer, intent(in) :: kte
76 integer, intent(in) :: kts
77
78 !==============================================
79 ! declare local variables
80 !==============================================
81 integer i
82 integer itf
83 integer j
84 integer jtf
85 integer k
86 integer ktf
87
88 !----------------------------------------------
89 ! ROUTINE BODY
90 !----------------------------------------------
91 itf = min(ite,ide-1)
92 ! recompute : itf
93 jtf = min(jte,jde-1)
94 ! recompute : jtf
95 ktf = min(kte,kde-1)
96 ! recompute : ktf
97 do j = jts, jtf
98 do k = kts, ktf
99 do i = its, itf
100 a_al(i,k,j) = a_al(i,k,j)+a_alt(i,k,j)
101 a_alt(i,k,j) = 0.
102 end do
103 end do
104 end do
105
106 end subroutine a_calc_alt
107
108
109 subroutine a_calc_cq( moist, a_moist, a_cqu, a_cqv, a_cqw, n_moist, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, &
110 &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(inout) :: a_cqu(ims:ime,kms:kme,jms:jme)
132 real, intent(inout) :: a_cqv(ims:ime,kms:kme,jms:jme)
133 real, intent(inout) :: a_cqw(ims:ime,kms:kme,jms:jme)
134 integer, intent(in) :: n_moist
135 real, intent(inout) :: a_moist(ims:ime,kms:kme,jms:jme,n_moist)
136 integer, intent(in) :: ide
137 integer, intent(in) :: ite
138 integer, intent(in) :: its
139 integer, intent(in) :: jde
140 integer, intent(in) :: jte
141 integer, intent(in) :: jts
142 integer, intent(in) :: kde
143 integer, intent(in) :: kte
144 integer, intent(in) :: kts
145 real, intent(in) :: moist(ims:ime,kms:kme,jms:jme,n_moist)
146
147 !==============================================
148 ! declare local variables
149 !==============================================
150 real a_qtot
151 integer i
152 integer ispe
153 integer itf
154 integer j
155 integer jtf
156 integer k
157 integer ktf
158 real qtot
159
160 !----------------------------------------------
161 ! RESET LOCAL ADJOINT VARIABLES
162 !----------------------------------------------
163 a_qtot = 0.
164
165 !----------------------------------------------
166 ! ROUTINE BODY
167 !----------------------------------------------
168 ktf = min(kte,kde-1)
169 ! recompute : ktf
170 if (n_moist .ge. param_first_scalar) then
171 itf = min(ite,ide-1)
172 ! recompute : itf
173 jtf = min(jte,jde-1)
174 ! recompute : jtf
175 do j = jts, jtf
176 a_qtot = 0.
177 do k = kts+1, ktf
178 a_qtot = 0.
179 do i = its, itf
180 a_qtot = 0.
181 a_qtot = a_qtot+0.5*a_cqw(i,k,j)
182 a_cqw(i,k,j) = 0.
183 do ispe = param_first_scalar, n_moist
184 a_moist(i,k-1,j,ispe) = a_moist(i,k-1,j,ispe)+a_qtot
185 a_moist(i,k,j,ispe) = a_moist(i,k,j,ispe)+a_qtot
186 end do
187 a_qtot = 0.
188 end do
189 end do
190 end do
191 ! recdepend vars : ide,ite
192 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:860
193 ! recompute vars : itf
194 itf = min(ite,ide-1)
195 ! recompute vars : itf
196 ! recdepend vars : itf,jte
197 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:861
198 ! recompute vars : jtf
199 jtf = jte
200 ! recompute vars : jtf
201 do j = jts, jtf
202 a_qtot = 0.
203 do k = kts, ktf
204 a_qtot = 0.
205 do i = its, itf
206 a_qtot = 0.
207 qtot = 0.
208 ! recompute : qtot
209 do ispe = param_first_scalar, n_moist
210 qtot = qtot+moist(i,k,j,ispe)+moist(i,k,j-1,ispe)
211 end do
212 ! recompute : qtot
213 a_qtot = a_qtot-a_cqv(i,k,j)*(0.5/((1.+0.5*qtot)*(1.+0.5*qtot)))
214 a_cqv(i,k,j) = 0.
215 do ispe = param_first_scalar, n_moist
216 a_moist(i,k,j-1,ispe) = a_moist(i,k,j-1,ispe)+a_qtot
217 a_moist(i,k,j,ispe) = a_moist(i,k,j,ispe)+a_qtot
218 end do
219 a_qtot = 0.
220 end do
221 end do
222 end do
223 ! recdepend vars : ite
224 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:839
225 ! recompute vars : itf
226 itf = ite
227 ! recompute vars : itf
228 ! recdepend vars : itf,jde,jte
229 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:840
230 ! recompute vars : jtf
231 jtf = min(jte,jde-1)
232 ! recompute vars : jtf
233 do j = jts, jtf
234 a_qtot = 0.
235 do k = kts, ktf
236 a_qtot = 0.
237 do i = its, itf
238 a_qtot = 0.
239 qtot = 0.
240 ! recompute : qtot
241 do ispe = param_first_scalar, n_moist
242 qtot = qtot+moist(i,k,j,ispe)+moist(i-1,k,j,ispe)
243 end do
244 ! recompute : qtot
245 a_qtot = a_qtot-a_cqu(i,k,j)*(0.5/((1.+0.5*qtot)*(1.+0.5*qtot)))
246 a_cqu(i,k,j) = 0.
247 do ispe = param_first_scalar, n_moist
248 a_moist(i-1,k,j,ispe) = a_moist(i-1,k,j,ispe)+a_qtot
249 a_moist(i,k,j,ispe) = a_moist(i,k,j,ispe)+a_qtot
250 end do
251 a_qtot = 0.
252 end do
253 end do
254 end do
255 else
256 itf = min(ite,ide-1)
257 ! recompute : itf
258 jtf = min(jte,jde-1)
259 ! recompute : jtf
260 do j = jts, jtf
261 do k = kts+1, ktf
262 do i = its, itf
263 a_cqw(i,k,j) = 0.
264 end do
265 end do
266 end do
267 ! recdepend vars : ide,ite
268 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:905
269 ! recompute vars : itf
270 itf = min(ite,ide-1)
271 ! recompute vars : itf
272 ! recdepend vars : itf,jte
273 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:906
274 ! recompute vars : jtf
275 jtf = jte
276 ! recompute vars : jtf
277 do j = jts, jtf
278 do k = kts, ktf
279 do i = its, itf
280 a_cqv(i,k,j) = 0.
281 end do
282 end do
283 end do
284 ! recdepend vars : ite
285 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:839
286 ! recompute vars : itf
287 itf = ite
288 ! recompute vars : itf
289 ! recdepend vars : itf,jde,jte
290 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:840
291 ! recompute vars : jtf
292 jtf = min(jte,jde-1)
293 ! recompute vars : jtf
294 do j = jts, jtf
295 do k = kts, ktf
296 do i = its, itf
297 a_cqu(i,k,j) = 0.
298 end do
299 end do
300 end do
301 endif
302
303 end subroutine a_calc_cq
304
305
306 subroutine a_calc_mu_uv( config_flags, a_mu, a_muu, a_muv, ids, ide, jds, jde, ims, ime, jms, jme, its, ite, jts, jte )
307 !******************************************************************
308 !******************************************************************
309 !** This routine was generated by Automatic differentiation. **
310 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
311 !******************************************************************
312 !******************************************************************
313 !==============================================
314 ! all entries are defined explicitly
315 !==============================================
316 implicit none
317
318 !==============================================
319 ! declare arguments
320 !==============================================
321 integer, intent(in) :: ime
322 integer, intent(in) :: ims
323 integer, intent(in) :: jme
324 integer, intent(in) :: jms
325 real, intent(inout) :: a_mu(ims:ime,jms:jme)
326 real, intent(inout) :: a_muu(ims:ime,jms:jme)
327 real, intent(inout) :: a_muv(ims:ime,jms:jme)
328 type (grid_config_rec_type), intent(in) :: config_flags
329 integer, intent(in) :: ide
330 integer, intent(in) :: ids
331 integer, intent(in) :: ite
332 integer, intent(in) :: its
333 integer, intent(in) :: jde
334 integer, intent(in) :: jds
335 integer, intent(in) :: jte
336 integer, intent(in) :: jts
337
338 !==============================================
339 ! declare local variables
340 !==============================================
341 integer i
342 integer im
343 integer itf
344 integer j
345 integer jm
346 integer jtf
347
348 !----------------------------------------------
349 ! ROUTINE BODY
350 !----------------------------------------------
351 itf = min(ite,ide-1)
352 ! recompute : itf
353 jtf = jte
354 ! recompute : jtf
355 if (jts .ne. jds .and. jte .ne. jde) then
356 do j = jts, jtf
357 do i = its, itf
358 a_mu(i,j-1) = a_mu(i,j-1)+0.5*a_muv(i,j)
359 a_mu(i,j) = a_mu(i,j)+0.5*a_muv(i,j)
360 a_muv(i,j) = 0.
361 end do
362 end do
363 else if (jts .eq. jds .and. jte .ne. jde) then
364 j = jts
365 ! recompute : j
366 jm = jts
367 ! recompute : jm
368 if (config_flags%periodic_y) then
369 jm = jts-1
370 endif
371 ! recompute : jm
372 do i = its, itf
373 a_mu(i,j) = a_mu(i,j)+0.5*a_muv(i,j)
374 a_mu(i,jm) = a_mu(i,jm)+0.5*a_muv(i,j)
375 a_muv(i,j) = 0.
376 end do
377 do j = jts+1, jtf
378 do i = its, itf
379 a_mu(i,j-1) = a_mu(i,j-1)+0.5*a_muv(i,j)
380 a_mu(i,j) = a_mu(i,j)+0.5*a_muv(i,j)
381 a_muv(i,j) = 0.
382 end do
383 end do
384 else if (jts .ne. jds .and. jte .eq. jde) then
385 j = jte
386 ! recompute : j
387 jm = jte-1
388 ! recompute : jm
389 if (config_flags%periodic_y) then
390 jm = jte
391 endif
392 ! recompute : jm
393 do i = its, itf
394 a_mu(i,j-1) = a_mu(i,j-1)+0.5*a_muv(i,j)
395 a_mu(i,jm) = a_mu(i,jm)+0.5*a_muv(i,j)
396 a_muv(i,j) = 0.
397 a_mu(i,j-1) = a_mu(i,j-1)+a_muv(i,j)
398 a_muv(i,j) = 0.
399 end do
400 do j = jts, jtf-1
401 do i = its, itf
402 a_mu(i,j-1) = a_mu(i,j-1)+0.5*a_muv(i,j)
403 a_mu(i,j) = a_mu(i,j)+0.5*a_muv(i,j)
404 a_muv(i,j) = 0.
405 end do
406 end do
407 else if (jts .eq. jds .and. jte .eq. jde) then
408 j = jte
409 ! recompute : j
410 jm = jte-1
411 ! recompute : jm
412 if (config_flags%periodic_y) then
413 jm = jte
414 endif
415 ! recompute : jm
416 do i = its, itf
417 a_mu(i,j-1) = a_mu(i,j-1)+0.5*a_muv(i,j)
418 a_mu(i,jm) = a_mu(i,jm)+0.5*a_muv(i,j)
419 a_muv(i,j) = 0.
420 end do
421 ! recdepend vars : jts
422 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:150
423 ! recompute vars : j
424 j = jts
425 ! recompute vars : j
426 ! recdepend vars : j,jts
427 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:151
428 ! recompute vars : jm
429 jm = jts
430 ! recompute vars : jm
431 ! recdepend vars : config_flags,j,jm,jts
432 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:152
433 ! recompute vars : jm
434 if (config_flags%periodic_y) then
435 jm = jts-1
436 endif
437 ! recompute vars : jm
438 do i = its, itf
439 a_mu(i,j) = a_mu(i,j)+0.5*a_muv(i,j)
440 a_mu(i,jm) = a_mu(i,jm)+0.5*a_muv(i,j)
441 a_muv(i,j) = 0.
442 end do
443 do j = jts+1, jtf-1
444 do i = its, itf
445 a_mu(i,j-1) = a_mu(i,j-1)+0.5*a_muv(i,j)
446 a_mu(i,j) = a_mu(i,j)+0.5*a_muv(i,j)
447 a_muv(i,j) = 0.
448 end do
449 end do
450 endif
451 ! recdepend vars : ite
452 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:46
453 ! recompute vars : itf
454 itf = ite
455 ! recompute vars : itf
456 ! recdepend vars : itf,jde,jte
457 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:47
458 ! recompute vars : jtf
459 jtf = min(jte,jde-1)
460 ! recompute vars : jtf
461 if (its .ne. ids .and. ite .ne. ide) then
462 do j = jts, jtf
463 do i = its, itf
464 a_mu(i-1,j) = a_mu(i-1,j)+0.5*a_muu(i,j)
465 a_mu(i,j) = a_mu(i,j)+0.5*a_muu(i,j)
466 a_muu(i,j) = 0.
467 end do
468 end do
469 else if (its .eq. ids .and. ite .ne. ide) then
470 i = its
471 ! recompute : i
472 im = its
473 ! recompute : im
474 if (config_flags%periodic_x) then
475 im = its-1
476 endif
477 ! recompute : im
478 do j = jts, jtf
479 a_mu(i,j) = a_mu(i,j)+0.5*a_muu(i,j)
480 a_mu(im,j) = a_mu(im,j)+0.5*a_muu(i,j)
481 a_muu(i,j) = 0.
482 end do
483 do j = jts, jtf
484 do i = its+1, itf
485 a_mu(i-1,j) = a_mu(i-1,j)+0.5*a_muu(i,j)
486 a_mu(i,j) = a_mu(i,j)+0.5*a_muu(i,j)
487 a_muu(i,j) = 0.
488 end do
489 end do
490 else if (its .ne. ids .and. ite .eq. ide) then
491 i = ite
492 ! recompute : i
493 im = ite-1
494 ! recompute : im
495 if (config_flags%periodic_x) then
496 im = ite
497 endif
498 ! recompute : im
499 do j = jts, jtf
500 a_mu(i-1,j) = a_mu(i-1,j)+0.5*a_muu(i,j)
501 a_mu(im,j) = a_mu(im,j)+0.5*a_muu(i,j)
502 a_muu(i,j) = 0.
503 end do
504 do j = jts, jtf
505 do i = its, itf-1
506 a_mu(i-1,j) = a_mu(i-1,j)+0.5*a_muu(i,j)
507 a_mu(i,j) = a_mu(i,j)+0.5*a_muu(i,j)
508 a_muu(i,j) = 0.
509 end do
510 end do
511 else if (its .eq. ids .and. ite .eq. ide) then
512 i = ite
513 ! recompute : i
514 im = ite-1
515 ! recompute : im
516 if (config_flags%periodic_x) then
517 im = ite
518 endif
519 ! recompute : im
520 do j = jts, jtf
521 a_mu(i-1,j) = a_mu(i-1,j)+0.5*a_muu(i,j)
522 a_mu(im,j) = a_mu(im,j)+0.5*a_muu(i,j)
523 a_muu(i,j) = 0.
524 end do
525 ! recdepend vars : its
526 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:89
527 ! recompute vars : i
528 i = its
529 ! recompute vars : i
530 ! recdepend vars : i,its
531 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:90
532 ! recompute vars : im
533 im = its
534 ! recompute vars : im
535 ! recdepend vars : config_flags,i,im,its
536 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:91
537 ! recompute vars : im
538 if (config_flags%periodic_x) then
539 im = its-1
540 endif
541 ! recompute vars : im
542 do j = jts, jtf
543 a_mu(i,j) = a_mu(i,j)+0.5*a_muu(i,j)
544 a_mu(im,j) = a_mu(im,j)+0.5*a_muu(i,j)
545 a_muu(i,j) = 0.
546 end do
547 do j = jts, jtf
548 do i = its+1, itf-1
549 a_mu(i-1,j) = a_mu(i-1,j)+0.5*a_muu(i,j)
550 a_mu(i,j) = a_mu(i,j)+0.5*a_muu(i,j)
551 a_muu(i,j) = 0.
552 end do
553 end do
554 endif
555
556 end subroutine a_calc_mu_uv
557
558
559 subroutine a_calc_mu_uv_1( config_flags, a_mu, a_muu, a_muv, ids, ide, jds, jde, ims, ime, jms, jme, its, ite, jts, jte )
560 !******************************************************************
561 !******************************************************************
562 !** This routine was generated by Automatic differentiation. **
563 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
564 !******************************************************************
565 !******************************************************************
566 !==============================================
567 ! all entries are defined explicitly
568 !==============================================
569 implicit none
570
571 !==============================================
572 ! declare arguments
573 !==============================================
574 integer, intent(in) :: ime
575 integer, intent(in) :: ims
576 integer, intent(in) :: jme
577 integer, intent(in) :: jms
578 real, intent(inout) :: a_mu(ims:ime,jms:jme)
579 real, intent(inout) :: a_muu(ims:ime,jms:jme)
580 real, intent(inout) :: a_muv(ims:ime,jms:jme)
581 type (grid_config_rec_type), intent(in) :: config_flags
582 integer, intent(in) :: ide
583 integer, intent(in) :: ids
584 integer, intent(in) :: ite
585 integer, intent(in) :: its
586 integer, intent(in) :: jde
587 integer, intent(in) :: jds
588 integer, intent(in) :: jte
589 integer, intent(in) :: jts
590
591 !==============================================
592 ! declare local variables
593 !==============================================
594 integer i
595 integer im
596 integer itf
597 integer j
598 integer jm
599 integer jtf
600
601 !----------------------------------------------
602 ! ROUTINE BODY
603 !----------------------------------------------
604 itf = min(ite,ide-1)
605 ! recompute : itf
606 jtf = jte
607 ! recompute : jtf
608 if (jts .ne. jds .and. jte .ne. jde) then
609 do j = jts, jtf
610 do i = its, itf
611 a_mu(i,j-1) = a_mu(i,j-1)+0.5*a_muv(i,j)
612 a_mu(i,j) = a_mu(i,j)+0.5*a_muv(i,j)
613 a_muv(i,j) = 0.
614 end do
615 end do
616 else if (jts .eq. jds .and. jte .ne. jde) then
617 j = jts
618 ! recompute : j
619 jm = jts
620 ! recompute : jm
621 if (config_flags%periodic_y) then
622 jm = jts-1
623 endif
624 ! recompute : jm
625 do i = its, itf
626 a_mu(i,j) = a_mu(i,j)+0.5*a_muv(i,j)
627 a_mu(i,jm) = a_mu(i,jm)+0.5*a_muv(i,j)
628 a_muv(i,j) = 0.
629 end do
630 do j = jts+1, jtf
631 do i = its, itf
632 a_mu(i,j-1) = a_mu(i,j-1)+0.5*a_muv(i,j)
633 a_mu(i,j) = a_mu(i,j)+0.5*a_muv(i,j)
634 a_muv(i,j) = 0.
635 end do
636 end do
637 else if (jts .ne. jds .and. jte .eq. jde) then
638 j = jte
639 ! recompute : j
640 jm = jte-1
641 ! recompute : jm
642 if (config_flags%periodic_y) then
643 jm = jte
644 endif
645 ! recompute : jm
646 do i = its, itf
647 a_mu(i,j-1) = a_mu(i,j-1)+0.5*a_muv(i,j)
648 a_mu(i,jm) = a_mu(i,jm)+0.5*a_muv(i,j)
649 a_muv(i,j) = 0.
650 end do
651 do j = jts, jtf-1
652 do i = its, itf
653 a_mu(i,j-1) = a_mu(i,j-1)+0.5*a_muv(i,j)
654 a_mu(i,j) = a_mu(i,j)+0.5*a_muv(i,j)
655 a_muv(i,j) = 0.
656 end do
657 end do
658 else if (jts .eq. jds .and. jte .eq. jde) then
659 j = jte
660 ! recompute : j
661 jm = jte-1
662 ! recompute : jm
663 if (config_flags%periodic_y) then
664 jm = jte
665 endif
666 ! recompute : jm
667 do i = its, itf
668 a_mu(i,j-1) = a_mu(i,j-1)+0.5*a_muv(i,j)
669 a_mu(i,jm) = a_mu(i,jm)+0.5*a_muv(i,j)
670 a_muv(i,j) = 0.
671 end do
672 ! recdepend vars : jts
673 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:295
674 ! recompute vars : j
675 j = jts
676 ! recompute vars : j
677 ! recdepend vars : j,jts
678 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:296
679 ! recompute vars : jm
680 jm = jts
681 ! recompute vars : jm
682 ! recdepend vars : config_flags,j,jm,jts
683 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:297
684 ! recompute vars : jm
685 if (config_flags%periodic_y) then
686 jm = jts-1
687 endif
688 ! recompute vars : jm
689 do i = its, itf
690 a_mu(i,j) = a_mu(i,j)+0.5*a_muv(i,j)
691 a_mu(i,jm) = a_mu(i,jm)+0.5*a_muv(i,j)
692 a_muv(i,j) = 0.
693 end do
694 do j = jts+1, jtf-1
695 do i = its, itf
696 a_mu(i,j-1) = a_mu(i,j-1)+0.5*a_muv(i,j)
697 a_mu(i,j) = a_mu(i,j)+0.5*a_muv(i,j)
698 a_muv(i,j) = 0.
699 end do
700 end do
701 endif
702 ! recdepend vars : ite
703 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:203
704 ! recompute vars : itf
705 itf = ite
706 ! recompute vars : itf
707 ! recdepend vars : itf,jde,jte
708 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:204
709 ! recompute vars : jtf
710 jtf = min(jte,jde-1)
711 ! recompute vars : jtf
712 if (its .ne. ids .and. ite .ne. ide) then
713 do j = jts, jtf
714 do i = its, itf
715 a_mu(i-1,j) = a_mu(i-1,j)+0.5*a_muu(i,j)
716 a_mu(i,j) = a_mu(i,j)+0.5*a_muu(i,j)
717 a_muu(i,j) = 0.
718 end do
719 end do
720 else if (its .eq. ids .and. ite .ne. ide) then
721 i = its
722 ! recompute : i
723 im = its
724 ! recompute : im
725 if (config_flags%periodic_x) then
726 im = its-1
727 endif
728 ! recompute : im
729 do j = jts, jtf
730 a_mu(i,j) = a_mu(i,j)+0.5*a_muu(i,j)
731 a_mu(im,j) = a_mu(im,j)+0.5*a_muu(i,j)
732 a_muu(i,j) = 0.
733 end do
734 do j = jts, jtf
735 do i = its+1, itf
736 a_mu(i-1,j) = a_mu(i-1,j)+0.5*a_muu(i,j)
737 a_mu(i,j) = a_mu(i,j)+0.5*a_muu(i,j)
738 a_muu(i,j) = 0.
739 end do
740 end do
741 else if (its .ne. ids .and. ite .eq. ide) then
742 i = ite
743 ! recompute : i
744 im = ite-1
745 ! recompute : im
746 if (config_flags%periodic_x) then
747 im = ite
748 endif
749 ! recompute : im
750 do j = jts, jtf
751 a_mu(i-1,j) = a_mu(i-1,j)+0.5*a_muu(i,j)
752 a_mu(im,j) = a_mu(im,j)+0.5*a_muu(i,j)
753 a_muu(i,j) = 0.
754 end do
755 do j = jts, jtf
756 do i = its, itf-1
757 a_mu(i-1,j) = a_mu(i-1,j)+0.5*a_muu(i,j)
758 a_mu(i,j) = a_mu(i,j)+0.5*a_muu(i,j)
759 a_muu(i,j) = 0.
760 end do
761 end do
762 else if (its .eq. ids .and. ite .eq. ide) then
763 i = ite
764 ! recompute : i
765 im = ite-1
766 ! recompute : im
767 if (config_flags%periodic_x) then
768 im = ite
769 endif
770 ! recompute : im
771 do j = jts, jtf
772 a_mu(i-1,j) = a_mu(i-1,j)+0.5*a_muu(i,j)
773 a_mu(im,j) = a_mu(im,j)+0.5*a_muu(i,j)
774 a_muu(i,j) = 0.
775 end do
776 ! recdepend vars : its
777 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:242
778 ! recompute vars : i
779 i = its
780 ! recompute vars : i
781 ! recdepend vars : i,its
782 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:243
783 ! recompute vars : im
784 im = its
785 ! recompute vars : im
786 ! recdepend vars : config_flags,i,im,its
787 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:244
788 ! recompute vars : im
789 if (config_flags%periodic_x) then
790 im = its-1
791 endif
792 ! recompute vars : im
793 do j = jts, jtf
794 a_mu(i,j) = a_mu(i,j)+0.5*a_muu(i,j)
795 a_mu(im,j) = a_mu(im,j)+0.5*a_muu(i,j)
796 a_muu(i,j) = 0.
797 end do
798 do j = jts, jtf
799 do i = its+1, itf-1
800 a_mu(i-1,j) = a_mu(i-1,j)+0.5*a_muu(i,j)
801 a_mu(i,j) = a_mu(i,j)+0.5*a_muu(i,j)
802 a_muu(i,j) = 0.
803 end do
804 end do
805 endif
806
807 end subroutine a_calc_mu_uv_1
808
809
810 subroutine a_calc_p_rho_phi( moist, a_moist, n_moist, al, a_al, alb, mu, a_mu, muts, a_muts, ph, a_ph, p, a_p, pb, t, a_t, p0, t0, &
811 &dnw, rdnw, rdn, non_hydrostatic, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
812 !******************************************************************
813 !******************************************************************
814 !** This routine was generated by Automatic differentiation. **
815 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
816 !******************************************************************
817 !******************************************************************
818 !==============================================
819 ! all entries are defined explicitly
820 !==============================================
821 implicit none
822
823 !==============================================
824 ! declare arguments
825 !==============================================
826 integer, intent(in) :: ime
827 integer, intent(in) :: ims
828 integer, intent(in) :: jme
829 integer, intent(in) :: jms
830 integer, intent(in) :: kme
831 integer, intent(in) :: kms
832 real, intent(inout) :: a_al(ims:ime,kms:kme,jms:jme)
833 integer, intent(in) :: n_moist
834 real, intent(inout) :: a_moist(ims:ime,kms:kme,jms:jme,n_moist)
835 real, intent(inout) :: a_mu(ims:ime,jms:jme)
836 real, intent(inout) :: a_muts(ims:ime,jms:jme)
837 real, intent(inout) :: a_p(ims:ime,kms:kme,jms:jme)
838 real, intent(inout) :: a_ph(ims:ime,kms:kme,jms:jme)
839 real, intent(inout) :: a_t(ims:ime,kms:kme,jms:jme)
840 real, intent(out) :: al(ims:ime,kms:kme,jms:jme)
841 real, intent(in) :: alb(ims:ime,kms:kme,jms:jme)
842 real, intent(in) :: dnw(kms:kme)
843 integer, intent(in) :: ide
844 integer, intent(in) :: ite
845 integer, intent(in) :: its
846 integer, intent(in) :: jde
847 integer, intent(in) :: jte
848 integer, intent(in) :: jts
849 integer, intent(in) :: kde
850 integer, intent(in) :: kte
851 integer, intent(in) :: kts
852 real, intent(in) :: moist(ims:ime,kms:kme,jms:jme,n_moist)
853 real, intent(in) :: mu(ims:ime,jms:jme)
854 real, intent(in) :: muts(ims:ime,jms:jme)
855 logical, intent(in) :: non_hydrostatic
856 real, intent(out) :: p(ims:ime,kms:kme,jms:jme)
857 real, intent(in) :: p0
858 real, intent(in) :: pb(ims:ime,kms:kme,jms:jme)
859 real, intent(inout) :: ph(ims:ime,kms:kme,jms:jme)
860 real, intent(in) :: rdn(kms:kme)
861 real, intent(in) :: rdnw(kms:kme)
862 real, intent(in) :: t(ims:ime,kms:kme,jms:jme)
863 real, intent(in) :: t0
864
865 !==============================================
866 ! declare local variables
867 !==============================================
868 real a_qf1
869 real a_qf2
870 real a_qtot
871 real a_qvf
872 integer i
873 integer ispe
874 integer itf
875 integer j
876 integer jtf
877 integer k
878 integer k1
879 integer k2
880 integer ka1
881 integer ka2
882 integer ktf
883 real qf1
884 real qf2
885 real qtot
886 real qvf
887
888 !----------------------------------------------
889 ! RESET LOCAL ADJOINT VARIABLES
890 !----------------------------------------------
891 a_qf1 = 0.
892 a_qf2 = 0.
893 a_qtot = 0.
894 a_qvf = 0.
895
896 !----------------------------------------------
897 ! ROUTINE BODY
898 !----------------------------------------------
899 itf = min(ite,ide-1)
900 ! recompute : itf
901 jtf = min(jte,jde-1)
902 ! recompute : jtf
903 ktf = min(kte,kde-1)
904 ! recompute : ktf
905 if (non_hydrostatic) then
906 if (n_moist .ge. param_first_scalar) then
907 do j = jts, jtf
908 a_qvf = 0.
909 do k = kts, ktf
910 a_qvf = 0.
911 do i = its, itf
912 a_qvf = 0.
913 qvf = 1.+rvovrd*moist(i,k,j,p_qv)
914 ! recompute : qvf
915 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))))
916 ! recompute : al
917 a_al(i,k,j) = a_al(i,k,j)-a_p(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)))*&
918 &cpovcv*(r_d*(t0+t(i,k,j))*qvf/(p0*(al(i,k,j)+alb(i,k,j))))**(cpovcv-1)*p0
919 a_qvf = a_qvf+a_p(i,k,j)*r_d*(t0+t(i,k,j))/(p0*(al(i,k,j)+alb(i,k,j)))*cpovcv*(r_d*(t0+t(i,k,j))*qvf/(p0*(al(i,k,j)+&
920 &alb(i,k,j))))**(cpovcv-1)*p0
921 a_t(i,k,j) = a_t(i,k,j)+a_p(i,k,j)*r_d*qvf/(p0*(al(i,k,j)+alb(i,k,j)))*cpovcv*(r_d*(t0+t(i,k,j))*qvf/(p0*(al(i,k,j)+&
922 &alb(i,k,j))))**(cpovcv-1)*p0
923 a_p(i,k,j) = 0.
924 a_mu(i,j) = a_mu(i,j)-a_al(i,k,j)*1./muts(i,j)*alb(i,k,j)
925 a_muts(i,j) = a_muts(i,j)+a_al(i,k,j)/(muts(i,j)*muts(i,j))*(alb(i,k,j)*mu(i,j)+rdnw(k)*(ph(i,k+1,j)-ph(i,k,j)))
926 a_ph(i,k+1,j) = a_ph(i,k+1,j)-a_al(i,k,j)*1./muts(i,j)*rdnw(k)
927 a_ph(i,k,j) = a_ph(i,k,j)+a_al(i,k,j)*1./muts(i,j)*rdnw(k)
928 a_al(i,k,j) = 0.
929 a_moist(i,k,j,p_qv) = a_moist(i,k,j,p_qv)+a_qvf*rvovrd
930 a_qvf = 0.
931 end do
932 end do
933 end do
934 else
935 do j = jts, jtf
936 do k = kts, ktf
937 do i = its, itf
938 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))))
939 ! recompute : al
940 a_al(i,k,j) = a_al(i,k,j)-a_p(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)))*&
941 &cpovcv*(r_d*(t0+t(i,k,j))/(p0*(al(i,k,j)+alb(i,k,j))))**(cpovcv-1)
942 a_t(i,k,j) = a_t(i,k,j)+a_p(i,k,j)*p0*r_d/(p0*(al(i,k,j)+alb(i,k,j)))*cpovcv*(r_d*(t0+t(i,k,j))/(p0*(al(i,k,j)+alb(i,k,j)&
943 &)))**(cpovcv-1)
944 a_p(i,k,j) = 0.
945 a_mu(i,j) = a_mu(i,j)-a_al(i,k,j)*1./muts(i,j)*alb(i,k,j)
946 a_muts(i,j) = a_muts(i,j)+a_al(i,k,j)/(muts(i,j)*muts(i,j))*(alb(i,k,j)*mu(i,j)+rdnw(k)*(ph(i,k+1,j)-ph(i,k,j)))
947 a_ph(i,k+1,j) = a_ph(i,k+1,j)-a_al(i,k,j)*1./muts(i,j)*rdnw(k)
948 a_ph(i,k,j) = a_ph(i,k,j)+a_al(i,k,j)*1./muts(i,j)*rdnw(k)
949 a_al(i,k,j) = 0.
950 end do
951 end do
952 end do
953 endif
954 else
955 if (n_moist .ge. param_first_scalar) then
956 do j = jts, jtf
957 a_qf1 = 0.
958 a_qf2 = 0.
959 a_qtot = 0.
960 a_qvf = 0.
961 k = ktf
962 ! recompute : k
963 do i = its, itf
964 qtot = 0.
965 do ispe = param_first_scalar, n_moist
966 qtot = qtot+moist(i,k,j,ispe)
967 end do
968 qf2 = 1./(1.+qtot)
969 qf1 = qtot*qf2
970 p(i,k,j) = -(0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2)
971 qvf = 1.+rvovrd*moist(i,k,j,p_qv)
972 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)
973 end do
974 ! recompute : p
975 do k = ktf-1, kts, -1
976 do i = its, itf
977 qtot = 0.
978 do ispe = param_first_scalar, n_moist
979 qtot = qtot+0.5*(moist(i,k,j,ispe)+moist(i,k+1,j,ispe))
980 end do
981 qf2 = 1./(1.+qtot)
982 qf1 = qtot*qf2
983 p(i,k,j) = p(i,k+1,j)-(mu(i,j)+qf1*muts(i,j))/qf2/rdn(k+1)
984 qvf = 1.+rvovrd*moist(i,k,j,p_qv)
985 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)
986 end do
987 end do
988 ! recompute : al
989 do k = ktf+1, 2, -1
990 do i = its, itf
991 a_al(i,k-1,j) = a_al(i,k-1,j)-a_ph(i,k,j)*dnw(k-1)*muts(i,j)
992 a_mu(i,j) = a_mu(i,j)-a_ph(i,k,j)*dnw(k-1)*alb(i,k-1,j)
993 a_muts(i,j) = a_muts(i,j)-a_ph(i,k,j)*dnw(k-1)*al(i,k-1,j)
994 a_ph(i,k-1,j) = a_ph(i,k-1,j)+a_ph(i,k,j)
995 a_ph(i,k,j) = 0.
996 end do
997 end do
998 do k = kts, ktf-1
999 ! recdepend vars : alb,cvpm,itf,its,j,k,moist,mu,muts,n_moist,p1000mb,p
1000 ! _qv,param_first_scalar,pb,r_d,rdnw,rvovrd,t,t0
1001 ! recompute pos : DOLOOP_STMT module_big_step_utilities_em.f90:1077
1002 ! recompute vars : p
1003 do i = its, itf
1004 qtot = 0.
1005 do ispe = param_first_scalar, n_moist
1006 qtot = qtot+moist(i,ka1,j,ispe)
1007 end do
1008 qf2 = 1./(1.+qtot)
1009 qf1 = qtot*qf2
1010 p(i,ka1,j) = -(0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(ka1)/qf2)
1011 qvf = 1.+rvovrd*moist(i,ka1,j,p_qv)
1012 al(i,ka1,j) = r_d/p1000mb*(t(i,ka1,j)+t0)*qvf*((p(i,ka1,j)+pb(i,ka1,j))/p1000mb)**cvpm-alb(i,ka1,j)
1013 end do
1014 ! recompute vars : p
1015 do k1 = ktf-1, k-(-1), -1
1016 do i = its, itf
1017 qtot = 0.
1018 do ispe = param_first_scalar, n_moist
1019 qtot = qtot+0.5*(moist(i,k1,j,ispe)+moist(i,k1+1,j,ispe))
1020 end do
1021 qf2 = 1./(1.+qtot)
1022 qf1 = qtot*qf2
1023 p(i,k1,j) = p(i,k1+1,j)-(mu(i,j)+qf1*muts(i,j))/qf2/rdn(k1+1)
1024 end do
1025 end do
1026 do i = its, itf
1027 a_qf1 = 0.
1028 a_qf2 = 0.
1029 a_qtot = 0.
1030 a_qvf = 0.
1031 qtot = 0.
1032 ! recompute : qtot
1033 do ispe = param_first_scalar, n_moist
1034 qtot = qtot+0.5*(moist(i,k,j,ispe)+moist(i,k+1,j,ispe))
1035 end do
1036 ! recompute : qtot
1037 qf2 = 1./(1.+qtot)
1038 ! recompute : qf2
1039 qf1 = qtot*qf2
1040 ! recompute : qf1
1041 p(i,k,j) = p(i,k+1,j)-(mu(i,j)+qf1*muts(i,j))/qf2/rdn(k+1)
1042 ! recompute : p
1043 qvf = 1.+rvovrd*moist(i,k,j,p_qv)
1044 ! recompute : qvf
1045 a_p(i,k,j) = a_p(i,k,j)+a_al(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)
1046 a_qvf = a_qvf+a_al(i,k,j)*r_d/p1000mb*(t(i,k,j)+t0)*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm
1047 a_t(i,k,j) = a_t(i,k,j)+a_al(i,k,j)*r_d/p1000mb*qvf*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm
1048 a_al(i,k,j) = 0.
1049 a_moist(i,k,j,p_qv) = a_moist(i,k,j,p_qv)+a_qvf*rvovrd
1050 a_qvf = 0.
1051 a_mu(i,j) = a_mu(i,j)-a_p(i,k,j)*(1/qf2/rdn(k+1))
1052 a_muts(i,j) = a_muts(i,j)-a_p(i,k,j)*(qf1/qf2/rdn(k+1))
1053 a_p(i,k+1,j) = a_p(i,k+1,j)+a_p(i,k,j)
1054 a_qf1 = a_qf1-a_p(i,k,j)*(muts(i,j)/qf2/rdn(k+1))
1055 a_qf2 = a_qf2+a_p(i,k,j)*((mu(i,j)+qf1*muts(i,j))/(qf2*qf2)/rdn(k+1))
1056 a_p(i,k,j) = 0.
1057 a_qf2 = a_qf2+a_qf1*qtot
1058 a_qtot = a_qtot+a_qf1*qf2
1059 a_qf1 = 0.
1060 a_qtot = a_qtot-a_qf2/((1.+qtot)*(1.+qtot))
1061 a_qf2 = 0.
1062 do ispe = param_first_scalar, n_moist
1063 a_moist(i,k+1,j,ispe) = a_moist(i,k+1,j,ispe)+0.5*a_qtot
1064 a_moist(i,k,j,ispe) = a_moist(i,k,j,ispe)+0.5*a_qtot
1065 end do
1066 a_qtot = 0.
1067 end do
1068 end do
1069 ! recdepend vars : ktf
1070 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1076
1071 ! recompute vars : k
1072 k = ktf
1073 ! recompute vars : k
1074 do i = its, itf
1075 a_qf1 = 0.
1076 a_qf2 = 0.
1077 a_qtot = 0.
1078 a_qvf = 0.
1079 qtot = 0.
1080 ! recompute : qtot
1081 do ispe = param_first_scalar, n_moist
1082 qtot = qtot+moist(i,k,j,ispe)
1083 end do
1084 ! recompute : qtot
1085 qf2 = 1./(1.+qtot)
1086 ! recompute : qf2
1087 qf1 = qtot*qf2
1088 ! recompute : qf1
1089 p(i,k,j) = -(0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2)
1090 ! recompute : p
1091 qvf = 1.+rvovrd*moist(i,k,j,p_qv)
1092 ! recompute : qvf
1093 a_p(i,k,j) = a_p(i,k,j)+a_al(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)
1094 a_qvf = a_qvf+a_al(i,k,j)*r_d/p1000mb*(t(i,k,j)+t0)*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm
1095 a_t(i,k,j) = a_t(i,k,j)+a_al(i,k,j)*r_d/p1000mb*qvf*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm
1096 a_al(i,k,j) = 0.
1097 a_moist(i,k,j,p_qv) = a_moist(i,k,j,p_qv)+a_qvf*rvovrd
1098 a_qvf = 0.
1099 a_mu(i,j) = a_mu(i,j)-a_p(i,k,j)*(0.5/rdnw(k)/qf2)
1100 a_muts(i,j) = a_muts(i,j)-a_p(i,k,j)*(0.5*qf1/rdnw(k)/qf2)
1101 a_qf1 = a_qf1-a_p(i,k,j)*(0.5*muts(i,j)/rdnw(k)/qf2)
1102 a_qf2 = a_qf2+a_p(i,k,j)*(0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/(qf2*qf2))
1103 a_p(i,k,j) = 0.
1104 a_qf2 = a_qf2+a_qf1*qtot
1105 a_qtot = a_qtot+a_qf1*qf2
1106 a_qf1 = 0.
1107 a_qtot = a_qtot-a_qf2/((1.+qtot)*(1.+qtot))
1108 a_qf2 = 0.
1109 do ispe = param_first_scalar, n_moist
1110 a_moist(i,k,j,ispe) = a_moist(i,k,j,ispe)+a_qtot
1111 end do
1112 a_qtot = 0.
1113 end do
1114 end do
1115 else
1116 do j = jts, jtf
1117 a_qf1 = 0.
1118 a_qf2 = 0.
1119 a_qtot = 0.
1120 a_qvf = 0.
1121 k = ktf
1122 ! recompute : k
1123 do i = its, itf
1124 qtot = 0.
1125 qf2 = 1./(1.+qtot)
1126 qf1 = qtot*qf2
1127 p(i,k,j) = -(0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2)
1128 qvf = 1.
1129 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)
1130 end do
1131 ! recompute : p
1132 do k = ktf-1, kts, -1
1133 do i = its, itf
1134 qtot = 0.
1135 qf2 = 1./(1.+qtot)
1136 qf1 = qtot*qf2
1137 p(i,k,j) = p(i,k+1,j)-(mu(i,j)+qf1*muts(i,j))/qf2/rdn(k+1)
1138 qvf = 1.
1139 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)
1140 end do
1141 end do
1142 ! recompute : al
1143 do k = ktf+1, 2, -1
1144 do i = its, itf
1145 a_al(i,k-1,j) = a_al(i,k-1,j)-a_ph(i,k,j)*dnw(k-1)*muts(i,j)
1146 a_mu(i,j) = a_mu(i,j)-a_ph(i,k,j)*dnw(k-1)*alb(i,k-1,j)
1147 a_muts(i,j) = a_muts(i,j)-a_ph(i,k,j)*dnw(k-1)*al(i,k-1,j)
1148 a_ph(i,k-1,j) = a_ph(i,k-1,j)+a_ph(i,k,j)
1149 a_ph(i,k,j) = 0.
1150 end do
1151 end do
1152 do k = kts, ktf-1
1153 ! recdepend vars : alb,cvpm,itf,its,j,k,mu,muts,p1000mb,pb,r_d,rdnw,t,t
1154 ! 0
1155 ! recompute pos : DOLOOP_STMT module_big_step_utilities_em.f90:1131
1156 ! recompute vars : p
1157 do i = its, itf
1158 qtot = 0.
1159 qf2 = 1./(1.+qtot)
1160 qf1 = qtot*qf2
1161 p(i,ka2,j) = -(0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(ka2)/qf2)
1162 qvf = 1.
1163 al(i,ka2,j) = r_d/p1000mb*(t(i,ka2,j)+t0)*qvf*((p(i,ka2,j)+pb(i,ka2,j))/p1000mb)**cvpm-alb(i,ka2,j)
1164 end do
1165 ! recompute vars : p
1166 do k2 = ktf-1, k-(-1), -1
1167 do i = its, itf
1168 qtot = 0.
1169 qf2 = 1./(1.+qtot)
1170 qf1 = qtot*qf2
1171 p(i,k2,j) = p(i,k2+1,j)-(mu(i,j)+qf1*muts(i,j))/qf2/rdn(k2+1)
1172 end do
1173 end do
1174 do i = its, itf
1175 a_qf1 = 0.
1176 a_qf2 = 0.
1177 a_qtot = 0.
1178 a_qvf = 0.
1179 qtot = 0.
1180 ! recompute : qtot
1181 qf2 = 1./(1.+qtot)
1182 ! recompute : qf2
1183 qf1 = qtot*qf2
1184 ! recompute : qf1
1185 p(i,k,j) = p(i,k+1,j)-(mu(i,j)+qf1*muts(i,j))/qf2/rdn(k+1)
1186 ! recompute : p
1187 qvf = 1.
1188 ! recompute : qvf
1189 a_p(i,k,j) = a_p(i,k,j)+a_al(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)
1190 a_qvf = a_qvf+a_al(i,k,j)*r_d/p1000mb*(t(i,k,j)+t0)*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm
1191 a_t(i,k,j) = a_t(i,k,j)+a_al(i,k,j)*r_d/p1000mb*qvf*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm
1192 a_al(i,k,j) = 0.
1193 a_mu(i,j) = a_mu(i,j)-a_p(i,k,j)*(1/qf2/rdn(k+1))
1194 a_muts(i,j) = a_muts(i,j)-a_p(i,k,j)*(qf1/qf2/rdn(k+1))
1195 a_p(i,k+1,j) = a_p(i,k+1,j)+a_p(i,k,j)
1196 a_qf1 = a_qf1-a_p(i,k,j)*(muts(i,j)/qf2/rdn(k+1))
1197 a_qf2 = a_qf2+a_p(i,k,j)*((mu(i,j)+qf1*muts(i,j))/(qf2*qf2)/rdn(k+1))
1198 a_p(i,k,j) = 0.
1199 end do
1200 end do
1201 ! recdepend vars : ktf
1202 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1130
1203 ! recompute vars : k
1204 k = ktf
1205 ! recompute vars : k
1206 do i = its, itf
1207 a_qf1 = 0.
1208 a_qf2 = 0.
1209 a_qtot = 0.
1210 a_qvf = 0.
1211 qtot = 0.
1212 ! recompute : qtot
1213 qf2 = 1./(1.+qtot)
1214 ! recompute : qf2
1215 qf1 = qtot*qf2
1216 ! recompute : qf1
1217 p(i,k,j) = -(0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2)
1218 ! recompute : p
1219 qvf = 1.
1220 ! recompute : qvf
1221 a_p(i,k,j) = a_p(i,k,j)+a_al(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)
1222 a_qvf = a_qvf+a_al(i,k,j)*r_d/p1000mb*(t(i,k,j)+t0)*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm
1223 a_t(i,k,j) = a_t(i,k,j)+a_al(i,k,j)*r_d/p1000mb*qvf*((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm
1224 a_al(i,k,j) = 0.
1225 a_mu(i,j) = a_mu(i,j)-a_p(i,k,j)*(0.5/rdnw(k)/qf2)
1226 a_muts(i,j) = a_muts(i,j)-a_p(i,k,j)*(0.5*qf1/rdnw(k)/qf2)
1227 a_qf1 = a_qf1-a_p(i,k,j)*(0.5*muts(i,j)/rdnw(k)/qf2)
1228 a_qf2 = a_qf2+a_p(i,k,j)*(0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/(qf2*qf2))
1229 a_p(i,k,j) = 0.
1230 end do
1231 end do
1232 endif
1233 endif
1234
1235 end subroutine a_calc_p_rho_phi
1236
1237
1238 subroutine a_calc_php( a_php, a_ph, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1239 !******************************************************************
1240 !******************************************************************
1241 !** This routine was generated by Automatic differentiation. **
1242 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1243 !******************************************************************
1244 !******************************************************************
1245 !==============================================
1246 ! all entries are defined explicitly
1247 !==============================================
1248 implicit none
1249
1250 !==============================================
1251 ! declare arguments
1252 !==============================================
1253 integer, intent(in) :: ime
1254 integer, intent(in) :: ims
1255 integer, intent(in) :: jme
1256 integer, intent(in) :: jms
1257 integer, intent(in) :: kme
1258 integer, intent(in) :: kms
1259 real, intent(inout) :: a_ph(ims:ime,kms:kme,jms:jme)
1260 real, intent(inout) :: a_php(ims:ime,kms:kme,jms:jme)
1261 integer, intent(in) :: ide
1262 integer, intent(in) :: ite
1263 integer, intent(in) :: its
1264 integer, intent(in) :: jde
1265 integer, intent(in) :: jte
1266 integer, intent(in) :: jts
1267 integer, intent(in) :: kde
1268 integer, intent(in) :: kte
1269 integer, intent(in) :: kts
1270
1271 !==============================================
1272 ! declare local variables
1273 !==============================================
1274 integer i
1275 integer itf
1276 integer j
1277 integer jtf
1278 integer k
1279 integer ktf
1280
1281 !----------------------------------------------
1282 ! ROUTINE BODY
1283 !----------------------------------------------
1284 itf = min(ite,ide-1)
1285 ! recompute : itf
1286 jtf = min(jte,jde-1)
1287 ! recompute : jtf
1288 ktf = min(kte,kde-1)
1289 ! recompute : ktf
1290 do j = jts, jtf
1291 do k = kts, ktf
1292 do i = its, itf
1293 a_ph(i,k+1,j) = a_ph(i,k+1,j)+0.5*a_php(i,k,j)
1294 a_ph(i,k,j) = a_ph(i,k,j)+0.5*a_php(i,k,j)
1295 a_php(i,k,j) = 0.
1296 end do
1297 end do
1298 end do
1299
1300 end subroutine a_calc_php
1301
1302
1303 subroutine a_calc_ww_cp( u, a_u, v, a_v, mup, a_mup, mub, a_ww, rdx, rdy, msft, msfu, msfv, dnw, ide, jde, kde, ims, ime, jms, jme,&
1304 & kms, kme, its, ite, jts, jte, kts, kte )
1305 !******************************************************************
1306 !******************************************************************
1307 !** This routine was generated by Automatic differentiation. **
1308 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1309 !******************************************************************
1310 !******************************************************************
1311 !==============================================
1312 ! all entries are defined explicitly
1313 !==============================================
1314 implicit none
1315
1316 !==============================================
1317 ! declare arguments
1318 !==============================================
1319 integer, intent(in) :: ime
1320 integer, intent(in) :: ims
1321 integer, intent(in) :: jme
1322 integer, intent(in) :: jms
1323 real, intent(inout) :: a_mup(ims:ime,jms:jme)
1324 integer, intent(in) :: kme
1325 integer, intent(in) :: kms
1326 real, intent(inout) :: a_u(ims:ime,kms:kme,jms:jme)
1327 real, intent(inout) :: a_v(ims:ime,kms:kme,jms:jme)
1328 real, intent(inout) :: a_ww(ims:ime,kms:kme,jms:jme)
1329 real, intent(in) :: dnw(kms:kme)
1330 integer, intent(in) :: ide
1331 integer, intent(in) :: ite
1332 integer, intent(in) :: its
1333 integer, intent(in) :: jde
1334 integer, intent(in) :: jte
1335 integer, intent(in) :: jts
1336 integer, intent(in) :: kde
1337 integer, intent(in) :: kte
1338 integer, intent(in) :: kts
1339 real, intent(in) :: msft(ims:ime,jms:jme)
1340 real, intent(in) :: msfu(ims:ime,jms:jme)
1341 real, intent(in) :: msfv(ims:ime,jms:jme)
1342 real, intent(in) :: mub(ims:ime,jms:jme)
1343 real, intent(in) :: mup(ims:ime,jms:jme)
1344 real, intent(in) :: rdx
1345 real, intent(in) :: rdy
1346 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
1347 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
1348
1349 !==============================================
1350 ! declare local variables
1351 !==============================================
1352 real a_divv(its:ite,kts:kte)
1353 real a_dmdt(its:ite)
1354 real a_muu(its:ite+1,jts:jte+1)
1355 real a_muv(its:ite+1,jts:jte+1)
1356 integer i
1357 integer itf
1358 integer j
1359 integer jtf
1360 integer k
1361 integer ktf
1362 real muu(its:ite+1,jts:jte+1)
1363 real muv(its:ite+1,jts:jte+1)
1364
1365 !----------------------------------------------
1366 ! RESET LOCAL ADJOINT VARIABLES
1367 !----------------------------------------------
1368 a_divv(:,:) = 0.
1369 a_dmdt(:) = 0.
1370 a_muu(:,:) = 0.
1371 a_muv(:,:) = 0.
1372
1373 !----------------------------------------------
1374 ! ROUTINE BODY
1375 !----------------------------------------------
1376 jtf = min(jte,jde-1)
1377 ! recompute : jtf
1378 ktf = min(kte,kde-1)
1379 ! recompute : ktf
1380 itf = min(ite,ide-1)
1381 ! recompute : itf
1382 do j = jts, jtf
1383 do i = its, min(ite+1,ide)
1384 muu(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i-1,j)+mub(i-1,j))/msfu(i,j)
1385 end do
1386 end do
1387 ! recompute : muu
1388 do j = jts, min(jte+1,jde)
1389 do i = its, itf
1390 muv(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i,j-1)+mub(i,j-1))/msfv(i,j)
1391 end do
1392 end do
1393 ! recompute : muv
1394 do j = jts, jtf
1395 do k = ktf, 2, -1
1396 do i = its, itf
1397 a_divv(i,k-1) = a_divv(i,k-1)-a_ww(i,k,j)
1398 a_dmdt(i) = a_dmdt(i)-a_ww(i,k,j)*dnw(k-1)
1399 a_ww(i,k-1,j) = a_ww(i,k-1,j)+a_ww(i,k,j)
1400 a_ww(i,k,j) = 0.
1401 end do
1402 end do
1403 do k = ktf, kts, -1
1404 do i = its, itf
1405 a_divv(i,k) = a_divv(i,k)+a_dmdt(i)
1406 a_muu(i+1,j) = a_muu(i+1,j)+a_divv(i,k)*msft(i,j)*dnw(k)*rdx*u(i+1,k,j)
1407 a_muu(i,j) = a_muu(i,j)-a_divv(i,k)*msft(i,j)*dnw(k)*rdx*u(i,k,j)
1408 a_muv(i,j+1) = a_muv(i,j+1)+a_divv(i,k)*msft(i,j)*dnw(k)*rdy*v(i,k,j+1)
1409 a_muv(i,j) = a_muv(i,j)-a_divv(i,k)*msft(i,j)*dnw(k)*rdy*v(i,k,j)
1410 a_u(i+1,k,j) = a_u(i+1,k,j)+a_divv(i,k)*msft(i,j)*dnw(k)*rdx*muu(i+1,j)
1411 a_u(i,k,j) = a_u(i,k,j)-a_divv(i,k)*msft(i,j)*dnw(k)*rdx*muu(i,j)
1412 a_v(i,k,j+1) = a_v(i,k,j+1)+a_divv(i,k)*msft(i,j)*dnw(k)*rdy*muv(i,j+1)
1413 a_v(i,k,j) = a_v(i,k,j)-a_divv(i,k)*msft(i,j)*dnw(k)*rdy*muv(i,j)
1414 a_divv(i,k) = 0.
1415 end do
1416 end do
1417 do i = its, ite
1418 a_ww(i,kte,j) = 0.
1419 a_ww(i,1,j) = 0.
1420 a_dmdt(i) = 0.
1421 end do
1422 end do
1423 do j = jts, min(jte+1,jde)
1424 do i = its, itf
1425 a_mup(i,j-1) = a_mup(i,j-1)+a_muv(i,j)*(0.5/msfv(i,j))
1426 a_mup(i,j) = a_mup(i,j)+a_muv(i,j)*(0.5/msfv(i,j))
1427 a_muv(i,j) = 0.
1428 end do
1429 end do
1430 do j = jts, jtf
1431 do i = its, min(ite+1,ide)
1432 a_mup(i-1,j) = a_mup(i-1,j)+a_muu(i,j)*(0.5/msfu(i,j))
1433 a_mup(i,j) = a_mup(i,j)+a_muu(i,j)*(0.5/msfu(i,j))
1434 a_muu(i,j) = 0.
1435 end do
1436 end do
1437
1438 end subroutine a_calc_ww_cp
1439
1440
1441 subroutine a_calculate_full( a_rfield, a_rfieldp, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1442 !******************************************************************
1443 !******************************************************************
1444 !** This routine was generated by Automatic differentiation. **
1445 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1446 !******************************************************************
1447 !******************************************************************
1448 !==============================================
1449 ! all entries are defined explicitly
1450 !==============================================
1451 implicit none
1452
1453 !==============================================
1454 ! declare arguments
1455 !==============================================
1456 integer, intent(in) :: ime
1457 integer, intent(in) :: ims
1458 integer, intent(in) :: jme
1459 integer, intent(in) :: jms
1460 integer, intent(in) :: kme
1461 integer, intent(in) :: kms
1462 real, intent(inout) :: a_rfield(ims:ime,kms:kme,jms:jme)
1463 real, intent(inout) :: a_rfieldp(ims:ime,kms:kme,jms:jme)
1464 integer, intent(in) :: ide
1465 integer, intent(in) :: ite
1466 integer, intent(in) :: its
1467 integer, intent(in) :: jde
1468 integer, intent(in) :: jte
1469 integer, intent(in) :: jts
1470 integer, intent(in) :: kde
1471 integer, intent(in) :: kte
1472 integer, intent(in) :: kts
1473
1474 !==============================================
1475 ! declare local variables
1476 !==============================================
1477 integer i
1478 integer itf
1479 integer j
1480 integer jtf
1481 integer k
1482 integer ktf
1483
1484 !----------------------------------------------
1485 ! ROUTINE BODY
1486 !----------------------------------------------
1487 itf = min(ite,ide-1)
1488 ! recompute : itf
1489 jtf = min(jte,jde-1)
1490 ! recompute : jtf
1491 ktf = min(kte,kde-1)
1492 ! recompute : ktf
1493 do j = jts, jtf
1494 do k = kts, ktf
1495 do i = its, itf
1496 a_rfieldp(i,k,j) = a_rfieldp(i,k,j)+a_rfield(i,k,j)
1497 a_rfield(i,k,j) = 0.
1498 end do
1499 end do
1500 end do
1501
1502 end subroutine a_calculate_full
1503
1504
1505 subroutine a_coriolis( a_ru, a_rv, a_rw, a_ru_tend, a_rv_tend, a_rw_tend, config_flags, f, e, sina, cosa, fzm, fzp, ids, ide, jds, &
1506 &jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1507 !******************************************************************
1508 !******************************************************************
1509 !** This routine was generated by Automatic differentiation. **
1510 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1511 !******************************************************************
1512 !******************************************************************
1513 !==============================================
1514 ! all entries are defined explicitly
1515 !==============================================
1516 implicit none
1517
1518 !==============================================
1519 ! declare arguments
1520 !==============================================
1521 integer, intent(in) :: ime
1522 integer, intent(in) :: ims
1523 integer, intent(in) :: jme
1524 integer, intent(in) :: jms
1525 integer, intent(in) :: kme
1526 integer, intent(in) :: kms
1527 real, intent(inout) :: a_ru(ims:ime,kms:kme,jms:jme)
1528 real, intent(inout) :: a_ru_tend(ims:ime,kms:kme,jms:jme)
1529 real, intent(inout) :: a_rv(ims:ime,kms:kme,jms:jme)
1530 real, intent(inout) :: a_rv_tend(ims:ime,kms:kme,jms:jme)
1531 real, intent(inout) :: a_rw(ims:ime,kms:kme,jms:jme)
1532 real, intent(inout) :: a_rw_tend(ims:ime,kms:kme,jms:jme)
1533 type (grid_config_rec_type), intent(in) :: config_flags
1534 real, intent(in) :: cosa(ims:ime,jms:jme)
1535 real, intent(in) :: e(ims:ime,jms:jme)
1536 real, intent(in) :: f(ims:ime,jms:jme)
1537 real, intent(in) :: fzm(kms:kme)
1538 real, intent(in) :: fzp(kms:kme)
1539 integer, intent(in) :: ide
1540 integer, intent(in) :: ids
1541 integer, intent(in) :: ite
1542 integer, intent(in) :: its
1543 integer, intent(in) :: jde
1544 integer, intent(in) :: jds
1545 integer, intent(in) :: jte
1546 integer, intent(in) :: jts
1547 integer, intent(in) :: kde
1548 integer, intent(in) :: kte
1549 integer, intent(in) :: kts
1550 real, intent(in) :: sina(ims:ime,jms:jme)
1551
1552 !==============================================
1553 ! declare local variables
1554 !==============================================
1555 integer i
1556 integer i_end
1557 integer i_start
1558 integer j
1559 integer j_end
1560 integer j_start
1561 integer k
1562 integer ktf
1563 logical specified
1564
1565 !----------------------------------------------
1566 ! ROUTINE BODY
1567 !----------------------------------------------
1568 specified = .false.
1569 ! recompute : specified
1570 if (config_flags%specified .or. config_flags%nested) then
1571 specified = .true.
1572 endif
1573 ! recompute : specified
1574 ktf = min(kte,kde-1)
1575 ! recompute : ktf
1576 i_start = its
1577 ! recompute : i_start
1578 i_end = ite
1579 ! recompute : i_end
1580 if (config_flags%open_xs .or. specified .or. config_flags%nested) then
1581 i_start = max(ids+1,its)
1582 endif
1583 ! recompute : i_start
1584 if (config_flags%open_xe .or. specified .or. config_flags%nested) then
1585 i_end = min(ide-1,ite)
1586 endif
1587 ! recompute : i_end
1588 j_start = jts
1589 ! recompute : j_start
1590 j_end = jte
1591 ! recompute : j_end
1592 if (config_flags%open_ys .or. specified .or. config_flags%nested) then
1593 j_start = max(jds+1,jts)
1594 endif
1595 ! recompute : j_start
1596 if (config_flags%open_ye .or. specified .or. config_flags%nested) then
1597 j_end = min(jde-1,jte)
1598 endif
1599 ! recompute : j_end
1600 do j = jts, min(jte,jde-1)
1601 do k = kts+1, ktf
1602 do i = its, min(ite,ide-1)
1603 a_ru(i+1,k-1,j) = a_ru(i+1,k-1,j)+0.5*a_rw_tend(i,k,j)*e(i,j)*cosa(i,j)*fzp(k)
1604 a_ru(i,k-1,j) = a_ru(i,k-1,j)+0.5*a_rw_tend(i,k,j)*e(i,j)*cosa(i,j)*fzp(k)
1605 a_ru(i+1,k,j) = a_ru(i+1,k,j)+0.5*a_rw_tend(i,k,j)*e(i,j)*cosa(i,j)*fzm(k)
1606 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_rw_tend(i,k,j)*e(i,j)*cosa(i,j)*fzm(k)
1607 a_rv(i,k-1,j+1) = a_rv(i,k-1,j+1)-0.5*a_rw_tend(i,k,j)*e(i,j)*sina(i,j)*fzp(k)
1608 a_rv(i,k-1,j) = a_rv(i,k-1,j)-0.5*a_rw_tend(i,k,j)*e(i,j)*sina(i,j)*fzp(k)
1609 a_rv(i,k,j+1) = a_rv(i,k,j+1)-0.5*a_rw_tend(i,k,j)*e(i,j)*sina(i,j)*fzm(k)
1610 a_rv(i,k,j) = a_rv(i,k,j)-0.5*a_rw_tend(i,k,j)*e(i,j)*sina(i,j)*fzm(k)
1611 end do
1612 end do
1613 end do
1614 if (config_flags%open_ye .and. jte .eq. jde) then
1615 do k = kts, ktf
1616 do i = its, min(ide-1,ite)
1617 a_ru(i+1,k,jte-1) = a_ru(i+1,k,jte-1)-0.5*a_rv_tend(i,k,jte)*f(i,jte-1)
1618 a_ru(i,k,jte-1) = a_ru(i,k,jte-1)-0.5*a_rv_tend(i,k,jte)*f(i,jte-1)
1619 a_rw(i,k+1,jte-1) = a_rw(i,k+1,jte-1)+0.5*a_rv_tend(i,k,jte)*e(i,jte-1)*sina(i,jte-1)
1620 a_rw(i,k,jte-1) = a_rw(i,k,jte-1)+0.5*a_rv_tend(i,k,jte)*e(i,jte-1)*sina(i,jte-1)
1621 end do
1622 end do
1623 endif
1624 do j = j_start, j_end
1625 do k = kts, ktf
1626 do i = its, min(ide-1,ite)
1627 a_ru(i+1,k,j-1) = a_ru(i+1,k,j-1)-0.125*a_rv_tend(i,k,j)*(f(i,j)+f(i,j-1))
1628 a_ru(i,k,j-1) = a_ru(i,k,j-1)-0.125*a_rv_tend(i,k,j)*(f(i,j)+f(i,j-1))
1629 a_ru(i+1,k,j) = a_ru(i+1,k,j)-0.125*a_rv_tend(i,k,j)*(f(i,j)+f(i,j-1))
1630 a_ru(i,k,j) = a_ru(i,k,j)-0.125*a_rv_tend(i,k,j)*(f(i,j)+f(i,j-1))
1631 a_rw(i,k+1,j-1) = a_rw(i,k+1,j-1)+0.0625*a_rv_tend(i,k,j)*(e(i,j)+e(i,j-1))*(sina(i,j)+sina(i,j-1))
1632 a_rw(i,k+1,j) = a_rw(i,k+1,j)+0.0625*a_rv_tend(i,k,j)*(e(i,j)+e(i,j-1))*(sina(i,j)+sina(i,j-1))
1633 a_rw(i,k,j-1) = a_rw(i,k,j-1)+0.0625*a_rv_tend(i,k,j)*(e(i,j)+e(i,j-1))*(sina(i,j)+sina(i,j-1))
1634 a_rw(i,k,j) = a_rw(i,k,j)+0.0625*a_rv_tend(i,k,j)*(e(i,j)+e(i,j-1))*(sina(i,j)+sina(i,j-1))
1635 end do
1636 end do
1637 end do
1638 if (config_flags%open_ys .and. jts .eq. jds) then
1639 do k = kts, ktf
1640 do i = its, min(ide-1,ite)
1641 a_ru(i+1,k,jts) = a_ru(i+1,k,jts)-0.5*a_rv_tend(i,k,jts)*f(i,jts)
1642 a_ru(i,k,jts) = a_ru(i,k,jts)-0.5*a_rv_tend(i,k,jts)*f(i,jts)
1643 a_rw(i,k+1,jts) = a_rw(i,k+1,jts)+0.5*a_rv_tend(i,k,jts)*e(i,jts)*sina(i,jts)
1644 a_rw(i,k,jts) = a_rw(i,k,jts)+0.5*a_rv_tend(i,k,jts)*e(i,jts)*sina(i,jts)
1645 end do
1646 end do
1647 endif
1648 do j = jts, min(jte,jde-1)
1649 if (config_flags%open_xe .and. ite .eq. ide) then
1650 do k = kts, ktf
1651 a_rv(ite-1,k,j+1) = a_rv(ite-1,k,j+1)+0.5*a_ru_tend(ite,k,j)*f(ite-1,j)
1652 a_rv(ite-1,k,j) = a_rv(ite-1,k,j)+0.5*a_ru_tend(ite,k,j)*f(ite-1,j)
1653 a_rw(ite-1,k+1,j) = a_rw(ite-1,k+1,j)-0.5*a_ru_tend(ite,k,j)*e(ite-1,j)*cosa(ite-1,j)
1654 a_rw(ite-1,k,j) = a_rw(ite-1,k,j)-0.5*a_ru_tend(ite,k,j)*e(ite-1,j)*cosa(ite-1,j)
1655 end do
1656 endif
1657 if (config_flags%open_xs .and. its .eq. ids) then
1658 do k = kts, ktf
1659 a_rv(its,k,j+1) = a_rv(its,k,j+1)+0.5*a_ru_tend(its,k,j)*f(its,j)
1660 a_rv(its,k,j) = a_rv(its,k,j)+0.5*a_ru_tend(its,k,j)*f(its,j)
1661 a_rw(its,k+1,j) = a_rw(its,k+1,j)-0.5*a_ru_tend(its,k,j)*e(its,j)*cosa(its,j)
1662 a_rw(its,k,j) = a_rw(its,k,j)-0.5*a_ru_tend(its,k,j)*e(its,j)*cosa(its,j)
1663 end do
1664 endif
1665 do k = kts, ktf
1666 do i = i_start, i_end
1667 a_rv(i-1,k,j+1) = a_rv(i-1,k,j+1)+0.125*a_ru_tend(i,k,j)*(f(i,j)+f(i-1,j))
1668 a_rv(i,k,j+1) = a_rv(i,k,j+1)+0.125*a_ru_tend(i,k,j)*(f(i,j)+f(i-1,j))
1669 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.125*a_ru_tend(i,k,j)*(f(i,j)+f(i-1,j))
1670 a_rv(i,k,j) = a_rv(i,k,j)+0.125*a_ru_tend(i,k,j)*(f(i,j)+f(i-1,j))
1671 a_rw(i-1,k+1,j) = a_rw(i-1,k+1,j)-0.0625*a_ru_tend(i,k,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+cosa(i-1,j))
1672 a_rw(i,k+1,j) = a_rw(i,k+1,j)-0.0625*a_ru_tend(i,k,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+cosa(i-1,j))
1673 a_rw(i-1,k,j) = a_rw(i-1,k,j)-0.0625*a_ru_tend(i,k,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+cosa(i-1,j))
1674 a_rw(i,k,j) = a_rw(i,k,j)-0.0625*a_ru_tend(i,k,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+cosa(i-1,j))
1675 end do
1676 end do
1677 end do
1678
1679 end subroutine a_coriolis
1680
1681
1682 subroutine a_couple_momentum( muu, a_muu, a_ru, u, a_u, msfu, muv, a_muv, a_rv, v, a_v, msfv, mut, a_mut, a_rw, w, a_w, msft, ide, &
1683 &jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1684 !******************************************************************
1685 !******************************************************************
1686 !** This routine was generated by Automatic differentiation. **
1687 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1688 !******************************************************************
1689 !******************************************************************
1690 !==============================================
1691 ! all entries are defined explicitly
1692 !==============================================
1693 implicit none
1694
1695 !==============================================
1696 ! declare arguments
1697 !==============================================
1698 integer, intent(in) :: ime
1699 integer, intent(in) :: ims
1700 integer, intent(in) :: jme
1701 integer, intent(in) :: jms
1702 real, intent(inout) :: a_mut(ims:ime,jms:jme)
1703 real, intent(inout) :: a_muu(ims:ime,jms:jme)
1704 real, intent(inout) :: a_muv(ims:ime,jms:jme)
1705 integer, intent(in) :: kme
1706 integer, intent(in) :: kms
1707 real, intent(inout) :: a_ru(ims:ime,kms:kme,jms:jme)
1708 real, intent(inout) :: a_rv(ims:ime,kms:kme,jms:jme)
1709 real, intent(inout) :: a_rw(ims:ime,kms:kme,jms:jme)
1710 real, intent(inout) :: a_u(ims:ime,kms:kme,jms:jme)
1711 real, intent(inout) :: a_v(ims:ime,kms:kme,jms:jme)
1712 real, intent(inout) :: a_w(ims:ime,kms:kme,jms:jme)
1713 integer, intent(in) :: ide
1714 integer, intent(in) :: ite
1715 integer, intent(in) :: its
1716 integer, intent(in) :: jde
1717 integer, intent(in) :: jte
1718 integer, intent(in) :: jts
1719 integer, intent(in) :: kde
1720 integer, intent(in) :: kte
1721 integer, intent(in) :: kts
1722 real, intent(in) :: msft(ims:ime,jms:jme)
1723 real, intent(in) :: msfu(ims:ime,jms:jme)
1724 real, intent(in) :: msfv(ims:ime,jms:jme)
1725 real, intent(in) :: mut(ims:ime,jms:jme)
1726 real, intent(in) :: muu(ims:ime,jms:jme)
1727 real, intent(in) :: muv(ims:ime,jms:jme)
1728 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
1729 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
1730 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
1731
1732 !==============================================
1733 ! declare local variables
1734 !==============================================
1735 integer i
1736 integer itf
1737 integer j
1738 integer jtf
1739 integer k
1740 integer ktf
1741
1742 !----------------------------------------------
1743 ! ROUTINE BODY
1744 !----------------------------------------------
1745 ktf = min(kte,kde-1)
1746 ! recompute : ktf
1747 itf = min(ite,ide-1)
1748 ! recompute : itf
1749 jtf = min(jte,jde-1)
1750 ! recompute : jtf
1751 do j = jts, jtf
1752 do k = kts, kte
1753 do i = its, itf
1754 a_mut(i,j) = a_mut(i,j)+a_rw(i,k,j)*(w(i,k,j)/msft(i,j))
1755 a_w(i,k,j) = a_w(i,k,j)+a_rw(i,k,j)*(mut(i,j)/msft(i,j))
1756 a_rw(i,k,j) = 0.
1757 end do
1758 end do
1759 end do
1760 ! recdepend vars : ide,ite
1761 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:359
1762 ! recompute vars : itf
1763 itf = min(ite,ide-1)
1764 ! recompute vars : itf
1765 ! recdepend vars : itf,jte
1766 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:360
1767 ! recompute vars : jtf
1768 jtf = jte
1769 ! recompute vars : jtf
1770 do j = jts, jtf
1771 do k = kts, ktf
1772 do i = its, itf
1773 a_muv(i,j) = a_muv(i,j)+a_rv(i,k,j)*(v(i,k,j)/msfv(i,j))
1774 a_v(i,k,j) = a_v(i,k,j)+a_rv(i,k,j)*(muv(i,j)/msfv(i,j))
1775 a_rv(i,k,j) = 0.
1776 end do
1777 end do
1778 end do
1779 ! recdepend vars : ite
1780 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:348
1781 ! recompute vars : itf
1782 itf = ite
1783 ! recompute vars : itf
1784 ! recdepend vars : itf,jde,jte
1785 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:349
1786 ! recompute vars : jtf
1787 jtf = min(jte,jde-1)
1788 ! recompute vars : jtf
1789 do j = jts, jtf
1790 do k = kts, ktf
1791 do i = its, itf
1792 a_muu(i,j) = a_muu(i,j)+a_ru(i,k,j)*(u(i,k,j)/msfu(i,j))
1793 a_u(i,k,j) = a_u(i,k,j)+a_ru(i,k,j)*(muu(i,j)/msfu(i,j))
1794 a_ru(i,k,j) = 0.
1795 end do
1796 end do
1797 end do
1798
1799 end subroutine a_couple_momentum
1800
1801
1802 subroutine a_curvature( ru, a_ru, rv, a_rv, rw, a_rw, u, a_u, v, a_v, a_ru_tend, a_rv_tend, a_rw_tend, config_flags, msfu, msfv, &
1803 &fzm, fzp, rdx, rdy, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1804 !******************************************************************
1805 !******************************************************************
1806 !** This routine was generated by Automatic differentiation. **
1807 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1808 !******************************************************************
1809 !******************************************************************
1810 !==============================================
1811 ! all entries are defined explicitly
1812 !==============================================
1813 implicit none
1814
1815 !==============================================
1816 ! declare arguments
1817 !==============================================
1818 integer, intent(in) :: ime
1819 integer, intent(in) :: ims
1820 integer, intent(in) :: jme
1821 integer, intent(in) :: jms
1822 integer, intent(in) :: kme
1823 integer, intent(in) :: kms
1824 real, intent(inout) :: a_ru(ims:ime,kms:kme,jms:jme)
1825 real, intent(inout) :: a_ru_tend(ims:ime,kms:kme,jms:jme)
1826 real, intent(inout) :: a_rv(ims:ime,kms:kme,jms:jme)
1827 real, intent(inout) :: a_rv_tend(ims:ime,kms:kme,jms:jme)
1828 real, intent(inout) :: a_rw(ims:ime,kms:kme,jms:jme)
1829 real, intent(inout) :: a_rw_tend(ims:ime,kms:kme,jms:jme)
1830 real, intent(inout) :: a_u(ims:ime,kms:kme,jms:jme)
1831 real, intent(inout) :: a_v(ims:ime,kms:kme,jms:jme)
1832 type (grid_config_rec_type), intent(in) :: config_flags
1833 real, intent(in) :: fzm(kms:kme)
1834 real, intent(in) :: fzp(kms:kme)
1835 integer, intent(in) :: ide
1836 integer, intent(in) :: ids
1837 integer, intent(in) :: ite
1838 integer, intent(in) :: its
1839 integer, intent(in) :: jde
1840 integer, intent(in) :: jds
1841 integer, intent(in) :: jte
1842 integer, intent(in) :: jts
1843 integer, intent(in) :: kde
1844 integer, intent(in) :: kte
1845 integer, intent(in) :: kts
1846 real, intent(in) :: msfu(ims:ime,jms:jme)
1847 real, intent(in) :: msfv(ims:ime,jms:jme)
1848 real, intent(in) :: rdx
1849 real, intent(in) :: rdy
1850 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
1851 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
1852 real, intent(in) :: rw(ims:ime,kms:kme,jms:jme)
1853 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
1854 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
1855
1856 !==============================================
1857 ! declare local variables
1858 !==============================================
1859 real a_vxgm(its-1:ite,kts:kte,jts-1:jte)
1860 integer i
1861 integer i_end
1862 integer i_start
1863 integer j
1864 integer j_end
1865 integer j_start
1866 integer k
1867 integer ktf
1868 logical specified
1869 real vxgm(its-1:ite,kts:kte,jts-1:jte)
1870
1871 !----------------------------------------------
1872 ! RESET LOCAL ADJOINT VARIABLES
1873 !----------------------------------------------
1874 a_vxgm(:,:,:) = 0.
1875
1876 !----------------------------------------------
1877 ! ROUTINE BODY
1878 !----------------------------------------------
1879 specified = .false.
1880 ! recompute : specified
1881 if (config_flags%specified .or. config_flags%nested) then
1882 specified = .true.
1883 endif
1884 ! recompute : specified
1885 ktf = min(kte,kde-1)
1886 ! recompute : ktf
1887 i_start = its-1
1888 ! recompute : i_start
1889 i_end = ite
1890 ! recompute : i_end
1891 j_start = jts-1
1892 ! recompute : j_start
1893 j_end = jte
1894 ! recompute : j_end
1895 if ((config_flags%open_xs .or. specified .or. config_flags%nested) .and. its .eq. ids) then
1896 i_start = its
1897 endif
1898 ! recompute : i_start
1899 if ((config_flags%open_xe .or. specified .or. config_flags%nested) .and. ite .eq. ide) then
1900 i_end = ite-1
1901 endif
1902 ! recompute : i_end
1903 if ((config_flags%open_ys .or. specified .or. config_flags%nested) .and. jts .eq. jds) then
1904 j_start = jts
1905 endif
1906 ! recompute : j_start
1907 if ((config_flags%open_ye .or. specified .or. config_flags%nested) .and. jte .eq. jde) then
1908 j_end = jte-1
1909 endif
1910 ! recompute : j_end
1911 do j = j_start, j_end
1912 do k = kts, ktf
1913 do i = i_start, i_end
1914 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
1915 end do
1916 end do
1917 end do
1918 ! recompute : vxgm
1919 if ((config_flags%open_xs .or. specified .or. config_flags%nested) .and. its .eq. ids) then
1920 do j = jts-1, jte
1921 do k = kts, ktf
1922 vxgm(its-1,k,j) = vxgm(its,k,j)
1923 end do
1924 end do
1925 endif
1926 ! recompute : vxgm
1927 if ((config_flags%open_xe .or. specified .or. config_flags%nested) .and. ite .eq. ide) then
1928 do j = jts-1, jte
1929 do k = kts, ktf
1930 vxgm(ite,k,j) = vxgm(ite-1,k,j)
1931 end do
1932 end do
1933 endif
1934 ! recompute : vxgm
1935 if ((config_flags%open_ys .or. specified .or. config_flags%nested) .and. jts .eq. jds) then
1936 do k = kts, ktf
1937 do i = its-1, ite
1938 vxgm(i,k,jts-1) = vxgm(i,k,jts)
1939 end do
1940 end do
1941 endif
1942 ! recompute : vxgm
1943 if ((config_flags%open_ye .or. specified .or. config_flags%nested) .and. jte .eq. jde) then
1944 do k = kts, ktf
1945 do i = its-1, ite
1946 vxgm(i,k,jte) = vxgm(i,k,jte-1)
1947 end do
1948 end do
1949 endif
1950 ! recompute : vxgm
1951 i_start = its
1952 ! recompute : i_start
1953 if (config_flags%open_xs .or. specified .or. config_flags%nested) then
1954 i_start = max(ids+1,its)
1955 endif
1956 ! recompute : i_start
1957 if (config_flags%open_xe .or. specified .or. config_flags%nested) then
1958 i_end = min(ide-1,ite)
1959 endif
1960 ! recompute : i_end
1961 j_start = jts
1962 ! recompute : j_start
1963 if (config_flags%open_ys .or. specified .or. config_flags%nested) then
1964 j_start = max(jds+1,jts)
1965 endif
1966 ! recompute : j_start
1967 if (config_flags%open_ye .or. specified .or. config_flags%nested) then
1968 j_end = min(jde-1,jte)
1969 endif
1970 ! recompute : j_end
1971 do j = jts, min(jte,jde-1)
1972 do k = max(2,kts), ktf
1973 do i = its, min(ite,ide-1)
1974 a_ru(i+1,k-1,j) = a_ru(i+1,k-1,j)+0.25*a_rw_tend(i,k,j)*reradius*fzp(k)*(fzm(k)*(u(i,k,j)+u(i+1,k,j))+fzp(k)*(u(i,k-1,j)+u(i+&
1975 &1,k-1,j)))
1976 a_ru(i,k-1,j) = a_ru(i,k-1,j)+0.25*a_rw_tend(i,k,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-&
1977 &1,j)))
1978 a_ru(i+1,k,j) = a_ru(i+1,k,j)+0.25*a_rw_tend(i,k,j)*reradius*fzm(k)*(fzm(k)*(u(i,k,j)+u(i+1,k,j))+fzp(k)*(u(i,k-1,j)+u(i+1,k-&
1979 &1,j)))
1980 a_ru(i,k,j) = a_ru(i,k,j)+0.25*a_rw_tend(i,k,j)*reradius*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)&
1981 &))
1982 a_rv(i,k-1,j+1) = a_rv(i,k-1,j+1)+0.25*a_rw_tend(i,k,j)*reradius*fzp(k)*(fzm(k)*(v(i,k,j)+v(i,k,j+1))+fzp(k)*(v(i,k-1,j)+v(i,&
1983 &k-1,j+1)))
1984 a_rv(i,k-1,j) = a_rv(i,k-1,j)+0.25*a_rw_tend(i,k,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,&
1985 &j+1)))
1986 a_rv(i,k,j+1) = a_rv(i,k,j+1)+0.25*a_rw_tend(i,k,j)*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,&
1987 &j+1)))
1988 a_rv(i,k,j) = a_rv(i,k,j)+0.25*a_rw_tend(i,k,j)*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)&
1989 &))
1990 a_u(i+1,k-1,j) = a_u(i+1,k-1,j)+0.25*a_rw_tend(i,k,j)*reradius*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j))+fzp(k)*(ru(i,k-1,j)+ru(i+1,k-&
1991 &1,j)))*fzp(k)
1992 a_u(i,k-1,j) = a_u(i,k-1,j)+0.25*a_rw_tend(i,k,j)*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))&
1993 &)*fzp(k)
1994 a_u(i+1,k,j) = a_u(i+1,k,j)+0.25*a_rw_tend(i,k,j)*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))&
1995 &)*fzm(k)
1996 a_u(i,k,j) = a_u(i,k,j)+0.25*a_rw_tend(i,k,j)*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)))*&
1997 &fzm(k)
1998 a_v(i,k-1,j+1) = a_v(i,k-1,j+1)+0.25*a_rw_tend(i,k,j)*reradius*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1))+fzp(k)*(rv(i,k-1,j)+rv(i,k-1,&
1999 &j+1)))*fzp(k)
2000 a_v(i,k-1,j) = a_v(i,k-1,j)+0.25*a_rw_tend(i,k,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))&
2001 &)*fzp(k)
2002 a_v(i,k,j+1) = a_v(i,k,j+1)+0.25*a_rw_tend(i,k,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))&
2003 &)*fzm(k)
2004 a_v(i,k,j) = a_v(i,k,j)+0.25*a_rw_tend(i,k,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)))*&
2005 &fzm(k)
2006 end do
2007 end do
2008 end do
2009 do j = j_start, j_end
2010 do k = kts, ktf
2011 do i = its, min(ite,ide-1)
2012 a_ru(i+1,k,j-1) = a_ru(i+1,k,j-1)-0.125*a_rv_tend(i,k,j)*(vxgm(i,k,j)+vxgm(i,k,j-1))
2013 a_ru(i,k,j-1) = a_ru(i,k,j-1)-0.125*a_rv_tend(i,k,j)*(vxgm(i,k,j)+vxgm(i,k,j-1))
2014 a_ru(i+1,k,j) = a_ru(i+1,k,j)-0.125*a_rv_tend(i,k,j)*(vxgm(i,k,j)+vxgm(i,k,j-1))
2015 a_ru(i,k,j) = a_ru(i,k,j)-0.125*a_rv_tend(i,k,j)*(vxgm(i,k,j)+vxgm(i,k,j-1))
2016 a_rw(i,k+1,j-1) = a_rw(i,k+1,j-1)+0.25*a_rv_tend(i,k,j)*v(i,k,j)*reradius
2017 a_rw(i,k+1,j) = a_rw(i,k+1,j)+0.25*a_rv_tend(i,k,j)*v(i,k,j)*reradius
2018 a_rw(i,k,j-1) = a_rw(i,k,j-1)+0.25*a_rv_tend(i,k,j)*v(i,k,j)*reradius
2019 a_rw(i,k,j) = a_rw(i,k,j)+0.25*a_rv_tend(i,k,j)*v(i,k,j)*reradius
2020 a_v(i,k,j) = a_v(i,k,j)+0.25*a_rv_tend(i,k,j)*reradius*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j))
2021 a_vxgm(i,k,j-1) = a_vxgm(i,k,j-1)-0.125*a_rv_tend(i,k,j)*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1))
2022 a_vxgm(i,k,j) = a_vxgm(i,k,j)-0.125*a_rv_tend(i,k,j)*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1))
2023 end do
2024 end do
2025 end do
2026 do j = jts, min(jde-1,jte)
2027 do k = kts, ktf
2028 do i = i_start, i_end
2029 a_rv(i-1,k,j+1) = a_rv(i-1,k,j+1)+0.125*a_ru_tend(i,k,j)*(vxgm(i,k,j)+vxgm(i-1,k,j))
2030 a_rv(i,k,j+1) = a_rv(i,k,j+1)+0.125*a_ru_tend(i,k,j)*(vxgm(i,k,j)+vxgm(i-1,k,j))
2031 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.125*a_ru_tend(i,k,j)*(vxgm(i,k,j)+vxgm(i-1,k,j))
2032 a_rv(i,k,j) = a_rv(i,k,j)+0.125*a_ru_tend(i,k,j)*(vxgm(i,k,j)+vxgm(i-1,k,j))
2033 a_rw(i-1,k+1,j) = a_rw(i-1,k+1,j)-0.25*a_ru_tend(i,k,j)*u(i,k,j)*reradius
2034 a_rw(i,k+1,j) = a_rw(i,k+1,j)-0.25*a_ru_tend(i,k,j)*u(i,k,j)*reradius
2035 a_rw(i-1,k,j) = a_rw(i-1,k,j)-0.25*a_ru_tend(i,k,j)*u(i,k,j)*reradius
2036 a_rw(i,k,j) = a_rw(i,k,j)-0.25*a_ru_tend(i,k,j)*u(i,k,j)*reradius
2037 a_u(i,k,j) = a_u(i,k,j)-0.25*a_ru_tend(i,k,j)*reradius*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j))
2038 a_vxgm(i-1,k,j) = a_vxgm(i-1,k,j)+0.125*a_ru_tend(i,k,j)*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j))
2039 a_vxgm(i,k,j) = a_vxgm(i,k,j)+0.125*a_ru_tend(i,k,j)*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j))
2040 end do
2041 end do
2042 end do
2043 if ((config_flags%open_ye .or. specified .or. config_flags%nested) .and. jte .eq. jde) then
2044 do k = kts, ktf
2045 do i = its-1, ite
2046 a_vxgm(i,k,jte-1) = a_vxgm(i,k,jte-1)+a_vxgm(i,k,jte)
2047 a_vxgm(i,k,jte) = 0.
2048 end do
2049 end do
2050 endif
2051 if ((config_flags%open_ys .or. specified .or. config_flags%nested) .and. jts .eq. jds) then
2052 do k = kts, ktf
2053 do i = its-1, ite
2054 a_vxgm(i,k,jts) = a_vxgm(i,k,jts)+a_vxgm(i,k,jts-1)
2055 a_vxgm(i,k,jts-1) = 0.
2056 end do
2057 end do
2058 endif
2059 if ((config_flags%open_xe .or. specified .or. config_flags%nested) .and. ite .eq. ide) then
2060 do j = jts-1, jte
2061 do k = kts, ktf
2062 a_vxgm(ite-1,k,j) = a_vxgm(ite-1,k,j)+a_vxgm(ite,k,j)
2063 a_vxgm(ite,k,j) = 0.
2064 end do
2065 end do
2066 endif
2067 if ((config_flags%open_xs .or. specified .or. config_flags%nested) .and. its .eq. ids) then
2068 do j = jts-1, jte
2069 do k = kts, ktf
2070 a_vxgm(its,k,j) = a_vxgm(its,k,j)+a_vxgm(its-1,k,j)
2071 a_vxgm(its-1,k,j) = 0.
2072 end do
2073 end do
2074 endif
2075 ! recdepend vars : its
2076 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3594
2077 ! recompute vars : i_start
2078 i_start = its-1
2079 ! recompute vars : i_start
2080 ! recdepend vars : i_start,ite
2081 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3595
2082 ! recompute vars : i_end
2083 i_end = ite
2084 ! recompute vars : i_end
2085 ! recdepend vars : i_end,i_start,jts
2086 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3596
2087 ! recompute vars : j_start
2088 j_start = jts-1
2089 ! recompute vars : j_start
2090 ! recdepend vars : i_end,i_start,j_start,jte
2091 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3597
2092 ! recompute vars : j_end
2093 j_end = jte
2094 ! recompute vars : j_end
2095 ! recdepend vars : config_flags,i_end,i_start,ids,its,j_end,j_start,spe
2096 ! cified
2097 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:3599
2098 ! recompute vars : i_start
2099 if ((config_flags%open_xs .or. specified .or. config_flags%nested) .and. its .eq. ids) then
2100 i_start = its
2101 endif
2102 ! recompute vars : i_start
2103 ! recdepend vars : config_flags,i_end,i_start,ide,ite,j_end,j_start,spe
2104 ! cified
2105 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:3601
2106 ! recompute vars : i_end
2107 if ((config_flags%open_xe .or. specified .or. config_flags%nested) .and. ite .eq. ide) then
2108 i_end = ite-1
2109 endif
2110 ! recompute vars : i_end
2111 ! recdepend vars : config_flags,i_end,i_start,j_end,j_start,jds,jts,spe
2112 ! cified
2113 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:3603
2114 ! recompute vars : j_start
2115 if ((config_flags%open_ys .or. specified .or. config_flags%nested) .and. jts .eq. jds) then
2116 j_start = jts
2117 endif
2118 ! recompute vars : j_start
2119 ! recdepend vars : config_flags,i_end,i_start,j_end,j_start,jde,jte,spe
2120 ! cified
2121 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:3605
2122 ! recompute vars : j_end
2123 if ((config_flags%open_ye .or. specified .or. config_flags%nested) .and. jte .eq. jde) then
2124 j_end = jte-1
2125 endif
2126 ! recompute vars : j_end
2127 do j = j_start, j_end
2128 do k = kts, ktf
2129 do i = i_start, i_end
2130 a_u(i+1,k,j) = a_u(i+1,k,j)+0.5*a_vxgm(i,k,j)*(msfv(i,j+1)-msfv(i,j))*rdy
2131 a_u(i,k,j) = a_u(i,k,j)+0.5*a_vxgm(i,k,j)*(msfv(i,j+1)-msfv(i,j))*rdy
2132 a_v(i,k,j+1) = a_v(i,k,j+1)-0.5*a_vxgm(i,k,j)*(msfu(i+1,j)-msfu(i,j))*rdx
2133 a_v(i,k,j) = a_v(i,k,j)-0.5*a_vxgm(i,k,j)*(msfu(i+1,j)-msfu(i,j))*rdx
2134 a_vxgm(i,k,j) = 0.
2135 end do
2136 end do
2137 end do
2138
2139 end subroutine a_curvature
2140
2141
2142 subroutine a_diagnose_w( ph_tend, a_ph_tend, a_ph_new, a_ph_old, a_w, mu, a_mu, dt, a_u, a_v, ht, cf1, cf2, cf3, rdx, rdy, msft, &
2143 &ide, jde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kte )
2144 !******************************************************************
2145 !******************************************************************
2146 !** This routine was generated by Automatic differentiation. **
2147 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
2148 !******************************************************************
2149 !******************************************************************
2150 !==============================================
2151 ! all entries are defined explicitly
2152 !==============================================
2153 implicit none
2154
2155 !==============================================
2156 ! declare arguments
2157 !==============================================
2158 integer, intent(in) :: ime
2159 integer, intent(in) :: ims
2160 integer, intent(in) :: jme
2161 integer, intent(in) :: jms
2162 real, intent(inout) :: a_mu(ims:ime,jms:jme)
2163 integer, intent(in) :: kme
2164 integer, intent(in) :: kms
2165 real, intent(inout) :: a_ph_new(ims:ime,kms:kme,jms:jme)
2166 real, intent(inout) :: a_ph_old(ims:ime,kms:kme,jms:jme)
2167 real, intent(inout) :: a_ph_tend(ims:ime,kms:kme,jms:jme)
2168 real, intent(inout) :: a_u(ims:ime,kms:kme,jms:jme)
2169 real, intent(inout) :: a_v(ims:ime,kms:kme,jms:jme)
2170 real, intent(inout) :: a_w(ims:ime,kms:kme,jms:jme)
2171 real, intent(in) :: cf1
2172 real, intent(in) :: cf2
2173 real, intent(in) :: cf3
2174 real, intent(in) :: dt
2175 real, intent(in) :: ht(ims:ime,jms:jme)
2176 integer, intent(in) :: ide
2177 integer, intent(in) :: ite
2178 integer, intent(in) :: its
2179 integer, intent(in) :: jde
2180 integer, intent(in) :: jte
2181 integer, intent(in) :: jts
2182 integer, intent(in) :: kte
2183 real, intent(in) :: msft(ims:ime,jms:jme)
2184 real, intent(in) :: mu(ims:ime,jms:jme)
2185 real, intent(in) :: ph_tend(ims:ime,kms:kme,jms:jme)
2186 real, intent(in) :: rdx
2187 real, intent(in) :: rdy
2188
2189 !==============================================
2190 ! declare local variables
2191 !==============================================
2192 integer i
2193 integer itf
2194 integer j
2195 integer jtf
2196 integer k
2197
2198 !----------------------------------------------
2199 ! ROUTINE BODY
2200 !----------------------------------------------
2201 itf = min(ite,ide-1)
2202 ! recompute : itf
2203 jtf = min(jte,jde-1)
2204 ! recompute : jtf
2205 do j = jts, jtf
2206 do k = 2, kte
2207 do i = its, itf
2208 a_mu(i,j) = a_mu(i,j)+a_w(i,k,j)*(msft(i,j)*(ph_tend(i,k,j)/(mu(i,j)*mu(i,j)))/g)
2209 a_ph_new(i,k,j) = a_ph_new(i,k,j)+a_w(i,k,j)*(msft(i,j)/dt/g)
2210 a_ph_old(i,k,j) = a_ph_old(i,k,j)-a_w(i,k,j)*(msft(i,j)/dt/g)
2211 a_ph_tend(i,k,j) = a_ph_tend(i,k,j)-a_w(i,k,j)*(msft(i,j)/mu(i,j)/g)
2212 a_w(i,k,j) = 0.
2213 end do
2214 end do
2215 do i = its, itf
2216 a_u(i+1,3,j) = a_u(i+1,3,j)+0.5*a_w(i,1,j)*msft(i,j)*rdx*(ht(i+1,j)-ht(i,j))*cf3
2217 a_u(i,3,j) = a_u(i,3,j)+0.5*a_w(i,1,j)*msft(i,j)*rdx*(ht(i,j)-ht(i,j-1))*cf3
2218 a_u(i+1,2,j) = a_u(i+1,2,j)+0.5*a_w(i,1,j)*msft(i,j)*rdx*(ht(i+1,j)-ht(i,j))*cf2
2219 a_u(i,2,j) = a_u(i,2,j)+0.5*a_w(i,1,j)*msft(i,j)*rdx*(ht(i,j)-ht(i,j-1))*cf2
2220 a_u(i+1,1,j) = a_u(i+1,1,j)+0.5*a_w(i,1,j)*msft(i,j)*rdx*(ht(i+1,j)-ht(i,j))*cf1
2221 a_u(i,1,j) = a_u(i,1,j)+0.5*a_w(i,1,j)*msft(i,j)*rdx*(ht(i,j)-ht(i,j-1))*cf1
2222 a_v(i,3,j+1) = a_v(i,3,j+1)+0.5*a_w(i,1,j)*msft(i,j)*rdy*(ht(i,j+1)-ht(i,j))*cf3
2223 a_v(i,3,j) = a_v(i,3,j)+0.5*a_w(i,1,j)*msft(i,j)*rdy*(ht(i,j)-ht(i,j-1))*cf3
2224 a_v(i,2,j+1) = a_v(i,2,j+1)+0.5*a_w(i,1,j)*msft(i,j)*rdy*(ht(i,j+1)-ht(i,j))*cf2
2225 a_v(i,2,j) = a_v(i,2,j)+0.5*a_w(i,1,j)*msft(i,j)*rdy*(ht(i,j)-ht(i,j-1))*cf2
2226 a_v(i,1,j+1) = a_v(i,1,j+1)+0.5*a_w(i,1,j)*msft(i,j)*rdy*(ht(i,j+1)-ht(i,j))*cf1
2227 a_v(i,1,j) = a_v(i,1,j)+0.5*a_w(i,1,j)*msft(i,j)*rdy*(ht(i,j)-ht(i,j-1))*cf1
2228 a_w(i,1,j) = 0.
2229 end do
2230 end do
2231
2232 end subroutine a_diagnose_w
2233
2234
2235 subroutine a_horizontal_diffusion( name, field, a_field, a_tendency, mu, a_mu, config_flags, msfu, msfv, msft, xkmhd, a_xkmhd, rdx,&
2236 & rdy, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
2237 !******************************************************************
2238 !******************************************************************
2239 !** This routine was generated by Automatic differentiation. **
2240 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
2241 !******************************************************************
2242 !******************************************************************
2243 !==============================================
2244 ! all entries are defined explicitly
2245 !==============================================
2246 implicit none
2247
2248 !==============================================
2249 ! declare arguments
2250 !==============================================
2251 integer, intent(in) :: ime
2252 integer, intent(in) :: ims
2253 integer, intent(in) :: jme
2254 integer, intent(in) :: jms
2255 integer, intent(in) :: kme
2256 integer, intent(in) :: kms
2257 real, intent(inout) :: a_field(ims:ime,kms:kme,jms:jme)
2258 real, intent(inout) :: a_mu(ims:ime,jms:jme)
2259 real, intent(inout) :: a_tendency(ims:ime,kms:kme,jms:jme)
2260 real, intent(inout) :: a_xkmhd(ims:ime,kms:kme,jms:jme)
2261 type (grid_config_rec_type), intent(in) :: config_flags
2262 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
2263 integer, intent(in) :: ide
2264 integer, intent(in) :: ids
2265 integer, intent(in) :: ite
2266 integer, intent(in) :: its
2267 integer, intent(in) :: jde
2268 integer, intent(in) :: jds
2269 integer, intent(in) :: jte
2270 integer, intent(in) :: jts
2271 integer, intent(in) :: kde
2272 integer, intent(in) :: kte
2273 integer, intent(in) :: kts
2274 real, intent(in) :: msft(ims:ime,jms:jme)
2275 real, intent(in) :: msfu(ims:ime,jms:jme)
2276 real, intent(in) :: msfv(ims:ime,jms:jme)
2277 real, intent(in) :: mu(ims:ime,jms:jme)
2278 character*(1), intent(in) :: name
2279 real, intent(in) :: rdx
2280 real, intent(in) :: rdy
2281 real, intent(in) :: xkmhd(ims:ime,kms:kme,jms:jme)
2282
2283 !==============================================
2284 ! declare local variables
2285 !==============================================
2286 real a_mkrdxm
2287 real a_mkrdxp
2288 real a_mkrdym
2289 real a_mkrdyp
2290 real a_rcoup
2291 integer i
2292 integer i_end
2293 integer i_start
2294 integer j
2295 integer j_end
2296 integer j_start
2297 integer k
2298 integer ktf
2299 real mkrdxm
2300 real mkrdxp
2301 real mkrdym
2302 real mkrdyp
2303 real mrdx
2304 real mrdy
2305 real :: pr = 3.
2306 real rcoup
2307 logical specified
2308
2309 !----------------------------------------------
2310 ! RESET LOCAL ADJOINT VARIABLES
2311 !----------------------------------------------
2312 a_mkrdxm = 0.
2313 a_mkrdxp = 0.
2314 a_mkrdym = 0.
2315 a_mkrdyp = 0.
2316 a_rcoup = 0.
2317
2318 !----------------------------------------------
2319 ! ROUTINE BODY
2320 !----------------------------------------------
2321 specified = .false.
2322 ! recompute : specified
2323 if (config_flags%specified .or. config_flags%nested) then
2324 specified = .true.
2325 endif
2326 ! recompute : specified
2327 ktf = min(kte,kde-1)
2328 ! recompute : ktf
2329 if (name .eq. 'u') then
2330 i_start = its
2331 ! recompute : i_start
2332 i_end = ite
2333 ! recompute : i_end
2334 j_start = jts
2335 ! recompute : j_start
2336 j_end = min(jte,jde-1)
2337 ! recompute : j_end
2338 if (config_flags%open_xs .or. specified) then
2339 i_start = max(ids+1,its)
2340 endif
2341 ! recompute : i_start
2342 if (config_flags%open_xe .or. specified) then
2343 i_end = min(ide-1,ite)
2344 endif
2345 ! recompute : i_end
2346 if (config_flags%open_ys .or. specified) then
2347 j_start = max(jds+1,jts)
2348 endif
2349 ! recompute : j_start
2350 if (config_flags%open_ye .or. specified) then
2351 j_end = min(jde-2,jte)
2352 endif
2353 ! recompute : j_end
2354 do j = j_start, j_end
2355 a_mkrdxm = 0.
2356 a_mkrdxp = 0.
2357 a_mkrdym = 0.
2358 a_mkrdyp = 0.
2359 a_rcoup = 0.
2360 do k = kts, ktf
2361 a_mkrdxm = 0.
2362 a_mkrdxp = 0.
2363 a_mkrdym = 0.
2364 a_mkrdyp = 0.
2365 a_rcoup = 0.
2366 do i = i_start, i_end
2367 a_mkrdxm = 0.
2368 a_mkrdxp = 0.
2369 a_mkrdym = 0.
2370 a_mkrdyp = 0.
2371 a_rcoup = 0.
2372 mkrdxm = msft(i-1,j)*xkmhd(i-1,k,j)*rdx
2373 ! recompute : mkrdxm
2374 mkrdxp = msft(i,j)*xkmhd(i,k,j)*rdx
2375 ! recompute : mkrdxp
2376 mrdx = msfu(i,j)*rdx
2377 ! recompute : mrdx
2378 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
2379 ! recompute : mkrdym
2380 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
2381 ! recompute : mkrdyp
2382 mrdy = msfu(i,j)*rdy
2383 ! recompute : mrdy
2384 rcoup = 0.5*(mu(i,j)+mu(i-1,j))
2385 ! recompute : rcoup
2386 a_field(i,k,j-1) = a_field(i,k,j-1)+a_tendency(i,k,j)*rcoup*mrdy*mkrdym
2387 a_field(i,k,j+1) = a_field(i,k,j+1)+a_tendency(i,k,j)*rcoup*mrdy*mkrdyp
2388 a_field(i-1,k,j) = a_field(i-1,k,j)+a_tendency(i,k,j)*rcoup*mrdx*mkrdxm
2389 a_field(i+1,k,j) = a_field(i+1,k,j)+a_tendency(i,k,j)*rcoup*mrdx*mkrdxp
2390 a_field(i,k,j) = a_field(i,k,j)+a_tendency(i,k,j)*rcoup*((-(mrdx*(mkrdxp+mkrdxm)))-mrdy*(mkrdyp+mkrdym))
2391 a_mkrdxm = a_mkrdxm-a_tendency(i,k,j)*rcoup*mrdx*(field(i,k,j)-field(i-1,k,j))
2392 a_mkrdxp = a_mkrdxp+a_tendency(i,k,j)*rcoup*mrdx*(field(i+1,k,j)-field(i,k,j))
2393 a_mkrdym = a_mkrdym-a_tendency(i,k,j)*rcoup*mrdy*(field(i,k,j)-field(i,k,j-1))
2394 a_mkrdyp = a_mkrdyp+a_tendency(i,k,j)*rcoup*mrdy*(field(i,k,j+1)-field(i,k,j))
2395 a_rcoup = a_rcoup+a_tendency(i,k,j)*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j))-mkrdxm*(field(i,k,j)-field(i-1,k,j)))+mrdy*&
2396 &(mkrdyp*(field(i,k,j+1)-field(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1))))
2397 a_mu(i-1,j) = a_mu(i-1,j)+0.5*a_rcoup
2398 a_mu(i,j) = a_mu(i,j)+0.5*a_rcoup
2399 a_rcoup = 0.
2400 a_xkmhd(i-1,k,j+1) = a_xkmhd(i-1,k,j+1)+0.125*a_mkrdyp*(msfu(i,j)+msfu(i,j+1))*rdy
2401 a_xkmhd(i,k,j+1) = a_xkmhd(i,k,j+1)+0.125*a_mkrdyp*(msfu(i,j)+msfu(i,j+1))*rdy
2402 a_xkmhd(i-1,k,j) = a_xkmhd(i-1,k,j)+0.125*a_mkrdyp*(msfu(i,j)+msfu(i,j+1))*rdy
2403 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.125*a_mkrdyp*(msfu(i,j)+msfu(i,j+1))*rdy
2404 a_mkrdyp = 0.
2405 a_xkmhd(i-1,k,j-1) = a_xkmhd(i-1,k,j-1)+0.125*a_mkrdym*(msfu(i,j)+msfu(i,j-1))*rdy
2406 a_xkmhd(i,k,j-1) = a_xkmhd(i,k,j-1)+0.125*a_mkrdym*(msfu(i,j)+msfu(i,j-1))*rdy
2407 a_xkmhd(i-1,k,j) = a_xkmhd(i-1,k,j)+0.125*a_mkrdym*(msfu(i,j)+msfu(i,j-1))*rdy
2408 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.125*a_mkrdym*(msfu(i,j)+msfu(i,j-1))*rdy
2409 a_mkrdym = 0.
2410 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+a_mkrdxp*msft(i,j)*rdx
2411 a_mkrdxp = 0.
2412 a_xkmhd(i-1,k,j) = a_xkmhd(i-1,k,j)+a_mkrdxm*msft(i-1,j)*rdx
2413 a_mkrdxm = 0.
2414 end do
2415 end do
2416 end do
2417 else if (name .eq. 'v') then
2418 i_start = its
2419 ! recompute : i_start
2420 i_end = min(ite,ide-1)
2421 ! recompute : i_end
2422 j_start = jts
2423 ! recompute : j_start
2424 j_end = jte
2425 ! recompute : j_end
2426 if (config_flags%open_xs .or. specified) then
2427 i_start = max(ids+1,its)
2428 endif
2429 ! recompute : i_start
2430 if (config_flags%open_xe .or. specified) then
2431 i_end = min(ide-2,ite)
2432 endif
2433 ! recompute : i_end
2434 if (config_flags%open_ys .or. specified) then
2435 j_start = max(jds+1,jts)
2436 endif
2437 ! recompute : j_start
2438 if (config_flags%open_ye .or. specified) then
2439 j_end = min(jde-1,jte)
2440 endif
2441 ! recompute : j_end
2442 do j = j_start, j_end
2443 a_mkrdxm = 0.
2444 a_mkrdxp = 0.
2445 a_mkrdym = 0.
2446 a_mkrdyp = 0.
2447 a_rcoup = 0.
2448 do k = kts, ktf
2449 a_mkrdxm = 0.
2450 a_mkrdxp = 0.
2451 a_mkrdym = 0.
2452 a_mkrdyp = 0.
2453 a_rcoup = 0.
2454 do i = i_start, i_end
2455 a_mkrdxm = 0.
2456 a_mkrdxp = 0.
2457 a_mkrdym = 0.
2458 a_mkrdyp = 0.
2459 a_rcoup = 0.
2460 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
2461 ! recompute : mkrdxm
2462 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
2463 ! recompute : mkrdxp
2464 mrdx = msfv(i,j)*rdx
2465 ! recompute : mrdx
2466 mkrdym = msft(i,j-1)*xkmhd(i,k,j-1)*rdy
2467 ! recompute : mkrdym
2468 mkrdyp = msft(i,j)*xkmhd(i,k,j)*rdy
2469 ! recompute : mkrdyp
2470 mrdy = msfv(i,j)*rdy
2471 ! recompute : mrdy
2472 rcoup = 0.5*(mu(i,j)+mu(i,j-1))
2473 ! recompute : rcoup
2474 a_field(i,k,j-1) = a_field(i,k,j-1)+a_tendency(i,k,j)*rcoup*mrdy*mkrdym
2475 a_field(i,k,j+1) = a_field(i,k,j+1)+a_tendency(i,k,j)*rcoup*mrdy*mkrdyp
2476 a_field(i-1,k,j) = a_field(i-1,k,j)+a_tendency(i,k,j)*rcoup*mrdx*mkrdxm
2477 a_field(i+1,k,j) = a_field(i+1,k,j)+a_tendency(i,k,j)*rcoup*mrdx*mkrdxp
2478 a_field(i,k,j) = a_field(i,k,j)+a_tendency(i,k,j)*rcoup*((-(mrdx*(mkrdxp+mkrdxm)))-mrdy*(mkrdyp+mkrdym))
2479 a_mkrdxm = a_mkrdxm-a_tendency(i,k,j)*rcoup*mrdx*(field(i,k,j)-field(i-1,k,j))
2480 a_mkrdxp = a_mkrdxp+a_tendency(i,k,j)*rcoup*mrdx*(field(i+1,k,j)-field(i,k,j))
2481 a_mkrdym = a_mkrdym-a_tendency(i,k,j)*rcoup*mrdy*(field(i,k,j)-field(i,k,j-1))
2482 a_mkrdyp = a_mkrdyp+a_tendency(i,k,j)*rcoup*mrdy*(field(i,k,j+1)-field(i,k,j))
2483 a_rcoup = a_rcoup+a_tendency(i,k,j)*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j))-mkrdxm*(field(i,k,j)-field(i-1,k,j)))+mrdy*&
2484 &(mkrdyp*(field(i,k,j+1)-field(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1))))
2485 a_mu(i,j-1) = a_mu(i,j-1)+0.5*a_rcoup
2486 a_mu(i,j) = a_mu(i,j)+0.5*a_rcoup
2487 a_rcoup = 0.
2488 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+a_mkrdyp*msft(i,j)*rdy
2489 a_mkrdyp = 0.
2490 a_xkmhd(i,k,j-1) = a_xkmhd(i,k,j-1)+a_mkrdym*msft(i,j-1)*rdy
2491 a_mkrdym = 0.
2492 a_xkmhd(i+1,k,j-1) = a_xkmhd(i+1,k,j-1)+0.125*a_mkrdxp*(msfv(i,j)+msfv(i+1,j))*rdx
2493 a_xkmhd(i,k,j-1) = a_xkmhd(i,k,j-1)+0.125*a_mkrdxp*(msfv(i,j)+msfv(i+1,j))*rdx
2494 a_xkmhd(i+1,k,j) = a_xkmhd(i+1,k,j)+0.125*a_mkrdxp*(msfv(i,j)+msfv(i+1,j))*rdx
2495 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.125*a_mkrdxp*(msfv(i,j)+msfv(i+1,j))*rdx
2496 a_mkrdxp = 0.
2497 a_xkmhd(i-1,k,j-1) = a_xkmhd(i-1,k,j-1)+0.125*a_mkrdxm*(msfv(i,j)+msfv(i-1,j))*rdx
2498 a_xkmhd(i,k,j-1) = a_xkmhd(i,k,j-1)+0.125*a_mkrdxm*(msfv(i,j)+msfv(i-1,j))*rdx
2499 a_xkmhd(i-1,k,j) = a_xkmhd(i-1,k,j)+0.125*a_mkrdxm*(msfv(i,j)+msfv(i-1,j))*rdx
2500 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.125*a_mkrdxm*(msfv(i,j)+msfv(i-1,j))*rdx
2501 a_mkrdxm = 0.
2502 end do
2503 end do
2504 end do
2505 else if (name .eq. 'w') then
2506 i_start = its
2507 ! recompute : i_start
2508 i_end = min(ite,ide-1)
2509 ! recompute : i_end
2510 j_start = jts
2511 ! recompute : j_start
2512 j_end = min(jte,jde-1)
2513 ! recompute : j_end
2514 if (config_flags%open_xs .or. specified) then
2515 i_start = max(ids+1,its)
2516 endif
2517 ! recompute : i_start
2518 if (config_flags%open_xe .or. specified) then
2519 i_end = min(ide-2,ite)
2520 endif
2521 ! recompute : i_end
2522 if (config_flags%open_ys .or. specified) then
2523 j_start = max(jds+1,jts)
2524 endif
2525 ! recompute : j_start
2526 if (config_flags%open_ye .or. specified) then
2527 j_end = min(jde-2,jte)
2528 endif
2529 ! recompute : j_end
2530 do j = j_start, j_end
2531 a_mkrdxm = 0.
2532 a_mkrdxp = 0.
2533 a_mkrdym = 0.
2534 a_mkrdyp = 0.
2535 a_rcoup = 0.
2536 do k = kts+1, ktf
2537 a_mkrdxm = 0.
2538 a_mkrdxp = 0.
2539 a_mkrdym = 0.
2540 a_mkrdyp = 0.
2541 a_rcoup = 0.
2542 do i = i_start, i_end
2543 a_mkrdxm = 0.
2544 a_mkrdxp = 0.
2545 a_mkrdym = 0.
2546 a_mkrdyp = 0.
2547 a_rcoup = 0.
2548 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
2549 ! recompute : mkrdxm
2550 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
2551 ! recompute : mkrdxp
2552 mrdx = msft(i,j)*rdx
2553 ! recompute : mrdx
2554 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
2555 ! recompute : mkrdym
2556 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
2557 ! recompute : mkrdyp
2558 mrdy = msft(i,j)*rdy
2559 ! recompute : mrdy
2560 rcoup = 0.5*(mu(i,j)+mu(i,j))
2561 ! recompute : rcoup
2562 a_field(i,k,j-1) = a_field(i,k,j-1)+a_tendency(i,k,j)*rcoup*mrdy*mkrdym
2563 a_field(i,k,j+1) = a_field(i,k,j+1)+a_tendency(i,k,j)*rcoup*mrdy*mkrdyp
2564 a_field(i-1,k,j) = a_field(i-1,k,j)+a_tendency(i,k,j)*rcoup*mrdx*mkrdxm
2565 a_field(i+1,k,j) = a_field(i+1,k,j)+a_tendency(i,k,j)*rcoup*mrdx*mkrdxp
2566 a_field(i,k,j) = a_field(i,k,j)+a_tendency(i,k,j)*rcoup*((-(mrdx*(mkrdxp+mkrdxm)))-mrdy*(mkrdyp+mkrdym))
2567 a_mkrdxm = a_mkrdxm-a_tendency(i,k,j)*rcoup*mrdx*(field(i,k,j)-field(i-1,k,j))
2568 a_mkrdxp = a_mkrdxp+a_tendency(i,k,j)*rcoup*mrdx*(field(i+1,k,j)-field(i,k,j))
2569 a_mkrdym = a_mkrdym-a_tendency(i,k,j)*rcoup*mrdy*(field(i,k,j)-field(i,k,j-1))
2570 a_mkrdyp = a_mkrdyp+a_tendency(i,k,j)*rcoup*mrdy*(field(i,k,j+1)-field(i,k,j))
2571 a_rcoup = a_rcoup+a_tendency(i,k,j)*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j))-mkrdxm*(field(i,k,j)-field(i-1,k,j)))+mrdy*&
2572 &(mkrdyp*(field(i,k,j+1)-field(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1))))
2573 a_mu(i,j) = a_mu(i,j)+a_rcoup
2574 a_rcoup = 0.
2575 a_xkmhd(i,k-1,j+1) = a_xkmhd(i,k-1,j+1)+0.25*a_mkrdyp*msfv(i,j+1)*rdy
2576 a_xkmhd(i,k-1,j) = a_xkmhd(i,k-1,j)+0.25*a_mkrdyp*msfv(i,j+1)*rdy
2577 a_xkmhd(i,k,j+1) = a_xkmhd(i,k,j+1)+0.25*a_mkrdyp*msfv(i,j+1)*rdy
2578 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.25*a_mkrdyp*msfv(i,j+1)*rdy
2579 a_mkrdyp = 0.
2580 a_xkmhd(i,k-1,j-1) = a_xkmhd(i,k-1,j-1)+0.25*a_mkrdym*msfv(i,j)*rdy
2581 a_xkmhd(i,k-1,j) = a_xkmhd(i,k-1,j)+0.25*a_mkrdym*msfv(i,j)*rdy
2582 a_xkmhd(i,k,j-1) = a_xkmhd(i,k,j-1)+0.25*a_mkrdym*msfv(i,j)*rdy
2583 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.25*a_mkrdym*msfv(i,j)*rdy
2584 a_mkrdym = 0.
2585 a_xkmhd(i+1,k-1,j) = a_xkmhd(i+1,k-1,j)+0.25*a_mkrdxp*msfu(i+1,j)*rdx
2586 a_xkmhd(i,k-1,j) = a_xkmhd(i,k-1,j)+0.25*a_mkrdxp*msfu(i+1,j)*rdx
2587 a_xkmhd(i+1,k,j) = a_xkmhd(i+1,k,j)+0.25*a_mkrdxp*msfu(i+1,j)*rdx
2588 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.25*a_mkrdxp*msfu(i+1,j)*rdx
2589 a_mkrdxp = 0.
2590 a_xkmhd(i-1,k-1,j) = a_xkmhd(i-1,k-1,j)+0.25*a_mkrdxm*msfu(i,j)*rdx
2591 a_xkmhd(i,k-1,j) = a_xkmhd(i,k-1,j)+0.25*a_mkrdxm*msfu(i,j)*rdx
2592 a_xkmhd(i-1,k,j) = a_xkmhd(i-1,k,j)+0.25*a_mkrdxm*msfu(i,j)*rdx
2593 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.25*a_mkrdxm*msfu(i,j)*rdx
2594 a_mkrdxm = 0.
2595 end do
2596 end do
2597 end do
2598 else
2599 i_start = its
2600 ! recompute : i_start
2601 i_end = min(ite,ide-1)
2602 ! recompute : i_end
2603 j_start = jts
2604 ! recompute : j_start
2605 j_end = min(jte,jde-1)
2606 ! recompute : j_end
2607 if (config_flags%open_xs .or. specified) then
2608 i_start = max(ids+1,its)
2609 endif
2610 ! recompute : i_start
2611 if (config_flags%open_xe .or. specified) then
2612 i_end = min(ide-2,ite)
2613 endif
2614 ! recompute : i_end
2615 if (config_flags%open_ys .or. specified) then
2616 j_start = max(jds+1,jts)
2617 endif
2618 ! recompute : j_start
2619 if (config_flags%open_ye .or. specified) then
2620 j_end = min(jde-2,jte)
2621 endif
2622 ! recompute : j_end
2623 do j = j_start, j_end
2624 a_mkrdxm = 0.
2625 a_mkrdxp = 0.
2626 a_mkrdym = 0.
2627 a_mkrdyp = 0.
2628 a_rcoup = 0.
2629 do k = kts, ktf
2630 a_mkrdxm = 0.
2631 a_mkrdxp = 0.
2632 a_mkrdym = 0.
2633 a_mkrdyp = 0.
2634 a_rcoup = 0.
2635 do i = i_start, i_end
2636 a_mkrdxm = 0.
2637 a_mkrdxp = 0.
2638 a_mkrdym = 0.
2639 a_mkrdyp = 0.
2640 a_rcoup = 0.
2641 mkrdxm = msfu(i,j)*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*rdx*pr
2642 ! recompute : mkrdxm
2643 mkrdxp = msfu(i+1,j)*0.5*(xkmhd(i+1,k,j)+xkmhd(i,k,j))*rdx*pr
2644 ! recompute : mkrdxp
2645 mrdx = msft(i,j)*rdx
2646 ! recompute : mrdx
2647 mkrdym = msfv(i,j)*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*rdy*pr
2648 ! recompute : mkrdym
2649 mkrdyp = msfv(i,j+1)*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*rdy*pr
2650 ! recompute : mkrdyp
2651 mrdy = msft(i,j)*rdy
2652 ! recompute : mrdy
2653 rcoup = mu(i,j)
2654 ! recompute : rcoup
2655 a_field(i,k,j-1) = a_field(i,k,j-1)+a_tendency(i,k,j)*rcoup*mrdy*mkrdym
2656 a_field(i,k,j+1) = a_field(i,k,j+1)+a_tendency(i,k,j)*rcoup*mrdy*mkrdyp
2657 a_field(i-1,k,j) = a_field(i-1,k,j)+a_tendency(i,k,j)*rcoup*mrdx*mkrdxm
2658 a_field(i+1,k,j) = a_field(i+1,k,j)+a_tendency(i,k,j)*rcoup*mrdx*mkrdxp
2659 a_field(i,k,j) = a_field(i,k,j)+a_tendency(i,k,j)*rcoup*((-(mrdx*(mkrdxp+mkrdxm)))-mrdy*(mkrdyp+mkrdym))
2660 a_mkrdxm = a_mkrdxm-a_tendency(i,k,j)*rcoup*mrdx*(field(i,k,j)-field(i-1,k,j))
2661 a_mkrdxp = a_mkrdxp+a_tendency(i,k,j)*rcoup*mrdx*(field(i+1,k,j)-field(i,k,j))
2662 a_mkrdym = a_mkrdym-a_tendency(i,k,j)*rcoup*mrdy*(field(i,k,j)-field(i,k,j-1))
2663 a_mkrdyp = a_mkrdyp+a_tendency(i,k,j)*rcoup*mrdy*(field(i,k,j+1)-field(i,k,j))
2664 a_rcoup = a_rcoup+a_tendency(i,k,j)*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j))-mkrdxm*(field(i,k,j)-field(i-1,k,j)))+mrdy*&
2665 &(mkrdyp*(field(i,k,j+1)-field(i,k,j))-mkrdym*(field(i,k,j)-field(i,k,j-1))))
2666 a_mu(i,j) = a_mu(i,j)+a_rcoup
2667 a_rcoup = 0.
2668 a_xkmhd(i,k,j+1) = a_xkmhd(i,k,j+1)+0.5*a_mkrdyp*msfv(i,j+1)*rdy*pr
2669 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.5*a_mkrdyp*msfv(i,j+1)*rdy*pr
2670 a_mkrdyp = 0.
2671 a_xkmhd(i,k,j-1) = a_xkmhd(i,k,j-1)+0.5*a_mkrdym*msfv(i,j)*rdy*pr
2672 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.5*a_mkrdym*msfv(i,j)*rdy*pr
2673 a_mkrdym = 0.
2674 a_xkmhd(i+1,k,j) = a_xkmhd(i+1,k,j)+0.5*a_mkrdxp*msfu(i+1,j)*rdx*pr
2675 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.5*a_mkrdxp*msfu(i+1,j)*rdx*pr
2676 a_mkrdxp = 0.
2677 a_xkmhd(i-1,k,j) = a_xkmhd(i-1,k,j)+0.5*a_mkrdxm*msfu(i,j)*rdx*pr
2678 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.5*a_mkrdxm*msfu(i,j)*rdx*pr
2679 a_mkrdxm = 0.
2680 end do
2681 end do
2682 end do
2683 endif
2684
2685 end subroutine a_horizontal_diffusion
2686
2687
2688 subroutine a_horizontal_diffusion_3dmp( field, a_field, a_tendency, mu, a_mu, config_flags, base_3d, msfu, msfv, msft, xkmhd, &
2689 &a_xkmhd, rdx, rdy, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
2690 !******************************************************************
2691 !******************************************************************
2692 !** This routine was generated by Automatic differentiation. **
2693 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
2694 !******************************************************************
2695 !******************************************************************
2696 !==============================================
2697 ! all entries are defined explicitly
2698 !==============================================
2699 implicit none
2700
2701 !==============================================
2702 ! declare arguments
2703 !==============================================
2704 integer, intent(in) :: ime
2705 integer, intent(in) :: ims
2706 integer, intent(in) :: jme
2707 integer, intent(in) :: jms
2708 integer, intent(in) :: kme
2709 integer, intent(in) :: kms
2710 real, intent(inout) :: a_field(ims:ime,kms:kme,jms:jme)
2711 real, intent(inout) :: a_mu(ims:ime,jms:jme)
2712 real, intent(inout) :: a_tendency(ims:ime,kms:kme,jms:jme)
2713 real, intent(inout) :: a_xkmhd(ims:ime,kms:kme,jms:jme)
2714 real, intent(in) :: base_3d(ims:ime,kms:kme,jms:jme)
2715 type (grid_config_rec_type), intent(in) :: config_flags
2716 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
2717 integer, intent(in) :: ide
2718 integer, intent(in) :: ids
2719 integer, intent(in) :: ite
2720 integer, intent(in) :: its
2721 integer, intent(in) :: jde
2722 integer, intent(in) :: jds
2723 integer, intent(in) :: jte
2724 integer, intent(in) :: jts
2725 integer, intent(in) :: kde
2726 integer, intent(in) :: kte
2727 integer, intent(in) :: kts
2728 real, intent(in) :: msft(ims:ime,jms:jme)
2729 real, intent(in) :: msfu(ims:ime,jms:jme)
2730 real, intent(in) :: msfv(ims:ime,jms:jme)
2731 real, intent(in) :: mu(ims:ime,jms:jme)
2732 real, intent(in) :: rdx
2733 real, intent(in) :: rdy
2734 real, intent(in) :: xkmhd(ims:ime,kms:kme,jms:jme)
2735
2736 !==============================================
2737 ! declare local variables
2738 !==============================================
2739 real a_mkrdxm
2740 real a_mkrdxp
2741 real a_mkrdym
2742 real a_mkrdyp
2743 real a_rcoup
2744 integer i
2745 integer i_end
2746 integer i_start
2747 integer j
2748 integer j_end
2749 integer j_start
2750 integer k
2751 integer ktf
2752 real mkrdxm
2753 real mkrdxp
2754 real mkrdym
2755 real mkrdyp
2756 real mrdx
2757 real mrdy
2758 real :: pr = 3.
2759 real rcoup
2760 logical specified
2761
2762 !----------------------------------------------
2763 ! RESET LOCAL ADJOINT VARIABLES
2764 !----------------------------------------------
2765 a_mkrdxm = 0.
2766 a_mkrdxp = 0.
2767 a_mkrdym = 0.
2768 a_mkrdyp = 0.
2769 a_rcoup = 0.
2770
2771 !----------------------------------------------
2772 ! ROUTINE BODY
2773 !----------------------------------------------
2774 specified = .false.
2775 ! recompute : specified
2776 if (config_flags%specified .or. config_flags%nested) then
2777 specified = .true.
2778 endif
2779 ! recompute : specified
2780 ktf = min(kte,kde-1)
2781 ! recompute : ktf
2782 i_start = its
2783 ! recompute : i_start
2784 i_end = min(ite,ide-1)
2785 ! recompute : i_end
2786 j_start = jts
2787 ! recompute : j_start
2788 j_end = min(jte,jde-1)
2789 ! recompute : j_end
2790 if (config_flags%open_xs .or. specified) then
2791 i_start = max(ids+1,its)
2792 endif
2793 ! recompute : i_start
2794 if (config_flags%open_xe .or. specified) then
2795 i_end = min(ide-2,ite)
2796 endif
2797 ! recompute : i_end
2798 if (config_flags%open_ys .or. specified) then
2799 j_start = max(jds+1,jts)
2800 endif
2801 ! recompute : j_start
2802 if (config_flags%open_ye .or. specified) then
2803 j_end = min(jde-2,jte)
2804 endif
2805 ! recompute : j_end
2806 do j = j_start, j_end
2807 a_mkrdxm = 0.
2808 a_mkrdxp = 0.
2809 a_mkrdym = 0.
2810 a_mkrdyp = 0.
2811 a_rcoup = 0.
2812 do k = kts, ktf
2813 a_mkrdxm = 0.
2814 a_mkrdxp = 0.
2815 a_mkrdym = 0.
2816 a_mkrdyp = 0.
2817 a_rcoup = 0.
2818 do i = i_start, i_end
2819 a_mkrdxm = 0.
2820 a_mkrdxp = 0.
2821 a_mkrdym = 0.
2822 a_mkrdyp = 0.
2823 a_rcoup = 0.
2824 mkrdxm = msfu(i,j)*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*rdx*pr
2825 ! recompute : mkrdxm
2826 mkrdxp = msfu(i+1,j)*0.5*(xkmhd(i+1,k,j)+xkmhd(i,k,j))*rdx*pr
2827 ! recompute : mkrdxp
2828 mrdx = msft(i,j)*rdx
2829 ! recompute : mrdx
2830 mkrdym = msfv(i,j)*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*rdy*pr
2831 ! recompute : mkrdym
2832 mkrdyp = msfv(i,j+1)*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*rdy*pr
2833 ! recompute : mkrdyp
2834 mrdy = msft(i,j)*rdy
2835 ! recompute : mrdy
2836 rcoup = mu(i,j)
2837 ! recompute : rcoup
2838 a_field(i,k,j-1) = a_field(i,k,j-1)+a_tendency(i,k,j)*rcoup*mrdy*mkrdym
2839 a_field(i,k,j+1) = a_field(i,k,j+1)+a_tendency(i,k,j)*rcoup*mrdy*mkrdyp
2840 a_field(i-1,k,j) = a_field(i-1,k,j)+a_tendency(i,k,j)*rcoup*mrdx*mkrdxm
2841 a_field(i+1,k,j) = a_field(i+1,k,j)+a_tendency(i,k,j)*rcoup*mrdx*mkrdxp
2842 a_field(i,k,j) = a_field(i,k,j)+a_tendency(i,k,j)*rcoup*((-(mrdx*(mkrdxp+mkrdxm)))-mrdy*(mkrdyp+mkrdym))
2843 a_mkrdxm = a_mkrdxm-a_tendency(i,k,j)*rcoup*mrdx*(field(i,k,j)-field(i-1,k,j)-base_3d(i,k,j)+base_3d(i-1,k,j))
2844 a_mkrdxp = a_mkrdxp+a_tendency(i,k,j)*rcoup*mrdx*(field(i+1,k,j)-field(i,k,j)-base_3d(i+1,k,j)+base_3d(i,k,j))
2845 a_mkrdym = a_mkrdym-a_tendency(i,k,j)*rcoup*mrdy*(field(i,k,j)-field(i,k,j-1)-base_3d(i,k,j)+base_3d(i,k,j-1))
2846 a_mkrdyp = a_mkrdyp+a_tendency(i,k,j)*rcoup*mrdy*(field(i,k,j+1)-field(i,k,j)-base_3d(i,k,j+1)+base_3d(i,k,j))
2847 a_rcoup = a_rcoup+a_tendency(i,k,j)*(mrdx*(mkrdxp*(field(i+1,k,j)-field(i,k,j)-base_3d(i+1,k,j)+base_3d(i,k,j))-mkrdxm*&
2848 &(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)+&
2849 &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))))
2850 a_mu(i,j) = a_mu(i,j)+a_rcoup
2851 a_rcoup = 0.
2852 a_xkmhd(i,k,j+1) = a_xkmhd(i,k,j+1)+0.5*a_mkrdyp*msfv(i,j+1)*rdy*pr
2853 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.5*a_mkrdyp*msfv(i,j+1)*rdy*pr
2854 a_mkrdyp = 0.
2855 a_xkmhd(i,k,j-1) = a_xkmhd(i,k,j-1)+0.5*a_mkrdym*msfv(i,j)*rdy*pr
2856 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.5*a_mkrdym*msfv(i,j)*rdy*pr
2857 a_mkrdym = 0.
2858 a_xkmhd(i+1,k,j) = a_xkmhd(i+1,k,j)+0.5*a_mkrdxp*msfu(i+1,j)*rdx*pr
2859 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.5*a_mkrdxp*msfu(i+1,j)*rdx*pr
2860 a_mkrdxp = 0.
2861 a_xkmhd(i-1,k,j) = a_xkmhd(i-1,k,j)+0.5*a_mkrdxm*msfu(i,j)*rdx*pr
2862 a_xkmhd(i,k,j) = a_xkmhd(i,k,j)+0.5*a_mkrdxm*msfu(i,j)*rdx*pr
2863 a_mkrdxm = 0.
2864 end do
2865 end do
2866 end do
2867
2868 end subroutine a_horizontal_diffusion_3dmp
2869
2870
2871 subroutine a_horizontal_pressure_gradient( a_ru_tend, a_rv_tend, ph, a_ph, alt, a_alt, p, a_p, pb, al, a_al, php, a_php, cqu, &
2872 &a_cqu, cqv, a_cqv, muu, a_muu, muv, a_muv, mu, a_mu, fnm, fnp, rdnw, cf1, cf2, cf3, rdx, rdy, config_flags, non_hydrostatic, ids, &
2873 &ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kte )
2874 !******************************************************************
2875 !******************************************************************
2876 !** This routine was generated by Automatic differentiation. **
2877 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
2878 !******************************************************************
2879 !******************************************************************
2880 !==============================================
2881 ! all entries are defined explicitly
2882 !==============================================
2883 implicit none
2884
2885 !==============================================
2886 ! declare arguments
2887 !==============================================
2888 integer, intent(in) :: ime
2889 integer, intent(in) :: ims
2890 integer, intent(in) :: jme
2891 integer, intent(in) :: jms
2892 integer, intent(in) :: kme
2893 integer, intent(in) :: kms
2894 real, intent(inout) :: a_al(ims:ime,kms:kme,jms:jme)
2895 real, intent(inout) :: a_alt(ims:ime,kms:kme,jms:jme)
2896 real, intent(inout) :: a_cqu(ims:ime,kms:kme,jms:jme)
2897 real, intent(inout) :: a_cqv(ims:ime,kms:kme,jms:jme)
2898 real, intent(inout) :: a_mu(ims:ime,jms:jme)
2899 real, intent(inout) :: a_muu(ims:ime,jms:jme)
2900 real, intent(inout) :: a_muv(ims:ime,jms:jme)
2901 real, intent(inout) :: a_p(ims:ime,kms:kme,jms:jme)
2902 real, intent(inout) :: a_ph(ims:ime,kms:kme,jms:jme)
2903 real, intent(inout) :: a_php(ims:ime,kms:kme,jms:jme)
2904 real, intent(inout) :: a_ru_tend(ims:ime,kms:kme,jms:jme)
2905 real, intent(inout) :: a_rv_tend(ims:ime,kms:kme,jms:jme)
2906 real, intent(in) :: al(ims:ime,kms:kme,jms:jme)
2907 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
2908 real, intent(in) :: cf1
2909 real, intent(in) :: cf2
2910 real, intent(in) :: cf3
2911 type (grid_config_rec_type), intent(in) :: config_flags
2912 real, intent(in) :: cqu(ims:ime,kms:kme,jms:jme)
2913 real, intent(in) :: cqv(ims:ime,kms:kme,jms:jme)
2914 real, intent(in) :: fnm(kms:kme)
2915 real, intent(in) :: fnp(kms:kme)
2916 integer, intent(in) :: ide
2917 integer, intent(in) :: ids
2918 integer, intent(in) :: ite
2919 integer, intent(in) :: its
2920 integer, intent(in) :: jde
2921 integer, intent(in) :: jds
2922 integer, intent(in) :: jte
2923 integer, intent(in) :: jts
2924 integer, intent(in) :: kde
2925 integer, intent(in) :: kte
2926 real, intent(in) :: mu(ims:ime,jms:jme)
2927 real, intent(in) :: muu(ims:ime,jms:jme)
2928 real, intent(in) :: muv(ims:ime,jms:jme)
2929 logical, intent(in) :: non_hydrostatic
2930 real, intent(in) :: p(ims:ime,kms:kme,jms:jme)
2931 real, intent(in) :: pb(ims:ime,kms:kme,jms:jme)
2932 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
2933 real, intent(in) :: php(ims:ime,kms:kme,jms:jme)
2934 real, intent(in) :: rdnw(kms:kme)
2935 real, intent(in) :: rdx
2936 real, intent(in) :: rdy
2937
2938 !==============================================
2939 ! declare local variables
2940 !==============================================
2941 real a_dpn(ims:ime,kms:kme)
2942 real a_dpx
2943 real a_dpy
2944 real dpn(ims:ime,kms:kme)
2945 real dpx
2946 real dpy
2947 integer i
2948 integer i_start
2949 integer itf
2950 integer j
2951 integer j_start
2952 integer jtf
2953 integer k
2954 integer ktf
2955 logical specified
2956
2957 !----------------------------------------------
2958 ! RESET LOCAL ADJOINT VARIABLES
2959 !----------------------------------------------
2960 a_dpn(:,:) = 0.
2961 a_dpx = 0.
2962 a_dpy = 0.
2963
2964 !----------------------------------------------
2965 ! ROUTINE BODY
2966 !----------------------------------------------
2967 specified = .false.
2968 ! recompute : specified
2969 if (config_flags%specified .or. config_flags%nested) then
2970 specified = .true.
2971 endif
2972 ! recompute : specified
2973 itf = ite
2974 ! recompute : itf
2975 jtf = min(jte,jde-1)
2976 ! recompute : jtf
2977 ktf = min(kte,kde-1)
2978 ! recompute : ktf
2979 i_start = its
2980 ! recompute : i_start
2981 j_start = jts
2982 ! recompute : j_start
2983 if ((config_flags%open_xs .or. specified .or. config_flags%nested) .and. its .eq. ids) then
2984 i_start = its+1
2985 endif
2986 ! recompute : i_start
2987 if ((config_flags%open_xe .or. specified .or. config_flags%nested) .and. ite .eq. ide) then
2988 itf = itf-1
2989 endif
2990 ! recompute : itf
2991 do j = j_start, jtf
2992 a_dpx = 0.
2993 if (non_hydrostatic) then
2994 k = 1
2995 ! recompute : k
2996 do i = i_start, itf
2997 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)))
2998 dpn(i,kde) = 0.
2999 end do
3000 do k = 2, ktf
3001 do i = i_start, itf
3002 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)))
3003 end do
3004 end do
3005 ! recompute : dpn
3006 do k = 1, ktf
3007 a_dpx = 0.
3008 do i = i_start, itf
3009 a_dpx = 0.
3010 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))+&
3011 &(al(i,k,j)+al(i-1,k,j))*(pb(i,k,j)-pb(i-1,k,j)))
3012 ! recompute : dpx
3013 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)))
3014 ! recompute : dpx
3015 a_cqu(i,k,j) = a_cqu(i,k,j)-a_ru_tend(i,k,j)*dpx
3016 a_dpx = a_dpx-a_ru_tend(i,k,j)*cqu(i,k,j)
3017 a_dpn(i,k+1) = a_dpn(i,k+1)+a_dpx*rdx*(php(i,k,j)-php(i-1,k,j))*rdnw(k)
3018 a_dpn(i,k) = a_dpn(i,k)-a_dpx*rdx*(php(i,k,j)-php(i-1,k,j))*rdnw(k)
3019 a_mu(i-1,j) = a_mu(i-1,j)-0.5*a_dpx*rdx*(php(i,k,j)-php(i-1,k,j))
3020 a_mu(i,j) = a_mu(i,j)-0.5*a_dpx*rdx*(php(i,k,j)-php(i-1,k,j))
3021 a_php(i-1,k,j) = a_php(i-1,k,j)-a_dpx*rdx*(rdnw(k)*(dpn(i,k+1)-dpn(i,k))-0.5*(mu(i-1,j)+mu(i,j)))
3022 a_php(i,k,j) = a_php(i,k,j)+a_dpx*rdx*(rdnw(k)*(dpn(i,k+1)-dpn(i,k))-0.5*(mu(i-1,j)+mu(i,j)))
3023 a_al(i-1,k,j) = a_al(i-1,k,j)+0.5*a_dpx*rdx*muu(i,j)*(pb(i,k,j)-pb(i-1,k,j))
3024 a_al(i,k,j) = a_al(i,k,j)+0.5*a_dpx*rdx*muu(i,j)*(pb(i,k,j)-pb(i-1,k,j))
3025 a_alt(i-1,k,j) = a_alt(i-1,k,j)+0.5*a_dpx*rdx*muu(i,j)*(p(i,k,j)-p(i-1,k,j))
3026 a_alt(i,k,j) = a_alt(i,k,j)+0.5*a_dpx*rdx*muu(i,j)*(p(i,k,j)-p(i-1,k,j))
3027 a_muu(i,j) = a_muu(i,j)+0.5*a_dpx*rdx*(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)-&
3028 &p(i-1,k,j))+(al(i,k,j)+al(i-1,k,j))*(pb(i,k,j)-pb(i-1,k,j)))
3029 a_p(i-1,k,j) = a_p(i-1,k,j)-0.5*a_dpx*rdx*muu(i,j)*(alt(i,k,j)+alt(i-1,k,j))
3030 a_p(i,k,j) = a_p(i,k,j)+0.5*a_dpx*rdx*muu(i,j)*(alt(i,k,j)+alt(i-1,k,j))
3031 a_ph(i-1,k+1,j) = a_ph(i-1,k+1,j)-0.5*a_dpx*rdx*muu(i,j)
3032 a_ph(i,k+1,j) = a_ph(i,k+1,j)+0.5*a_dpx*rdx*muu(i,j)
3033 a_ph(i-1,k,j) = a_ph(i-1,k,j)-0.5*a_dpx*rdx*muu(i,j)
3034 a_ph(i,k,j) = a_ph(i,k,j)+0.5*a_dpx*rdx*muu(i,j)
3035 a_dpx = 0.
3036 end do
3037 end do
3038 do k = 2, ktf
3039 do i = i_start, itf
3040 a_p(i-1,k-1,j) = a_p(i-1,k-1,j)+0.5*a_dpn(i,k)*fnp(k)
3041 a_p(i,k-1,j) = a_p(i,k-1,j)+0.5*a_dpn(i,k)*fnp(k)
3042 a_p(i-1,k,j) = a_p(i-1,k,j)+0.5*a_dpn(i,k)*fnm(k)
3043 a_p(i,k,j) = a_p(i,k,j)+0.5*a_dpn(i,k)*fnm(k)
3044 a_dpn(i,k) = 0.
3045 end do
3046 end do
3047 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:2001
3048 ! recompute vars : k
3049 k = 1
3050 ! recompute vars : k
3051 do i = i_start, itf
3052 a_dpn(i,kde) = 0.
3053 a_p(i-1,k+2,j) = a_p(i-1,k+2,j)+0.5*a_dpn(i,k)*cf3
3054 a_p(i,k+2,j) = a_p(i,k+2,j)+0.5*a_dpn(i,k)*cf3
3055 a_p(i-1,k+1,j) = a_p(i-1,k+1,j)+0.5*a_dpn(i,k)*cf2
3056 a_p(i,k+1,j) = a_p(i,k+1,j)+0.5*a_dpn(i,k)*cf2
3057 a_p(i-1,k,j) = a_p(i-1,k,j)+0.5*a_dpn(i,k)*cf1
3058 a_p(i,k,j) = a_p(i,k,j)+0.5*a_dpn(i,k)*cf1
3059 a_dpn(i,k) = 0.
3060 end do
3061 else
3062 do k = 1, ktf
3063 a_dpx = 0.
3064 do i = i_start, itf
3065 a_dpx = 0.
3066 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))+&
3067 &(al(i,k,j)+al(i-1,k,j))*(pb(i,k,j)-pb(i-1,k,j)))
3068 ! recompute : dpx
3069 a_cqu(i,k,j) = a_cqu(i,k,j)-a_ru_tend(i,k,j)*dpx
3070 a_dpx = a_dpx-a_ru_tend(i,k,j)*cqu(i,k,j)
3071 a_al(i-1,k,j) = a_al(i-1,k,j)+0.5*a_dpx*rdx*muu(i,j)*(pb(i,k,j)-pb(i-1,k,j))
3072 a_al(i,k,j) = a_al(i,k,j)+0.5*a_dpx*rdx*muu(i,j)*(pb(i,k,j)-pb(i-1,k,j))
3073 a_alt(i-1,k,j) = a_alt(i-1,k,j)+0.5*a_dpx*rdx*muu(i,j)*(p(i,k,j)-p(i-1,k,j))
3074 a_alt(i,k,j) = a_alt(i,k,j)+0.5*a_dpx*rdx*muu(i,j)*(p(i,k,j)-p(i-1,k,j))
3075 a_muu(i,j) = a_muu(i,j)+0.5*a_dpx*rdx*(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)-&
3076 &p(i-1,k,j))+(al(i,k,j)+al(i-1,k,j))*(pb(i,k,j)-pb(i-1,k,j)))
3077 a_p(i-1,k,j) = a_p(i-1,k,j)-0.5*a_dpx*rdx*muu(i,j)*(alt(i,k,j)+alt(i-1,k,j))
3078 a_p(i,k,j) = a_p(i,k,j)+0.5*a_dpx*rdx*muu(i,j)*(alt(i,k,j)+alt(i-1,k,j))
3079 a_ph(i-1,k+1,j) = a_ph(i-1,k+1,j)-0.5*a_dpx*rdx*muu(i,j)
3080 a_ph(i,k+1,j) = a_ph(i,k+1,j)+0.5*a_dpx*rdx*muu(i,j)
3081 a_ph(i-1,k,j) = a_ph(i-1,k,j)-0.5*a_dpx*rdx*muu(i,j)
3082 a_ph(i,k,j) = a_ph(i,k,j)+0.5*a_dpx*rdx*muu(i,j)
3083 a_dpx = 0.
3084 end do
3085 end do
3086 endif
3087 end do
3088 ! recdepend vars : ide,ite
3089 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1927
3090 ! recompute vars : itf
3091 itf = min(ite,ide-1)
3092 ! recompute vars : itf
3093 ! recdepend vars : itf,jte
3094 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1928
3095 ! recompute vars : jtf
3096 jtf = jte
3097 ! recompute vars : jtf
3098 ! recdepend vars : itf,jtf,kde,kte
3099 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1929
3100 ! recompute vars : ktf
3101 ktf = min(kte,kde-1)
3102 ! recompute vars : ktf
3103 ! recdepend vars : itf,its,jtf,ktf
3104 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1930
3105 ! recompute vars : i_start
3106 i_start = its
3107 ! recompute vars : i_start
3108 ! recdepend vars : i_start,itf,jtf,jts,ktf
3109 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1931
3110 ! recompute vars : j_start
3111 j_start = jts
3112 ! recompute vars : j_start
3113 ! recdepend vars : config_flags,i_start,itf,j_start,jds,jtf,jts,ktf,spe
3114 ! cified
3115 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:1932
3116 ! recompute vars : j_start
3117 if ((config_flags%open_ys .or. specified .or. config_flags%nested) .and. jts .eq. jds) then
3118 j_start = jts+1
3119 endif
3120 ! recompute vars : j_start
3121 ! recdepend vars : config_flags,i_start,itf,j_start,jde,jte,jtf,ktf,spe
3122 ! cified
3123 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:1934
3124 ! recompute vars : jtf
3125 if ((config_flags%open_ye .or. specified .or. config_flags%nested) .and. jte .eq. jde) then
3126 jtf = jtf-1
3127 endif
3128 ! recompute vars : jtf
3129 do j = j_start, jtf
3130 a_dpy = 0.
3131 if (non_hydrostatic) then
3132 k = 1
3133 ! recompute : k
3134 do i = i_start, itf
3135 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)))
3136 dpn(i,kde) = 0.
3137 end do
3138 do k = 2, ktf
3139 do i = i_start, itf
3140 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)))
3141 end do
3142 end do
3143 ! recompute : dpn
3144 do k = 1, ktf
3145 a_dpy = 0.
3146 do i = i_start, itf
3147 a_dpy = 0.
3148 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))+&
3149 &(al(i,k,j)+al(i,k,j-1))*(pb(i,k,j)-pb(i,k,j-1)))
3150 ! recompute : dpy
3151 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)))
3152 ! recompute : dpy
3153 a_cqv(i,k,j) = a_cqv(i,k,j)-a_rv_tend(i,k,j)*dpy
3154 a_dpy = a_dpy-a_rv_tend(i,k,j)*cqv(i,k,j)
3155 a_dpn(i,k+1) = a_dpn(i,k+1)+a_dpy*rdy*(php(i,k,j)-php(i,k,j-1))*rdnw(k)
3156 a_dpn(i,k) = a_dpn(i,k)-a_dpy*rdy*(php(i,k,j)-php(i,k,j-1))*rdnw(k)
3157 a_mu(i,j-1) = a_mu(i,j-1)-0.5*a_dpy*rdy*(php(i,k,j)-php(i,k,j-1))
3158 a_mu(i,j) = a_mu(i,j)-0.5*a_dpy*rdy*(php(i,k,j)-php(i,k,j-1))
3159 a_php(i,k,j-1) = a_php(i,k,j-1)-a_dpy*rdy*(rdnw(k)*(dpn(i,k+1)-dpn(i,k))-0.5*(mu(i,j-1)+mu(i,j)))
3160 a_php(i,k,j) = a_php(i,k,j)+a_dpy*rdy*(rdnw(k)*(dpn(i,k+1)-dpn(i,k))-0.5*(mu(i,j-1)+mu(i,j)))
3161 a_al(i,k,j-1) = a_al(i,k,j-1)+0.5*a_dpy*rdy*muv(i,j)*(pb(i,k,j)-pb(i,k,j-1))
3162 a_al(i,k,j) = a_al(i,k,j)+0.5*a_dpy*rdy*muv(i,j)*(pb(i,k,j)-pb(i,k,j-1))
3163 a_alt(i,k,j-1) = a_alt(i,k,j-1)+0.5*a_dpy*rdy*muv(i,j)*(p(i,k,j)-p(i,k,j-1))
3164 a_alt(i,k,j) = a_alt(i,k,j)+0.5*a_dpy*rdy*muv(i,j)*(p(i,k,j)-p(i,k,j-1))
3165 a_muv(i,j) = a_muv(i,j)+0.5*a_dpy*rdy*(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)-&
3166 &p(i,k,j-1))+(al(i,k,j)+al(i,k,j-1))*(pb(i,k,j)-pb(i,k,j-1)))
3167 a_p(i,k,j-1) = a_p(i,k,j-1)-0.5*a_dpy*rdy*muv(i,j)*(alt(i,k,j)+alt(i,k,j-1))
3168 a_p(i,k,j) = a_p(i,k,j)+0.5*a_dpy*rdy*muv(i,j)*(alt(i,k,j)+alt(i,k,j-1))
3169 a_ph(i,k+1,j-1) = a_ph(i,k+1,j-1)-0.5*a_dpy*rdy*muv(i,j)
3170 a_ph(i,k+1,j) = a_ph(i,k+1,j)+0.5*a_dpy*rdy*muv(i,j)
3171 a_ph(i,k,j-1) = a_ph(i,k,j-1)-0.5*a_dpy*rdy*muv(i,j)
3172 a_ph(i,k,j) = a_ph(i,k,j)+0.5*a_dpy*rdy*muv(i,j)
3173 a_dpy = 0.
3174 end do
3175 end do
3176 do k = 2, ktf
3177 do i = i_start, itf
3178 a_p(i,k-1,j-1) = a_p(i,k-1,j-1)+0.5*a_dpn(i,k)*fnp(k)
3179 a_p(i,k-1,j) = a_p(i,k-1,j)+0.5*a_dpn(i,k)*fnp(k)
3180 a_p(i,k,j-1) = a_p(i,k,j-1)+0.5*a_dpn(i,k)*fnm(k)
3181 a_p(i,k,j) = a_p(i,k,j)+0.5*a_dpn(i,k)*fnm(k)
3182 a_dpn(i,k) = 0.
3183 end do
3184 end do
3185 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1941
3186 ! recompute vars : k
3187 k = 1
3188 ! recompute vars : k
3189 do i = i_start, itf
3190 a_dpn(i,kde) = 0.
3191 a_p(i,k+2,j-1) = a_p(i,k+2,j-1)+0.5*a_dpn(i,k)*cf3
3192 a_p(i,k+2,j) = a_p(i,k+2,j)+0.5*a_dpn(i,k)*cf3
3193 a_p(i,k+1,j-1) = a_p(i,k+1,j-1)+0.5*a_dpn(i,k)*cf2
3194 a_p(i,k+1,j) = a_p(i,k+1,j)+0.5*a_dpn(i,k)*cf2
3195 a_p(i,k,j-1) = a_p(i,k,j-1)+0.5*a_dpn(i,k)*cf1
3196 a_p(i,k,j) = a_p(i,k,j)+0.5*a_dpn(i,k)*cf1
3197 a_dpn(i,k) = 0.
3198 end do
3199 else
3200 do k = 1, ktf
3201 a_dpy = 0.
3202 do i = i_start, itf
3203 a_dpy = 0.
3204 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))+&
3205 &(al(i,k,j)+al(i,k,j-1))*(pb(i,k,j)-pb(i,k,j-1)))
3206 ! recompute : dpy
3207 a_cqv(i,k,j) = a_cqv(i,k,j)-a_rv_tend(i,k,j)*dpy
3208 a_dpy = a_dpy-a_rv_tend(i,k,j)*cqv(i,k,j)
3209 a_al(i,k,j-1) = a_al(i,k,j-1)+0.5*a_dpy*rdy*muv(i,j)*(pb(i,k,j)-pb(i,k,j-1))
3210 a_al(i,k,j) = a_al(i,k,j)+0.5*a_dpy*rdy*muv(i,j)*(pb(i,k,j)-pb(i,k,j-1))
3211 a_alt(i,k,j-1) = a_alt(i,k,j-1)+0.5*a_dpy*rdy*muv(i,j)*(p(i,k,j)-p(i,k,j-1))
3212 a_alt(i,k,j) = a_alt(i,k,j)+0.5*a_dpy*rdy*muv(i,j)*(p(i,k,j)-p(i,k,j-1))
3213 a_muv(i,j) = a_muv(i,j)+0.5*a_dpy*rdy*(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)-&
3214 &p(i,k,j-1))+(al(i,k,j)+al(i,k,j-1))*(pb(i,k,j)-pb(i,k,j-1)))
3215 a_p(i,k,j-1) = a_p(i,k,j-1)-0.5*a_dpy*rdy*muv(i,j)*(alt(i,k,j)+alt(i,k,j-1))
3216 a_p(i,k,j) = a_p(i,k,j)+0.5*a_dpy*rdy*muv(i,j)*(alt(i,k,j)+alt(i,k,j-1))
3217 a_ph(i,k+1,j-1) = a_ph(i,k+1,j-1)-0.5*a_dpy*rdy*muv(i,j)
3218 a_ph(i,k+1,j) = a_ph(i,k+1,j)+0.5*a_dpy*rdy*muv(i,j)
3219 a_ph(i,k,j-1) = a_ph(i,k,j-1)-0.5*a_dpy*rdy*muv(i,j)
3220 a_ph(i,k,j) = a_ph(i,k,j)+0.5*a_dpy*rdy*muv(i,j)
3221 a_dpy = 0.
3222 end do
3223 end do
3224 endif
3225 end do
3226
3227 end subroutine a_horizontal_pressure_gradient
3228
3229
3230 subroutine a_perturbation_coriolis( a_ru_in, a_rv_in, a_rw, a_ru_tend, a_rv_tend, a_rw_tend, config_flags, u_base, v_base, z_base, &
3231 &muu, a_muu, muv, a_muv, phb, ph, a_ph, f, e, sina, cosa, fzm, fzp, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, &
3232 &ite, jts, jte, kts, kte )
3233 !******************************************************************
3234 !******************************************************************
3235 !** This routine was generated by Automatic differentiation. **
3236 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
3237 !******************************************************************
3238 !******************************************************************
3239 !==============================================
3240 ! all entries are defined explicitly
3241 !==============================================
3242 implicit none
3243
3244 !==============================================
3245 ! declare arguments
3246 !==============================================
3247 integer, intent(in) :: ime
3248 integer, intent(in) :: ims
3249 integer, intent(in) :: jme
3250 integer, intent(in) :: jms
3251 real, intent(inout) :: a_muu(ims:ime,jms:jme)
3252 real, intent(inout) :: a_muv(ims:ime,jms:jme)
3253 integer, intent(in) :: kme
3254 integer, intent(in) :: kms
3255 real, intent(inout) :: a_ph(ims:ime,kms:kme,jms:jme)
3256 real, intent(inout) :: a_ru_in(ims:ime,kms:kme,jms:jme)
3257 real, intent(inout) :: a_ru_tend(ims:ime,kms:kme,jms:jme)
3258 real, intent(inout) :: a_rv_in(ims:ime,kms:kme,jms:jme)
3259 real, intent(inout) :: a_rv_tend(ims:ime,kms:kme,jms:jme)
3260 real, intent(inout) :: a_rw(ims:ime,kms:kme,jms:jme)
3261 real, intent(inout) :: a_rw_tend(ims:ime,kms:kme,jms:jme)
3262 type (grid_config_rec_type), intent(in) :: config_flags
3263 real, intent(in) :: cosa(ims:ime,jms:jme)
3264 real, intent(in) :: e(ims:ime,jms:jme)
3265 real, intent(in) :: f(ims:ime,jms:jme)
3266 real, intent(in) :: fzm(kms:kme)
3267 real, intent(in) :: fzp(kms:kme)
3268 integer, intent(in) :: ide
3269 integer, intent(in) :: ids
3270 integer, intent(in) :: ite
3271 integer, intent(in) :: its
3272 integer, intent(in) :: jde
3273 integer, intent(in) :: jds
3274 integer, intent(in) :: jte
3275 integer, intent(in) :: jts
3276 integer, intent(in) :: kde
3277 integer, intent(in) :: kte
3278 integer, intent(in) :: kts
3279 real, intent(in) :: muu(ims:ime,jms:jme)
3280 real, intent(in) :: muv(ims:ime,jms:jme)
3281 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
3282 real, intent(in) :: phb(ims:ime,kms:kme,jms:jme)
3283 real, intent(in) :: sina(ims:ime,jms:jme)
3284 real, intent(in) :: u_base(kms:kme)
3285 real, intent(in) :: v_base(kms:kme)
3286 real, intent(in) :: z_base(kms:kme)
3287
3288 !==============================================
3289 ! declare local variables
3290 !==============================================
3291 real a_ru(ims:ime,kms:kme,jms:jme)
3292 real a_rv(ims:ime,kms:kme,jms:jme)
3293 real a_wk
3294 real a_wkm1
3295 real a_wkp1
3296 real a_z_at_u
3297 real a_z_at_v
3298 integer i
3299 integer i_end
3300 integer i_start
3301 integer j
3302 integer j_end
3303 integer j_start
3304 integer k
3305 integer ktf
3306 logical specified
3307 real wk
3308 real wkm1
3309 real wkp1
3310 real z_at_u
3311 real z_at_v
3312
3313 !----------------------------------------------
3314 ! RESET LOCAL ADJOINT VARIABLES
3315 !----------------------------------------------
3316 a_ru(:,:,:) = 0.
3317 a_rv(:,:,:) = 0.
3318 a_wk = 0.
3319 a_wkm1 = 0.
3320 a_wkp1 = 0.
3321 a_z_at_u = 0.
3322 a_z_at_v = 0.
3323
3324 !----------------------------------------------
3325 ! ROUTINE BODY
3326 !----------------------------------------------
3327 specified = .false.
3328 ! recompute : specified
3329 if (config_flags%specified .or. config_flags%nested) then
3330 specified = .true.
3331 endif
3332 ! recompute : specified
3333 ktf = min(kte,kde-1)
3334 ! recompute : ktf
3335 i_start = its
3336 ! recompute : i_start
3337 i_end = ite
3338 ! recompute : i_end
3339 if (config_flags%open_xs .or. specified .or. config_flags%nested) then
3340 i_start = max(ids+1,its)
3341 endif
3342 ! recompute : i_start
3343 if (config_flags%open_xe .or. specified .or. config_flags%nested) then
3344 i_end = min(ide-1,ite)
3345 endif
3346 ! recompute : i_end
3347 j_start = jts
3348 ! recompute : j_start
3349 j_end = jte
3350 ! recompute : j_end
3351 if (config_flags%open_ys .or. specified .or. config_flags%nested) then
3352 j_start = max(jds+1,jts)
3353 endif
3354 ! recompute : j_start
3355 if (config_flags%open_ye .or. specified .or. config_flags%nested) then
3356 j_end = min(jde-1,jte)
3357 endif
3358 ! recompute : j_end
3359 do j = jts, min(jte,jde-1)
3360 do k = kts+1, ktf
3361 do i = its, min(ite,ide-1)
3362 a_ru(i+1,k-1,j) = a_ru(i+1,k-1,j)+0.5*a_rw_tend(i,k,j)*e(i,j)*cosa(i,j)*fzp(k)
3363 a_ru(i,k-1,j) = a_ru(i,k-1,j)+0.5*a_rw_tend(i,k,j)*e(i,j)*cosa(i,j)*fzp(k)
3364 a_ru(i+1,k,j) = a_ru(i+1,k,j)+0.5*a_rw_tend(i,k,j)*e(i,j)*cosa(i,j)*fzm(k)
3365 a_ru(i,k,j) = a_ru(i,k,j)+0.5*a_rw_tend(i,k,j)*e(i,j)*cosa(i,j)*fzm(k)
3366 a_rv(i,k-1,j+1) = a_rv(i,k-1,j+1)-0.5*a_rw_tend(i,k,j)*e(i,j)*sina(i,j)*fzp(k)
3367 a_rv(i,k-1,j) = a_rv(i,k-1,j)-0.5*a_rw_tend(i,k,j)*e(i,j)*sina(i,j)*fzp(k)
3368 a_rv(i,k,j+1) = a_rv(i,k,j+1)-0.5*a_rw_tend(i,k,j)*e(i,j)*sina(i,j)*fzm(k)
3369 a_rv(i,k,j) = a_rv(i,k,j)-0.5*a_rw_tend(i,k,j)*e(i,j)*sina(i,j)*fzm(k)
3370 end do
3371 end do
3372 end do
3373 if (config_flags%open_ye .and. jte .eq. jde) then
3374 do k = kts, ktf
3375 do i = its, min(ide-1,ite)
3376 a_ru(i+1,k,jte-1) = a_ru(i+1,k,jte-1)-0.5*a_rv_tend(i,k,jte)*f(i,jte-1)
3377 a_ru(i,k,jte-1) = a_ru(i,k,jte-1)-0.5*a_rv_tend(i,k,jte)*f(i,jte-1)
3378 a_rw(i,k+1,jte-1) = a_rw(i,k+1,jte-1)+0.5*a_rv_tend(i,k,jte)*e(i,jte-1)*sina(i,jte-1)
3379 a_rw(i,k,jte-1) = a_rw(i,k,jte-1)+0.5*a_rv_tend(i,k,jte)*e(i,jte-1)*sina(i,jte-1)
3380 end do
3381 end do
3382 endif
3383 do j = j_start, j_end
3384 do k = kts, ktf
3385 do i = its, min(ide-1,ite)
3386 a_ru(i+1,k,j-1) = a_ru(i+1,k,j-1)-0.125*a_rv_tend(i,k,j)*(f(i,j)+f(i,j-1))
3387 a_ru(i,k,j-1) = a_ru(i,k,j-1)-0.125*a_rv_tend(i,k,j)*(f(i,j)+f(i,j-1))
3388 a_ru(i+1,k,j) = a_ru(i+1,k,j)-0.125*a_rv_tend(i,k,j)*(f(i,j)+f(i,j-1))
3389 a_ru(i,k,j) = a_ru(i,k,j)-0.125*a_rv_tend(i,k,j)*(f(i,j)+f(i,j-1))
3390 a_rw(i,k+1,j-1) = a_rw(i,k+1,j-1)+0.0625*a_rv_tend(i,k,j)*(e(i,j)+e(i,j-1))*(sina(i,j)+sina(i,j-1))
3391 a_rw(i,k+1,j) = a_rw(i,k+1,j)+0.0625*a_rv_tend(i,k,j)*(e(i,j)+e(i,j-1))*(sina(i,j)+sina(i,j-1))
3392 a_rw(i,k,j-1) = a_rw(i,k,j-1)+0.0625*a_rv_tend(i,k,j)*(e(i,j)+e(i,j-1))*(sina(i,j)+sina(i,j-1))
3393 a_rw(i,k,j) = a_rw(i,k,j)+0.0625*a_rv_tend(i,k,j)*(e(i,j)+e(i,j-1))*(sina(i,j)+sina(i,j-1))
3394 end do
3395 end do
3396 end do
3397 if (config_flags%open_ys .and. jts .eq. jds) then
3398 do k = kts, ktf
3399 do i = its, min(ide-1,ite)
3400 a_ru(i+1,k,jts) = a_ru(i+1,k,jts)-0.5*a_rv_tend(i,k,jts)*f(i,jts)
3401 a_ru(i,k,jts) = a_ru(i,k,jts)-0.5*a_rv_tend(i,k,jts)*f(i,jts)
3402 a_rw(i,k+1,jts) = a_rw(i,k+1,jts)+0.5*a_rv_tend(i,k,jts)*e(i,jts)*sina(i,jts)
3403 a_rw(i,k,jts) = a_rw(i,k,jts)+0.5*a_rv_tend(i,k,jts)*e(i,jts)*sina(i,jts)
3404 end do
3405 end do
3406 endif
3407 do j = j_start-1, j_end
3408 a_wk = 0.
3409 a_wkm1 = 0.
3410 a_wkp1 = 0.
3411 a_z_at_u = 0.
3412 do i = its, min(ite,ide-1)+1
3413 a_wk = 0.
3414 a_wkm1 = 0.
3415 a_wkp1 = 0.
3416 a_z_at_u = 0.
3417 k = kts
3418 ! recompute : k
3419 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
3420 ! recompute : z_at_u
3421 wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k)))
3422 ! recompute : wkp1
3423 k = ktf
3424 ! recompute : k
3425 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
3426 ! recompute : z_at_u
3427 wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1)))
3428 ! recompute : wkm1
3429 wk = 1.-wkm1
3430 ! recompute : wk
3431 a_muu(i,j) = a_muu(i,j)-a_ru(i,k,j)*(wkm1*u_base(k-1)+wk*u_base(k))
3432 a_ru_in(i,k,j) = a_ru_in(i,k,j)+a_ru(i,k,j)
3433 a_wk = a_wk-a_ru(i,k,j)*muu(i,j)*u_base(k)
3434 a_wkm1 = a_wkm1-a_ru(i,k,j)*muu(i,j)*u_base(k-1)
3435 a_ru(i,k,j) = 0.
3436 a_wkm1 = a_wkm1-a_wk
3437 a_wk = 0.
3438 a_z_at_u = a_z_at_u-a_wkm1*(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)-&
3439 &z_at_u)))/(z_base(k)-z_base(k-1)))
3440 a_wkm1 = 0.
3441 a_ph(i-1,k+1,j) = a_ph(i-1,k+1,j)+a_z_at_u*(0.25/g)
3442 a_ph(i,k+1,j) = a_ph(i,k+1,j)+a_z_at_u*(0.25/g)
3443 a_ph(i-1,k,j) = a_ph(i-1,k,j)+a_z_at_u*(0.25/g)
3444 a_ph(i,k,j) = a_ph(i,k,j)+a_z_at_u*(0.25/g)
3445 a_z_at_u = 0.
3446 ! recdepend vars : kts
3447 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3426
3448 ! recompute vars : k
3449 k = kts
3450 ! recompute vars : k
3451 ! recdepend vars : k,wkp1
3452 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3432
3453 ! recompute vars : wk
3454 wk = 1.-wkp1
3455 ! recompute vars : wk
3456 a_muu(i,j) = a_muu(i,j)-a_ru(i,k,j)*(wk*u_base(k)+wkp1*u_base(k+1))
3457 a_ru_in(i,k,j) = a_ru_in(i,k,j)+a_ru(i,k,j)
3458 a_wk = a_wk-a_ru(i,k,j)*muu(i,j)*u_base(k)
3459 a_wkp1 = a_wkp1-a_ru(i,k,j)*muu(i,j)*u_base(k+1)
3460 a_ru(i,k,j) = 0.
3461 a_wkp1 = a_wkp1-a_wk
3462 a_wk = 0.
3463 ! recdepend vars : kts
3464 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3426
3465 ! recompute vars : k
3466 k = kts
3467 ! recompute vars : k
3468 ! recdepend vars : g,i,j,k,ph,phb
3469 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3427
3470 ! recompute vars : z_at_u
3471 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
3472 ! recompute vars : z_at_u
3473 a_z_at_u = a_z_at_u+a_wkp1*(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-&
3474 &z_base(k))))/(z_base(k+1)-z_base(k)))
3475 a_wkp1 = 0.
3476 ! recdepend vars : kts
3477 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3426
3478 ! recompute vars : k
3479 k = kts
3480 ! recompute vars : k
3481 a_ph(i-1,k+1,j) = a_ph(i-1,k+1,j)+a_z_at_u*(0.25/g)
3482 a_ph(i,k+1,j) = a_ph(i,k+1,j)+a_z_at_u*(0.25/g)
3483 a_ph(i-1,k,j) = a_ph(i-1,k,j)+a_z_at_u*(0.25/g)
3484 a_ph(i,k,j) = a_ph(i,k,j)+a_z_at_u*(0.25/g)
3485 a_z_at_u = 0.
3486 end do
3487 end do
3488 do j = j_start-1, j_end
3489 a_wk = 0.
3490 a_wkm1 = 0.
3491 a_wkp1 = 0.
3492 a_z_at_u = 0.
3493 do k = kts+1, ktf-1
3494 a_wk = 0.
3495 a_wkm1 = 0.
3496 a_wkp1 = 0.
3497 a_z_at_u = 0.
3498 do i = its, min(ite,ide-1)+1
3499 a_wk = 0.
3500 a_wkm1 = 0.
3501 a_wkp1 = 0.
3502 a_z_at_u = 0.
3503 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
3504 ! recompute : z_at_u
3505 wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k)))
3506 ! recompute : wkp1
3507 wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1)))
3508 ! recompute : wkm1
3509 wk = 1.-wkp1-wkm1
3510 ! recompute : wk
3511 a_muu(i,j) = a_muu(i,j)-a_ru(i,k,j)*(wkm1*u_base(k-1)+wk*u_base(k)+wkp1*u_base(k+1))
3512 a_ru_in(i,k,j) = a_ru_in(i,k,j)+a_ru(i,k,j)
3513 a_wk = a_wk-a_ru(i,k,j)*muu(i,j)*u_base(k)
3514 a_wkm1 = a_wkm1-a_ru(i,k,j)*muu(i,j)*u_base(k-1)
3515 a_wkp1 = a_wkp1-a_ru(i,k,j)*muu(i,j)*u_base(k+1)
3516 a_ru(i,k,j) = 0.
3517 a_wkm1 = a_wkm1-a_wk
3518 a_wkp1 = a_wkp1-a_wk
3519 a_wk = 0.
3520 a_z_at_u = a_z_at_u-a_wkm1*(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)-&
3521 &z_at_u)))/(z_base(k)-z_base(k-1)))
3522 a_wkm1 = 0.
3523 a_z_at_u = a_z_at_u+a_wkp1*(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-&
3524 &z_base(k))))/(z_base(k+1)-z_base(k)))
3525 a_wkp1 = 0.
3526 a_ph(i-1,k+1,j) = a_ph(i-1,k+1,j)+a_z_at_u*(0.25/g)
3527 a_ph(i,k+1,j) = a_ph(i,k+1,j)+a_z_at_u*(0.25/g)
3528 a_ph(i-1,k,j) = a_ph(i-1,k,j)+a_z_at_u*(0.25/g)
3529 a_ph(i,k,j) = a_ph(i,k,j)+a_z_at_u*(0.25/g)
3530 a_z_at_u = 0.
3531 end do
3532 end do
3533 end do
3534 do j = jts, min(jte,jde-1)
3535 if (config_flags%open_xe .and. ite .eq. ide) then
3536 do k = kts, ktf
3537 a_rv(ite-1,k,j+1) = a_rv(ite-1,k,j+1)+0.5*a_ru_tend(ite,k,j)*f(ite-1,j)
3538 a_rv(ite-1,k,j) = a_rv(ite-1,k,j)+0.5*a_ru_tend(ite,k,j)*f(ite-1,j)
3539 a_rw(ite-1,k+1,j) = a_rw(ite-1,k+1,j)-0.5*a_ru_tend(ite,k,j)*e(ite-1,j)*cosa(ite-1,j)
3540 a_rw(ite-1,k,j) = a_rw(ite-1,k,j)-0.5*a_ru_tend(ite,k,j)*e(ite-1,j)*cosa(ite-1,j)
3541 end do
3542 endif
3543 if (config_flags%open_xs .and. its .eq. ids) then
3544 do k = kts, ktf
3545 a_rv(its,k,j+1) = a_rv(its,k,j+1)+0.5*a_ru_tend(its,k,j)*f(its,j)
3546 a_rv(its,k,j) = a_rv(its,k,j)+0.5*a_ru_tend(its,k,j)*f(its,j)
3547 a_rw(its,k+1,j) = a_rw(its,k+1,j)-0.5*a_ru_tend(its,k,j)*e(its,j)*cosa(its,j)
3548 a_rw(its,k,j) = a_rw(its,k,j)-0.5*a_ru_tend(its,k,j)*e(its,j)*cosa(its,j)
3549 end do
3550 endif
3551 do k = kts, ktf
3552 do i = i_start, i_end
3553 a_rv(i-1,k,j+1) = a_rv(i-1,k,j+1)+0.125*a_ru_tend(i,k,j)*(f(i,j)+f(i-1,j))
3554 a_rv(i,k,j+1) = a_rv(i,k,j+1)+0.125*a_ru_tend(i,k,j)*(f(i,j)+f(i-1,j))
3555 a_rv(i-1,k,j) = a_rv(i-1,k,j)+0.125*a_ru_tend(i,k,j)*(f(i,j)+f(i-1,j))
3556 a_rv(i,k,j) = a_rv(i,k,j)+0.125*a_ru_tend(i,k,j)*(f(i,j)+f(i-1,j))
3557 a_rw(i-1,k+1,j) = a_rw(i-1,k+1,j)-0.0625*a_ru_tend(i,k,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+cosa(i-1,j))
3558 a_rw(i,k+1,j) = a_rw(i,k+1,j)-0.0625*a_ru_tend(i,k,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+cosa(i-1,j))
3559 a_rw(i-1,k,j) = a_rw(i-1,k,j)-0.0625*a_ru_tend(i,k,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+cosa(i-1,j))
3560 a_rw(i,k,j) = a_rw(i,k,j)-0.0625*a_ru_tend(i,k,j)*(e(i,j)+e(i-1,j))*(cosa(i,j)+cosa(i-1,j))
3561 end do
3562 end do
3563 end do
3564 do j = jts, min(jte,jde-1)+1
3565 a_wk = 0.
3566 a_wkm1 = 0.
3567 a_wkp1 = 0.
3568 a_z_at_v = 0.
3569 do i = i_start-1, i_end
3570 a_wk = 0.
3571 a_wkm1 = 0.
3572 a_wkp1 = 0.
3573 a_z_at_v = 0.
3574 k = kts
3575 ! recompute : k
3576 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
3577 ! recompute : z_at_v
3578 wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k)))
3579 ! recompute : wkp1
3580 k = ktf
3581 ! recompute : k
3582 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
3583 ! recompute : z_at_v
3584 wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1)))
3585 ! recompute : wkm1
3586 wk = 1.-wkm1
3587 ! recompute : wk
3588 a_muv(i,j) = a_muv(i,j)-a_rv(i,k,j)*(wkm1*v_base(k-1)+wk*v_base(k))
3589 a_rv_in(i,k,j) = a_rv_in(i,k,j)+a_rv(i,k,j)
3590 a_wk = a_wk-a_rv(i,k,j)*muv(i,j)*v_base(k)
3591 a_wkm1 = a_wkm1-a_rv(i,k,j)*muv(i,j)*v_base(k-1)
3592 a_rv(i,k,j) = 0.
3593 a_wkm1 = a_wkm1-a_wk
3594 a_wk = 0.
3595 a_z_at_v = a_z_at_v-a_wkm1*(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)-&
3596 &z_at_v)))/(z_base(k)-z_base(k-1)))
3597 a_wkm1 = 0.
3598 a_ph(i,k+1,j-1) = a_ph(i,k+1,j-1)+a_z_at_v*(0.25/g)
3599 a_ph(i,k+1,j) = a_ph(i,k+1,j)+a_z_at_v*(0.25/g)
3600 a_ph(i,k,j-1) = a_ph(i,k,j-1)+a_z_at_v*(0.25/g)
3601 a_ph(i,k,j) = a_ph(i,k,j)+a_z_at_v*(0.25/g)
3602 a_z_at_v = 0.
3603 ! recdepend vars : kts
3604 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3325
3605 ! recompute vars : k
3606 k = kts
3607 ! recompute vars : k
3608 ! recdepend vars : k,wkp1
3609 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3331
3610 ! recompute vars : wk
3611 wk = 1.-wkp1
3612 ! recompute vars : wk
3613 a_muv(i,j) = a_muv(i,j)-a_rv(i,k,j)*(wk*v_base(k)+wkp1*v_base(k+1))
3614 a_rv_in(i,k,j) = a_rv_in(i,k,j)+a_rv(i,k,j)
3615 a_wk = a_wk-a_rv(i,k,j)*muv(i,j)*v_base(k)
3616 a_wkp1 = a_wkp1-a_rv(i,k,j)*muv(i,j)*v_base(k+1)
3617 a_rv(i,k,j) = 0.
3618 a_wkp1 = a_wkp1-a_wk
3619 a_wk = 0.
3620 ! recdepend vars : kts
3621 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3325
3622 ! recompute vars : k
3623 k = kts
3624 ! recompute vars : k
3625 ! recdepend vars : g,i,j,k,ph,phb
3626 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3326
3627 ! recompute vars : z_at_v
3628 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
3629 ! recompute vars : z_at_v
3630 a_z_at_v = a_z_at_v+a_wkp1*(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-&
3631 &z_base(k))))/(z_base(k+1)-z_base(k)))
3632 a_wkp1 = 0.
3633 ! recdepend vars : kts
3634 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:3325
3635 ! recompute vars : k
3636 k = kts
3637 ! recompute vars : k
3638 a_ph(i,k+1,j-1) = a_ph(i,k+1,j-1)+a_z_at_v*(0.25/g)
3639 a_ph(i,k+1,j) = a_ph(i,k+1,j)+a_z_at_v*(0.25/g)
3640 a_ph(i,k,j-1) = a_ph(i,k,j-1)+a_z_at_v*(0.25/g)
3641 a_ph(i,k,j) = a_ph(i,k,j)+a_z_at_v*(0.25/g)
3642 a_z_at_v = 0.
3643 end do
3644 end do
3645 do j = jts, min(jte,jde-1)+1
3646 a_wk = 0.
3647 a_wkm1 = 0.
3648 a_wkp1 = 0.
3649 a_z_at_v = 0.
3650 do k = kts+1, ktf-1
3651 a_wk = 0.
3652 a_wkm1 = 0.
3653 a_wkp1 = 0.
3654 a_z_at_v = 0.
3655 do i = i_start-1, i_end
3656 a_wk = 0.
3657 a_wkm1 = 0.
3658 a_wkp1 = 0.
3659 a_z_at_v = 0.
3660 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
3661 ! recompute : z_at_v
3662 wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k)))
3663 ! recompute : wkp1
3664 wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1)))
3665 ! recompute : wkm1
3666 wk = 1.-wkp1-wkm1
3667 ! recompute : wk
3668 a_muv(i,j) = a_muv(i,j)-a_rv(i,k,j)*(wkm1*v_base(k-1)+wk*v_base(k)+wkp1*v_base(k+1))
3669 a_rv_in(i,k,j) = a_rv_in(i,k,j)+a_rv(i,k,j)
3670 a_wk = a_wk-a_rv(i,k,j)*muv(i,j)*v_base(k)
3671 a_wkm1 = a_wkm1-a_rv(i,k,j)*muv(i,j)*v_base(k-1)
3672 a_wkp1 = a_wkp1-a_rv(i,k,j)*muv(i,j)*v_base(k+1)
3673 a_rv(i,k,j) = 0.
3674 a_wkm1 = a_wkm1-a_wk
3675 a_wkp1 = a_wkp1-a_wk
3676 a_wk = 0.
3677 a_z_at_v = a_z_at_v-a_wkm1*(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)-&
3678 &z_at_v)))/(z_base(k)-z_base(k-1)))
3679 a_wkm1 = 0.
3680 a_z_at_v = a_z_at_v+a_wkp1*(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-&
3681 &z_base(k))))/(z_base(k+1)-z_base(k)))
3682 a_wkp1 = 0.
3683 a_ph(i,k+1,j-1) = a_ph(i,k+1,j-1)+a_z_at_v*(0.25/g)
3684 a_ph(i,k+1,j) = a_ph(i,k+1,j)+a_z_at_v*(0.25/g)
3685 a_ph(i,k,j-1) = a_ph(i,k,j-1)+a_z_at_v*(0.25/g)
3686 a_ph(i,k,j) = a_ph(i,k,j)+a_z_at_v*(0.25/g)
3687 a_z_at_v = 0.
3688 end do
3689 end do
3690 end do
3691
3692 end subroutine a_perturbation_coriolis
3693
3694
3695 subroutine a_pg_buoy_w( a_rw_tend, p, a_p, cqw, a_cqw, a_mu, mub, rdnw, rdn, g, msft, ide, jde, kde, ims, ime, jms, jme, kms, kme, &
3696 &its, ite, jts, jte )
3697 !******************************************************************
3698 !******************************************************************
3699 !** This routine was generated by Automatic differentiation. **
3700 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
3701 !******************************************************************
3702 !******************************************************************
3703 !==============================================
3704 ! all entries are defined explicitly
3705 !==============================================
3706 implicit none
3707
3708 !==============================================
3709 ! declare arguments
3710 !==============================================
3711 integer, intent(in) :: ime
3712 integer, intent(in) :: ims
3713 integer, intent(in) :: jme
3714 integer, intent(in) :: jms
3715 integer, intent(in) :: kme
3716 integer, intent(in) :: kms
3717 real, intent(inout) :: a_cqw(ims:ime,kms:kme,jms:jme)
3718 real, intent(inout) :: a_mu(ims:ime,jms:jme)
3719 real, intent(inout) :: a_p(ims:ime,kms:kme,jms:jme)
3720 real, intent(inout) :: a_rw_tend(ims:ime,kms:kme,jms:jme)
3721 real, intent(inout) :: cqw(ims:ime,kms:kme,jms:jme)
3722 real, intent(in) :: g
3723 integer, intent(in) :: ide
3724 integer, intent(in) :: ite
3725 integer, intent(in) :: its
3726 integer, intent(in) :: jde
3727 integer, intent(in) :: jte
3728 integer, intent(in) :: jts
3729 integer, intent(in) :: kde
3730 real, intent(in) :: msft(ims:ime,jms:jme)
3731 real, intent(in) :: mub(ims:ime,jms:jme)
3732 real, intent(in) :: p(ims:ime,kms:kme,jms:jme)
3733 real, intent(in) :: rdn(kms:kme)
3734 real, intent(in) :: rdnw(kms:kme)
3735
3736 !==============================================
3737 ! declare local variables
3738 !==============================================
3739 real a_cq1
3740 real a_cq2
3741 real cq1
3742 integer i
3743 integer itf
3744 integer j
3745 integer jtf
3746 integer k
3747
3748 !----------------------------------------------
3749 ! RESET LOCAL ADJOINT VARIABLES
3750 !----------------------------------------------
3751 a_cq1 = 0.
3752 a_cq2 = 0.
3753
3754 !----------------------------------------------
3755 ! ROUTINE BODY
3756 !----------------------------------------------
3757 itf = min(ite,ide-1)
3758 ! recompute : itf
3759 jtf = min(jte,jde-1)
3760 ! recompute : jtf
3761 do j = jts, jtf
3762 a_cq1 = 0.
3763 a_cq2 = 0.
3764 do k = 2, kde-1
3765 a_cq1 = 0.
3766 a_cq2 = 0.
3767 do i = its, itf
3768 a_cq1 = 0.
3769 a_cq2 = 0.
3770 cq1 = 1./(1.+cqw(i,k,j))
3771 ! recompute : cq1
3772 a_cq1 = a_cq1+a_rw_tend(i,k,j)*1./msft(i,j)*g*rdn(k)*(p(i,k,j)-p(i,k-1,j))
3773 a_cq2 = a_cq2-a_rw_tend(i,k,j)*1./msft(i,j)*g*mub(i,j)
3774 a_mu(i,j) = a_mu(i,j)-a_rw_tend(i,k,j)*1./msft(i,j)*g
3775 a_p(i,k-1,j) = a_p(i,k-1,j)-a_rw_tend(i,k,j)*1./msft(i,j)*g*cq1*rdn(k)
3776 a_p(i,k,j) = a_p(i,k,j)+a_rw_tend(i,k,j)*1./msft(i,j)*g*cq1*rdn(k)
3777 a_cq1 = a_cq1+a_cqw(i,k,j)
3778 a_cqw(i,k,j) = 0.
3779 a_cq1 = a_cq1+a_cq2*cqw(i,k,j)
3780 a_cqw(i,k,j) = a_cqw(i,k,j)+a_cq2*cq1
3781 a_cq2 = 0.
3782 a_cqw(i,k,j) = a_cqw(i,k,j)-a_cq1/((1.+cqw(i,k,j))*(1.+cqw(i,k,j)))
3783 a_cq1 = 0.
3784 end do
3785 end do
3786 ! recdepend vars : kde
3787 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:2094
3788 ! recompute vars : k
3789 k = kde
3790 ! recompute vars : k
3791 do i = its, itf
3792 a_cq1 = 0.
3793 a_cq2 = 0.
3794 cq1 = 1./(1.+cqw(i,k-1,j))
3795 ! recompute : cq1
3796 a_cq1 = a_cq1-2*a_rw_tend(i,k,j)*1./msft(i,j)*g*rdnw(k-1)*p(i,k-1,j)
3797 a_cq2 = a_cq2-a_rw_tend(i,k,j)*1./msft(i,j)*g*mub(i,j)
3798 a_mu(i,j) = a_mu(i,j)-a_rw_tend(i,k,j)*1./msft(i,j)*g
3799 a_p(i,k-1,j) = a_p(i,k-1,j)-2*a_rw_tend(i,k,j)*1./msft(i,j)*g*cq1*rdnw(k-1)
3800 a_cq1 = a_cq1+a_cq2*cqw(i,k-1,j)
3801 a_cqw(i,k-1,j) = a_cqw(i,k-1,j)+a_cq2*cq1
3802 a_cq2 = 0.
3803 a_cqw(i,k-1,j) = a_cqw(i,k-1,j)-a_cq1/((1.+cqw(i,k-1,j))*(1.+cqw(i,k-1,j)))
3804 a_cq1 = 0.
3805 end do
3806 end do
3807
3808 end subroutine a_pg_buoy_w
3809
3810
3811 subroutine a_phy_prep( p, a_p, pb, ph, a_ph, phb, t, a_t, th_phy, a_th_phy, p_phy, a_p_phy, pi_phy, a_pi_phy, a_p8w, t_phy, &
3812 &a_t_phy, a_t8w, z, a_z, z_at_w, a_z_at_w, fzm, fzp, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
3813 !******************************************************************
3814 !******************************************************************
3815 !** This routine was generated by Automatic differentiation. **
3816 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
3817 !******************************************************************
3818 !******************************************************************
3819 !==============================================
3820 ! all entries are defined explicitly
3821 !==============================================
3822 implicit none
3823
3824 !==============================================
3825 ! declare arguments
3826 !==============================================
3827 integer, intent(in) :: ime
3828 integer, intent(in) :: ims
3829 integer, intent(in) :: jme
3830 integer, intent(in) :: jms
3831 integer, intent(in) :: kme
3832 integer, intent(in) :: kms
3833 real, intent(inout) :: a_p(ims:ime,kms:kme,jms:jme)
3834 real, intent(inout) :: a_p8w(ims:ime,kms:kme,jms:jme)
3835 real, intent(inout) :: a_p_phy(ims:ime,kms:kme,jms:jme)
3836 real, intent(inout) :: a_ph(ims:ime,kms:kme,jms:jme)
3837 real, intent(inout) :: a_pi_phy(ims:ime,kms:kme,jms:jme)
3838 real, intent(inout) :: a_t(ims:ime,kms:kme,jms:jme)
3839 real, intent(inout) :: a_t8w(ims:ime,kms:kme,jms:jme)
3840 real, intent(inout) :: a_t_phy(ims:ime,kms:kme,jms:jme)
3841 real, intent(inout) :: a_th_phy(ims:ime,kms:kme,jms:jme)
3842 real, intent(inout) :: a_z(ims:ime,kms:kme,jms:jme)
3843 real, intent(inout) :: a_z_at_w(ims:ime,kms:kme,jms:jme)
3844 real, intent(in) :: fzm(kms:kme)
3845 real, intent(in) :: fzp(kms:kme)
3846 integer, intent(in) :: ide
3847 integer, intent(in) :: ite
3848 integer, intent(in) :: its
3849 integer, intent(in) :: jde
3850 integer, intent(in) :: jte
3851 integer, intent(in) :: jts
3852 integer, intent(in) :: kde
3853 integer, intent(in) :: kte
3854 integer, intent(in) :: kts
3855 real, intent(in) :: p(ims:ime,kms:kme,jms:jme)
3856 real, intent(out) :: p_phy(ims:ime,kms:kme,jms:jme)
3857 real, intent(in) :: pb(ims:ime,kms:kme,jms:jme)
3858 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
3859 real, intent(in) :: phb(ims:ime,kms:kme,jms:jme)
3860 real, intent(out) :: pi_phy(ims:ime,kms:kme,jms:jme)
3861 real, intent(in) :: t(ims:ime,kms:kme,jms:jme)
3862 real, intent(out) :: t_phy(ims:ime,kms:kme,jms:jme)
3863 real, intent(out) :: th_phy(ims:ime,kms:kme,jms:jme)
3864 real, intent(out) :: z(ims:ime,kms:kme,jms:jme)
3865 real, intent(out) :: z_at_w(ims:ime,kms:kme,jms:jme)
3866
3867 !==============================================
3868 ! declare local variables
3869 !==============================================
3870 real a_w1
3871 real a_w2
3872 real a_z0
3873 real a_z1
3874 real a_z2
3875 integer i
3876 integer i_end
3877 integer i_start
3878 integer j
3879 integer j_end
3880 integer j_start
3881 integer k
3882 integer k_end
3883 integer k_start
3884 real w1
3885 real w2
3886 real z0
3887 real z1
3888 real z2
3889
3890 !----------------------------------------------
3891 ! RESET LOCAL ADJOINT VARIABLES
3892 !----------------------------------------------
3893 a_w1 = 0.
3894 a_w2 = 0.
3895 a_z0 = 0.
3896 a_z1 = 0.
3897 a_z2 = 0.
3898
3899 !----------------------------------------------
3900 ! ROUTINE BODY
3901 !----------------------------------------------
3902 i_start = its
3903 ! recompute : i_start
3904 i_end = min(ite,ide-1)
3905 ! recompute : i_end
3906 j_start = jts
3907 ! recompute : j_start
3908 j_end = min(jte,jde-1)
3909 ! recompute : j_end
3910 k_start = kts
3911 ! recompute : k_start
3912 k_end = min(kte,kde-1)
3913 ! recompute : k_end
3914 do j = j_start, j_end
3915 do k = k_start, k_end
3916 do i = i_start, i_end
3917 th_phy(i,k,j) = t(i,k,j)+t0
3918 p_phy(i,k,j) = p(i,k,j)+pb(i,k,j)
3919 pi_phy(i,k,j) = (p_phy(i,k,j)/p1000mb)**rcp
3920 t_phy(i,k,j) = th_phy(i,k,j)*pi_phy(i,k,j)
3921 end do
3922 end do
3923 end do
3924 ! recompute : p_phy,t_phy
3925 do j = j_start, j_end
3926 do k = k_start, kte
3927 do i = i_start, i_end
3928 z_at_w(i,k,j) = (phb(i,k,j)+ph(i,k,j))/g
3929 end do
3930 end do
3931 end do
3932 ! recompute : z_at_w
3933 do j = j_start, j_end
3934 do k = k_start, k_end
3935 do i = i_start, i_end
3936 z(i,k,j) = 0.5*(z_at_w(i,k,j)+z_at_w(i,k+1,j))
3937 end do
3938 end do
3939 end do
3940 ! recompute : z
3941 do j = j_start, j_end
3942 a_w1 = 0.
3943 a_w2 = 0.
3944 a_z0 = 0.
3945 a_z1 = 0.
3946 a_z2 = 0.
3947 do i = i_start, i_end
3948 a_w1 = 0.
3949 a_w2 = 0.
3950 a_z0 = 0.
3951 a_z1 = 0.
3952 a_z2 = 0.
3953 z0 = z_at_w(i,kte,j)
3954 ! recompute : z0
3955 z1 = z(i,k_end,j)
3956 ! recompute : z1
3957 z2 = z(i,k_end-1,j)
3958 ! recompute : z2
3959 w1 = (z0-z2)/(z1-z2)
3960 ! recompute : w1
3961 w2 = 1.-w1
3962 ! recompute : w2
3963 a_t_phy(i,kde-2,j) = a_t_phy(i,kde-2,j)+a_t8w(i,kde,j)*w2
3964 a_t_phy(i,kde-1,j) = a_t_phy(i,kde-1,j)+a_t8w(i,kde,j)*w1
3965 a_w1 = a_w1+a_t8w(i,kde,j)*t_phy(i,kde-1,j)
3966 a_w2 = a_w2+a_t8w(i,kde,j)*t_phy(i,kde-2,j)
3967 a_t8w(i,kde,j) = 0.
3968 a_p_phy(i,kde-2,j) = a_p_phy(i,kde-2,j)+a_p8w(i,kde,j)*w2*(1./p_phy(i,kde-2,j))*exp(w1*log(p_phy(i,kde-1,j))+w2*log(p_phy(i,&
3969 &kde-2,j)))
3970 a_p_phy(i,kde-1,j) = a_p_phy(i,kde-1,j)+a_p8w(i,kde,j)*w1*(1./p_phy(i,kde-1,j))*exp(w1*log(p_phy(i,kde-1,j))+w2*log(p_phy(i,&
3971 &kde-2,j)))
3972 a_w1 = a_w1+a_p8w(i,kde,j)*exp(w1*log(p_phy(i,kde-1,j))+w2*log(p_phy(i,kde-2,j)))*log(p_phy(i,kde-1,j))
3973 a_w2 = a_w2+a_p8w(i,kde,j)*exp(w1*log(p_phy(i,kde-1,j))+w2*log(p_phy(i,kde-2,j)))*log(p_phy(i,kde-2,j))
3974 a_p8w(i,kde,j) = 0.
3975 a_w1 = a_w1-a_w2
3976 a_w2 = 0.
3977 a_z0 = a_z0+a_w1/(z1-z2)
3978 a_z1 = a_z1-a_w1*((z0-z2)/((z1-z2)*(z1-z2)))
3979 a_z2 = a_z2+a_w1*((-1)/(z1-z2)+(z0-z2)/((z1-z2)*(z1-z2)))
3980 a_w1 = 0.
3981 a_z(i,k_end-1,j) = a_z(i,k_end-1,j)+a_z2
3982 a_z2 = 0.
3983 a_z(i,k_end,j) = a_z(i,k_end,j)+a_z1
3984 a_z1 = 0.
3985 a_z_at_w(i,kte,j) = a_z_at_w(i,kte,j)+a_z0
3986 a_z0 = 0.
3987 ! recdepend vars : i,j,z_at_w
3988 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:4092
3989 ! recompute vars : z0
3990 z0 = z_at_w(i,1,j)
3991 ! recompute vars : z0
3992 ! recdepend vars : i,j,z,z0
3993 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:4093
3994 ! recompute vars : z1
3995 z1 = z(i,1,j)
3996 ! recompute vars : z1
3997 ! recdepend vars : i,j,z,z0,z1
3998 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:4094
3999 ! recompute vars : z2
4000 z2 = z(i,2,j)
4001 ! recompute vars : z2
4002 ! recdepend vars : z0,z1,z2
4003 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:4095
4004 ! recompute vars : w1
4005 w1 = (z0-z2)/(z1-z2)
4006 ! recompute vars : w1
4007 ! recdepend vars : w1
4008 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:4096
4009 ! recompute vars : w2
4010 w2 = 1.-w1
4011 ! recompute vars : w2
4012 a_t_phy(i,2,j) = a_t_phy(i,2,j)+a_t8w(i,1,j)*w2
4013 a_t_phy(i,1,j) = a_t_phy(i,1,j)+a_t8w(i,1,j)*w1
4014 a_w1 = a_w1+a_t8w(i,1,j)*t_phy(i,1,j)
4015 a_w2 = a_w2+a_t8w(i,1,j)*t_phy(i,2,j)
4016 a_t8w(i,1,j) = 0.
4017 ! recdepend vars : i,j,z_at_w
4018 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:4092
4019 ! recompute vars : z0
4020 z0 = z_at_w(i,1,j)
4021 ! recompute vars : z0
4022 ! recdepend vars : i,j,z,z0
4023 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:4093
4024 ! recompute vars : z1
4025 z1 = z(i,1,j)
4026 ! recompute vars : z1
4027 ! recdepend vars : i,j,z,z0,z1
4028 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:4094
4029 ! recompute vars : z2
4030 z2 = z(i,2,j)
4031 ! recompute vars : z2
4032 ! recdepend vars : z0,z1,z2
4033 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:4095
4034 ! recompute vars : w1
4035 w1 = (z0-z2)/(z1-z2)
4036 ! recompute vars : w1
4037 ! recdepend vars : w1
4038 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:4096
4039 ! recompute vars : w2
4040 w2 = 1.-w1
4041 ! recompute vars : w2
4042 a_p_phy(i,2,j) = a_p_phy(i,2,j)+a_p8w(i,1,j)*w2
4043 a_p_phy(i,1,j) = a_p_phy(i,1,j)+a_p8w(i,1,j)*w1
4044 a_w1 = a_w1+a_p8w(i,1,j)*p_phy(i,1,j)
4045 a_w2 = a_w2+a_p8w(i,1,j)*p_phy(i,2,j)
4046 a_p8w(i,1,j) = 0.
4047 a_w1 = a_w1-a_w2
4048 a_w2 = 0.
4049 ! recdepend vars : i,j,z_at_w
4050 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:4092
4051 ! recompute vars : z0
4052 z0 = z_at_w(i,1,j)
4053 ! recompute vars : z0
4054 ! recdepend vars : i,j,z,z0
4055 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:4093
4056 ! recompute vars : z1
4057 z1 = z(i,1,j)
4058 ! recompute vars : z1
4059 ! recdepend vars : i,j,z,z0,z1
4060 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:4094
4061 ! recompute vars : z2
4062 z2 = z(i,2,j)
4063 ! recompute vars : z2
4064 a_z0 = a_z0+a_w1/(z1-z2)
4065 a_z1 = a_z1-a_w1*((z0-z2)/((z1-z2)*(z1-z2)))
4066 a_z2 = a_z2+a_w1*((-1)/(z1-z2)+(z0-z2)/((z1-z2)*(z1-z2)))
4067 a_w1 = 0.
4068 a_z(i,2,j) = a_z(i,2,j)+a_z2
4069 a_z2 = 0.
4070 a_z(i,1,j) = a_z(i,1,j)+a_z1
4071 a_z1 = 0.
4072 a_z_at_w(i,1,j) = a_z_at_w(i,1,j)+a_z0
4073 a_z0 = 0.
4074 end do
4075 end do
4076 do j = j_start, j_end
4077 do k = 2, k_end
4078 do i = i_start, i_end
4079 a_t_phy(i,k-1,j) = a_t_phy(i,k-1,j)+a_t8w(i,k,j)*fzp(k)
4080 a_t_phy(i,k,j) = a_t_phy(i,k,j)+a_t8w(i,k,j)*fzm(k)
4081 a_t8w(i,k,j) = 0.
4082 a_p_phy(i,k-1,j) = a_p_phy(i,k-1,j)+a_p8w(i,k,j)*fzp(k)
4083 a_p_phy(i,k,j) = a_p_phy(i,k,j)+a_p8w(i,k,j)*fzm(k)
4084 a_p8w(i,k,j) = 0.
4085 end do
4086 end do
4087 end do
4088 do j = j_start, j_end
4089 do k = k_start, k_end
4090 do i = i_start, i_end
4091 a_z_at_w(i,k+1,j) = a_z_at_w(i,k+1,j)+0.5*a_z(i,k,j)
4092 a_z_at_w(i,k,j) = a_z_at_w(i,k,j)+0.5*a_z(i,k,j)
4093 a_z(i,k,j) = 0.
4094 end do
4095 end do
4096 end do
4097 do j = j_start, j_end
4098 do k = k_start, kte
4099 do i = i_start, i_end
4100 a_ph(i,k,j) = a_ph(i,k,j)+a_z_at_w(i,k,j)/g
4101 a_z_at_w(i,k,j) = 0.
4102 end do
4103 end do
4104 end do
4105 do j = j_start, j_end
4106 do k = k_start, k_end
4107 do i = i_start, i_end
4108 th_phy(i,k,j) = t(i,k,j)+t0
4109 ! recompute : th_phy
4110 p_phy(i,k,j) = p(i,k,j)+pb(i,k,j)
4111 ! recompute : p_phy
4112 pi_phy(i,k,j) = (p_phy(i,k,j)/p1000mb)**rcp
4113 ! recompute : pi_phy
4114 a_pi_phy(i,k,j) = a_pi_phy(i,k,j)+a_t_phy(i,k,j)*th_phy(i,k,j)
4115 a_th_phy(i,k,j) = a_th_phy(i,k,j)+a_t_phy(i,k,j)*pi_phy(i,k,j)
4116 a_t_phy(i,k,j) = 0.
4117 a_p_phy(i,k,j) = a_p_phy(i,k,j)+a_pi_phy(i,k,j)/p1000mb*rcp*(p_phy(i,k,j)/p1000mb)**(rcp-1)
4118 a_pi_phy(i,k,j) = 0.
4119 a_p(i,k,j) = a_p(i,k,j)+a_p_phy(i,k,j)
4120 a_p_phy(i,k,j) = 0.
4121 a_t(i,k,j) = a_t(i,k,j)+a_th_phy(i,k,j)
4122 a_th_phy(i,k,j) = 0.
4123 end do
4124 end do
4125 end do
4126
4127 end subroutine a_phy_prep
4128
4129
4130 subroutine a_rhs_ph( a_ph_tend, u, a_u, v, a_v, ww, a_ww, ph, a_ph, ph_old, a_ph_old, phb, w, a_w, mut, a_mut, muu, a_muu, muv, &
4131 &a_muv, fnm, fnp, rdnw, cfn, cfn1, rdx, rdy, msft, non_hydrostatic, config_flags, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms,&
4132 & kme, its, ite, jts, jte, kts, kte )
4133 !******************************************************************
4134 !******************************************************************
4135 !** This routine was generated by Automatic differentiation. **
4136 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
4137 !******************************************************************
4138 !******************************************************************
4139 !==============================================
4140 ! all entries are defined explicitly
4141 !==============================================
4142 implicit none
4143
4144 !==============================================
4145 ! declare arguments
4146 !==============================================
4147 integer, intent(in) :: ime
4148 integer, intent(in) :: ims
4149 integer, intent(in) :: jme
4150 integer, intent(in) :: jms
4151 real, intent(inout) :: a_mut(ims:ime,jms:jme)
4152 real, intent(inout) :: a_muu(ims:ime,jms:jme)
4153 real, intent(inout) :: a_muv(ims:ime,jms:jme)
4154 integer, intent(in) :: kme
4155 integer, intent(in) :: kms
4156 real, intent(inout) :: a_ph(ims:ime,kms:kme,jms:jme)
4157 real, intent(inout) :: a_ph_old(ims:ime,kms:kme,jms:jme)
4158 real, intent(inout) :: a_ph_tend(ims:ime,kms:kme,jms:jme)
4159 real, intent(inout) :: a_u(ims:ime,kms:kme,jms:jme)
4160 real, intent(inout) :: a_v(ims:ime,kms:kme,jms:jme)
4161 real, intent(inout) :: a_w(ims:ime,kms:kme,jms:jme)
4162 real, intent(inout) :: a_ww(ims:ime,kms:kme,jms:jme)
4163 real, intent(in) :: cfn
4164 real, intent(in) :: cfn1
4165 type (grid_config_rec_type), intent(in) :: config_flags
4166 real, intent(in) :: fnm(kms:kme)
4167 real, intent(in) :: fnp(kms:kme)
4168 integer, intent(in) :: ide
4169 integer, intent(in) :: ids
4170 integer, intent(in) :: ite
4171 integer, intent(in) :: its
4172 integer, intent(in) :: jde
4173 integer, intent(in) :: jds
4174 integer, intent(in) :: jte
4175 integer, intent(in) :: jts
4176 integer, intent(in) :: kde
4177 integer, intent(in) :: kte
4178 integer, intent(in) :: kts
4179 real, intent(in) :: msft(ims:ime,jms:jme)
4180 real, intent(in) :: mut(ims:ime,jms:jme)
4181 real, intent(in) :: muu(ims:ime,jms:jme)
4182 real, intent(in) :: muv(ims:ime,jms:jme)
4183 logical, intent(in) :: non_hydrostatic
4184 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
4185 real, intent(in) :: ph_old(ims:ime,kms:kme,jms:jme)
4186 real, intent(in) :: phb(ims:ime,kms:kme,jms:jme)
4187 real, intent(in) :: rdnw(kms:kme)
4188 real, intent(in) :: rdx
4189 real, intent(in) :: rdy
4190 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
4191 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
4192 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
4193 real, intent(in) :: ww(ims:ime,kms:kme,jms:jme)
4194
4195 !==============================================
4196 ! declare local variables
4197 !==============================================
4198 real a_ub
4199 real a_ul
4200 real a_ur
4201 real a_vb
4202 real a_vl
4203 real a_vr
4204 real a_wdwn(its:ite,kts:kte)
4205 integer advective_order
4206 integer i
4207 integer i_start
4208 integer itf
4209 integer j
4210 integer j_start
4211 integer jtf
4212 integer k
4213 integer kz
4214 logical specified
4215 real ub
4216 real ul
4217 real ur
4218 real vb
4219 real vl
4220 real vr
4221
4222 !----------------------------------------------
4223 ! RESET LOCAL ADJOINT VARIABLES
4224 !----------------------------------------------
4225 a_ub = 0.
4226 a_ul = 0.
4227 a_ur = 0.
4228 a_vb = 0.
4229 a_vl = 0.
4230 a_vr = 0.
4231 a_wdwn(:,:) = 0.
4232
4233 !----------------------------------------------
4234 ! ROUTINE BODY
4235 !----------------------------------------------
4236 specified = .false.
4237 ! recompute : specified
4238 if (config_flags%specified .or. config_flags%nested) then
4239 specified = .true.
4240 endif
4241 ! recompute : specified
4242 advective_order = config_flags%h_sca_adv_order
4243 ! recompute : advective_order
4244 itf = min(ite,ide-1)
4245 ! recompute : itf
4246 jtf = min(jte,jde-1)
4247 ! recompute : jtf
4248 if (config_flags%open_xe .and. ite .eq. ide) then
4249 i = ite-1
4250 ! recompute : i
4251 do j = jtf, jts, -1
4252 k = kde
4253 ! recompute : k
4254 kz = k-1
4255 ! recompute : kz
4256 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)))
4257 ! recompute : ub
4258 ur = amax1(ub,0.)
4259 ! recompute : ur
4260 a_mut(i,j) = a_mut(i,j)-a_ph_tend(i,k,j)*rdx*ur*(ph_old(i,k,j)-ph_old(i-1,k,j))
4261 a_ph_old(i-1,k,j) = a_ph_old(i-1,k,j)+a_ph_tend(i,k,j)*rdx*mut(i,j)*ur
4262 a_ph_old(i,k,j) = a_ph_old(i,k,j)-a_ph_tend(i,k,j)*rdx*mut(i,j)*ur
4263 a_ur = a_ur-a_ph_tend(i,k,j)*rdx*mut(i,j)*(ph_old(i,k,j)-ph_old(i-1,k,j))
4264 a_ub = a_ub+a_ur*(0.5+sign(0.5,ub-0.))
4265 a_ur = 0.
4266 a_u(i+1,kz-1,j) = a_u(i+1,kz-1,j)+0.5*a_ub*fnp(kz)
4267 a_u(i,kz-1,j) = a_u(i,kz-1,j)+0.5*a_ub*fnp(kz)
4268 a_u(i+1,kz,j) = a_u(i+1,kz,j)+0.5*a_ub*fnm(kz)
4269 a_u(i,kz,j) = a_u(i,kz,j)+0.5*a_ub*fnm(kz)
4270 a_ub = 0.
4271 do k = 2, kde-1
4272 a_ub = 0.
4273 a_ur = 0.
4274 kz = k
4275 ! recompute : kz
4276 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)))
4277 ! recompute : ub
4278 ur = amax1(ub,0.)
4279 ! recompute : ur
4280 a_mut(i,j) = a_mut(i,j)-a_ph_tend(i,k,j)*rdx*ur*(ph_old(i,k,j)-ph_old(i-1,k,j))
4281 a_ph_old(i-1,k,j) = a_ph_old(i-1,k,j)+a_ph_tend(i,k,j)*rdx*mut(i,j)*ur
4282 a_ph_old(i,k,j) = a_ph_old(i,k,j)-a_ph_tend(i,k,j)*rdx*mut(i,j)*ur
4283 a_ur = a_ur-a_ph_tend(i,k,j)*rdx*mut(i,j)*(ph_old(i,k,j)-ph_old(i-1,k,j))
4284 a_ub = a_ub+a_ur*(0.5+sign(0.5,ub-0.))
4285 a_ur = 0.
4286 a_u(i+1,kz-1,j) = a_u(i+1,kz-1,j)+0.5*a_ub*fnp(kz)
4287 a_u(i,kz-1,j) = a_u(i,kz-1,j)+0.5*a_ub*fnp(kz)
4288 a_u(i+1,kz,j) = a_u(i+1,kz,j)+0.5*a_ub*fnm(kz)
4289 a_u(i,kz,j) = a_u(i,kz,j)+0.5*a_ub*fnm(kz)
4290 a_ub = 0.
4291 end do
4292 end do
4293 endif
4294 if (config_flags%open_xs .and. its .eq. ids) then
4295 i = its
4296 ! recompute : i
4297 do j = jtf, jts, -1
4298 k = kde
4299 ! recompute : k
4300 kz = k
4301 ! recompute : kz
4302 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)))
4303 ! recompute : ub
4304 ul = amin1(ub,0.)
4305 ! recompute : ul
4306 a_mut(i,j) = a_mut(i,j)-a_ph_tend(i,k,j)*rdx*ul*(ph_old(i+1,k,j)-ph_old(i,k,j))
4307 a_ph_old(i+1,k,j) = a_ph_old(i+1,k,j)-a_ph_tend(i,k,j)*rdx*mut(i,j)*ul
4308 a_ph_old(i,k,j) = a_ph_old(i,k,j)+a_ph_tend(i,k,j)*rdx*mut(i,j)*ul
4309 a_ul = a_ul-a_ph_tend(i,k,j)*rdx*mut(i,j)*(ph_old(i+1,k,j)-ph_old(i,k,j))
4310 a_ub = a_ub+a_ul*(0.5+sign(0.5,0.-ub))
4311 a_ul = 0.
4312 a_u(i+1,kz-1,j) = a_u(i+1,kz-1,j)+0.5*a_ub*fnp(kz)
4313 a_u(i,kz-1,j) = a_u(i,kz-1,j)+0.5*a_ub*fnp(kz)
4314 a_u(i+1,kz,j) = a_u(i+1,kz,j)+0.5*a_ub*fnm(kz)
4315 a_u(i,kz,j) = a_u(i,kz,j)+0.5*a_ub*fnm(kz)
4316 a_ub = 0.
4317 do k = 2, kde-1
4318 a_ub = 0.
4319 a_ul = 0.
4320 kz = k
4321 ! recompute : kz
4322 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)))
4323 ! recompute : ub
4324 ul = amin1(ub,0.)
4325 ! recompute : ul
4326 a_mut(i,j) = a_mut(i,j)-a_ph_tend(i,k,j)*rdx*ul*(ph_old(i+1,k,j)-ph_old(i,k,j))
4327 a_ph_old(i+1,k,j) = a_ph_old(i+1,k,j)-a_ph_tend(i,k,j)*rdx*mut(i,j)*ul
4328 a_ph_old(i,k,j) = a_ph_old(i,k,j)+a_ph_tend(i,k,j)*rdx*mut(i,j)*ul
4329 a_ul = a_ul-a_ph_tend(i,k,j)*rdx*mut(i,j)*(ph_old(i+1,k,j)-ph_old(i,k,j))
4330 a_ub = a_ub+a_ul*(0.5+sign(0.5,0.-ub))
4331 a_ul = 0.
4332 a_u(i+1,kz-1,j) = a_u(i+1,kz-1,j)+0.5*a_ub*fnp(kz)
4333 a_u(i,kz-1,j) = a_u(i,kz-1,j)+0.5*a_ub*fnp(kz)
4334 a_u(i+1,kz,j) = a_u(i+1,kz,j)+0.5*a_ub*fnm(kz)
4335 a_u(i,kz,j) = a_u(i,kz,j)+0.5*a_ub*fnm(kz)
4336 a_ub = 0.
4337 end do
4338 end do
4339 endif
4340 if (config_flags%open_ye .and. jte .eq. jde) then
4341 j = jte-1
4342 ! recompute : j
4343 do k = 2, kde
4344 a_vb = 0.
4345 a_vr = 0.
4346 kz = min(k,kde-1)
4347 ! recompute : kz
4348 do i = its, itf
4349 a_vb = 0.
4350 a_vr = 0.
4351 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)))
4352 ! recompute : vb
4353 vr = amax1(vb,0.)
4354 ! recompute : vr
4355 a_mut(i,j) = a_mut(i,j)-a_ph_tend(i,k,j)*rdy*vr*(ph_old(i,k,j)-ph_old(i,k,j-1))
4356 a_ph_old(i,k,j-1) = a_ph_old(i,k,j-1)+a_ph_tend(i,k,j)*rdy*mut(i,j)*vr
4357 a_ph_old(i,k,j) = a_ph_old(i,k,j)-a_ph_tend(i,k,j)*rdy*mut(i,j)*vr
4358 a_vr = a_vr-a_ph_tend(i,k,j)*rdy*mut(i,j)*(ph_old(i,k,j)-ph_old(i,k,j-1))
4359 a_vb = a_vb+a_vr*(0.5+sign(0.5,vb-0.))
4360 a_vr = 0.
4361 a_v(i,kz-1,j+1) = a_v(i,kz-1,j+1)+0.5*a_vb*fnp(kz)
4362 a_v(i,kz-1,j) = a_v(i,kz-1,j)+0.5*a_vb*fnp(kz)
4363 a_v(i,kz,j+1) = a_v(i,kz,j+1)+0.5*a_vb*fnm(kz)
4364 a_v(i,kz,j) = a_v(i,kz,j)+0.5*a_vb*fnm(kz)
4365 a_vb = 0.
4366 end do
4367 end do
4368 endif
4369 if (config_flags%open_ys .and. jts .eq. jds) then
4370 j = jts
4371 ! recompute : j
4372 do k = 2, kde
4373 a_vb = 0.
4374 a_vl = 0.
4375 kz = min(k,kde-1)
4376 ! recompute : kz
4377 do i = its, itf
4378 a_vb = 0.
4379 a_vl = 0.
4380 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)))
4381 ! recompute : vb
4382 vl = amin1(vb,0.)
4383 ! recompute : vl
4384 a_mut(i,j) = a_mut(i,j)-a_ph_tend(i,k,j)*rdy*vl*(ph_old(i,k,j+1)-ph_old(i,k,j))
4385 a_ph_old(i,k,j+1) = a_ph_old(i,k,j+1)-a_ph_tend(i,k,j)*rdy*mut(i,j)*vl
4386 a_ph_old(i,k,j) = a_ph_old(i,k,j)+a_ph_tend(i,k,j)*rdy*mut(i,j)*vl
4387 a_vl = a_vl-a_ph_tend(i,k,j)*rdy*mut(i,j)*(ph_old(i,k,j+1)-ph_old(i,k,j))
4388 a_vb = a_vb+a_vl*(0.5+sign(0.5,0.-vb))
4389 a_vl = 0.
4390 a_v(i,kz-1,j+1) = a_v(i,kz-1,j+1)+0.5*a_vb*fnp(kz)
4391 a_v(i,kz-1,j) = a_v(i,kz-1,j)+0.5*a_vb*fnp(kz)
4392 a_v(i,kz,j+1) = a_v(i,kz,j+1)+0.5*a_vb*fnm(kz)
4393 a_v(i,kz,j) = a_v(i,kz,j)+0.5*a_vb*fnm(kz)
4394 a_vb = 0.
4395 end do
4396 end do
4397 endif
4398 if (advective_order .le. 2) then
4399 i_start = its
4400 ! recompute : i_start
4401 j_start = jts
4402 ! recompute : j_start
4403 itf = min(ite,ide-1)
4404 ! recompute : itf
4405 jtf = min(jte,jde-1)
4406 ! recompute : jtf
4407 if (config_flags%open_xs .and. its .eq. ids) then
4408 i_start = its+1
4409 endif
4410 ! recompute : i_start
4411 if (config_flags%open_xe .and. ite .eq. ide) then
4412 itf = itf-1
4413 endif
4414 ! recompute : itf
4415 do j = jtf, j_start, -1
4416 k = kte
4417 ! recompute : k
4418 do i = i_start, itf
4419 a_muu(i+1,j) = a_muu(i+1,j)-0.5*a_ph_tend(i,k,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,&
4420 &j)-ph(i,k,j))
4421 a_muu(i,j) = a_muu(i,j)-0.5*a_ph_tend(i,k,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,&
4422 &k,j))
4423 a_ph(i-1,k,j) = a_ph(i-1,k,j)+0.5*a_ph_tend(i,k,j)*rdx*muu(i,j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j))
4424 a_ph(i+1,k,j) = a_ph(i+1,k,j)-0.5*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))
4425 a_ph(i,k,j) = a_ph(i,k,j)-0.5*a_ph_tend(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-&
4426 &1,j)+cfn1*u(i,k-2,j)))
4427 a_u(i+1,k-2,j) = a_u(i+1,k-2,j)-0.5*a_ph_tend(i,k,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))
4428 a_u(i,k-2,j) = a_u(i,k-2,j)-0.5*a_ph_tend(i,k,j)*rdx*muu(i,j)*cfn1*(phb(i,k,j)-phb(i-1,k,j)+ph(i,k,j)-ph(i-1,k,j))
4429 a_u(i+1,k-1,j) = a_u(i+1,k-1,j)-0.5*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*cfn*(phb(i+1,k,j)-phb(i,k,j)+ph(i+1,k,j)-ph(i,k,j))
4430 a_u(i,k-1,j) = a_u(i,k-1,j)-0.5*a_ph_tend(i,k,j)*rdx*muu(i,j)*cfn*(phb(i,k,j)-phb(i-1,k,j)+ph(i,k,j)-ph(i-1,k,j))
4431 end do
4432 do k = 2, kte-1
4433 do i = i_start, itf
4434 a_muu(i+1,j) = a_muu(i+1,j)-0.25*a_ph_tend(i,k,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,&
4435 &k,j))
4436 a_muu(i,j) = a_muu(i,j)-0.25*a_ph_tend(i,k,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))
4437 a_ph(i-1,k,j) = a_ph(i-1,k,j)+0.25*a_ph_tend(i,k,j)*rdx*muu(i,j)*(u(i,k,j)+u(i,k-1,j))
4438 a_ph(i+1,k,j) = a_ph(i+1,k,j)-0.25*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))
4439 a_ph(i,k,j) = a_ph(i,k,j)-0.25*a_ph_tend(i,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,&
4440 &j)))
4441 a_u(i+1,k-1,j) = a_u(i+1,k-1,j)-0.25*a_ph_tend(i,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))
4442 a_u(i,k-1,j) = a_u(i,k-1,j)-0.25*a_ph_tend(i,k,j)*rdx*muu(i,j)*(phb(i,k,j)-phb(i-1,k,j)+ph(i,k,j)-ph(i-1,k,j))
4443 a_u(i+1,k,j) = a_u(i+1,k,j)-0.25*a_ph_tend(i,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))
4444 a_u(i,k,j) = a_u(i,k,j)-0.25*a_ph_tend(i,k,j)*rdx*muu(i,j)*(phb(i,k,j)-phb(i-1,k,j)+ph(i,k,j)-ph(i-1,k,j))
4445 end do
4446 end do
4447 end do
4448 ! recdepend vars : its
4449 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1407
4450 ! recompute vars : i_start
4451 i_start = its
4452 ! recompute vars : i_start
4453 ! recdepend vars : i_start,jts
4454 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1408
4455 ! recompute vars : j_start
4456 j_start = jts
4457 ! recompute vars : j_start
4458 ! recdepend vars : i_start,ide,ite,j_start
4459 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1409
4460 ! recompute vars : itf
4461 itf = min(ite,ide-1)
4462 ! recompute vars : itf
4463 ! recdepend vars : i_start,itf,j_start,jde,jte
4464 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1410
4465 ! recompute vars : jtf
4466 jtf = min(jte,jde-1)
4467 ! recompute vars : jtf
4468 ! recdepend vars : config_flags,i_start,itf,j_start,jds,jtf,jts
4469 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:1412
4470 ! recompute vars : j_start
4471 if (config_flags%open_ys .and. jts .eq. jds) then
4472 j_start = jts+1
4473 endif
4474 ! recompute vars : j_start
4475 ! recdepend vars : config_flags,i_start,itf,j_start,jde,jte,jtf
4476 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:1413
4477 ! recompute vars : jtf
4478 if (config_flags%open_ye .and. jte .eq. jde) then
4479 jtf = jtf-1
4480 endif
4481 ! recompute vars : jtf
4482 do j = jtf, j_start, -1
4483 k = kte
4484 ! recompute : k
4485 do i = i_start, itf
4486 a_muv(i,j+1) = a_muv(i,j+1)-0.5*a_ph_tend(i,k,j)*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+&
4487 &1)-ph(i,k,j))
4488 a_muv(i,j) = a_muv(i,j)-0.5*a_ph_tend(i,k,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,&
4489 &j-1))
4490 a_ph(i,k,j-1) = a_ph(i,k,j-1)+0.5*a_ph_tend(i,k,j)*rdy*muv(i,j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j))
4491 a_ph(i,k,j+1) = a_ph(i,k,j+1)-0.5*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))
4492 a_ph(i,k,j) = a_ph(i,k,j)-0.5*a_ph_tend(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-&
4493 &1,j)+cfn1*v(i,k-2,j)))
4494 a_v(i,k-2,j+1) = a_v(i,k-2,j+1)-0.5*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*cfn1*(phb(i,k,j+1)-phb(i,k,j)+ph(i,k,j+1)-ph(i,k,j))
4495 a_v(i,k-2,j) = a_v(i,k-2,j)-0.5*a_ph_tend(i,k,j)*rdy*muv(i,j)*cfn1*(phb(i,k,j)-phb(i,k,j-1)+ph(i,k,j)-ph(i,k,j-1))
4496 a_v(i,k-1,j+1) = a_v(i,k-1,j+1)-0.5*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*cfn*(phb(i,k,j+1)-phb(i,k,j)+ph(i,k,j+1)-ph(i,k,j))
4497 a_v(i,k-1,j) = a_v(i,k-1,j)-0.5*a_ph_tend(i,k,j)*rdy*muv(i,j)*cfn*(phb(i,k,j)-phb(i,k,j-1)+ph(i,k,j)-ph(i,k,j-1))
4498 end do
4499 do k = 2, kte-1
4500 do i = i_start, itf
4501 a_muv(i,j+1) = a_muv(i,j+1)-0.25*a_ph_tend(i,k,j)*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,&
4502 &k,j))
4503 a_muv(i,j) = a_muv(i,j)-0.25*a_ph_tend(i,k,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))
4504 a_ph(i,k,j-1) = a_ph(i,k,j-1)+0.25*a_ph_tend(i,k,j)*rdy*muv(i,j)*(v(i,k,j)+v(i,k-1,j))
4505 a_ph(i,k,j+1) = a_ph(i,k,j+1)-0.25*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))
4506 a_ph(i,k,j) = a_ph(i,k,j)-0.25*a_ph_tend(i,k,j)*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,&
4507 &j)))
4508 a_v(i,k-1,j+1) = a_v(i,k-1,j+1)-0.25*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*(phb(i,k,j+1)-phb(i,k,j)+ph(i,k,j+1)-ph(i,k,j))
4509 a_v(i,k-1,j) = a_v(i,k-1,j)-0.25*a_ph_tend(i,k,j)*rdy*muv(i,j)*(phb(i,k,j)-phb(i,k,j-1)+ph(i,k,j)-ph(i,k,j-1))
4510 a_v(i,k,j+1) = a_v(i,k,j+1)-0.25*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*(phb(i,k,j+1)-phb(i,k,j)+ph(i,k,j+1)-ph(i,k,j))
4511 a_v(i,k,j) = a_v(i,k,j)-0.25*a_ph_tend(i,k,j)*rdy*muv(i,j)*(phb(i,k,j)-phb(i,k,j-1)+ph(i,k,j)-ph(i,k,j-1))
4512 end do
4513 end do
4514 end do
4515 else if (advective_order .le. 4) then
4516 i_start = its
4517 ! recompute : i_start
4518 j_start = jts
4519 ! recompute : j_start
4520 itf = min(ite,ide-1)
4521 ! recompute : itf
4522 jtf = min(jte,jde-1)
4523 ! recompute : jtf
4524 if (config_flags%open_xs .and. its .eq. ids) then
4525 i_start = its+1
4526 endif
4527 ! recompute : i_start
4528 if (config_flags%open_xe .and. ite .eq. ide) then
4529 itf = itf-1
4530 endif
4531 ! recompute : itf
4532 do j = jtf, j_start, -1
4533 k = kte
4534 ! recompute : k
4535 do i = i_start, itf
4536 a_muu(i+1,j) = a_muu(i+1,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*(8.*(ph(i+1,k,j)-ph(i-&
4537 &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)))
4538 a_muu(i,j) = a_muu(i,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-&
4539 &(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)))
4540 a_ph(i-2,k,j) = a_ph(i-2,k,j)-0.083333333*0.5*a_ph_tend(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)*&
4541 &(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4542 a_ph(i-1,k,j) = a_ph(i-1,k,j)-(-0.66666667)*0.5*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,&
4543 &j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4544 a_ph(i+2,k,j) = a_ph(i+2,k,j)-(-0.083333333)*0.5*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,&
4545 &j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4546 a_ph(i+1,k,j) = a_ph(i+1,k,j)-0.66666667*0.5*a_ph_tend(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)*&
4547 &(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4548 a_u(i+1,k-2,j) = a_u(i+1,k-2,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*cfn1*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,&
4549 &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)))
4550 a_u(i,k-2,j) = a_u(i,k-2,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*muu(i,j)*cfn1*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-&
4551 &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)))
4552 a_u(i+1,k-1,j) = a_u(i+1,k-1,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*cfn*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,&
4553 &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)))
4554 a_u(i,k-1,j) = a_u(i,k-1,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*muu(i,j)*cfn*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-&
4555 &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)))
4556 end do
4557 do k = 2, kte-1
4558 do i = i_start, itf
4559 a_muu(i+1,j) = a_muu(i+1,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*(u(i+1,k,j)+u(i+1,k-1,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-&
4560 &(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)))
4561 a_muu(i,j) = a_muu(i,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*(u(i,k,j)+u(i,k-1,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,&
4562 &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)))
4563 a_ph(i-2,k,j) = a_ph(i-2,k,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,&
4564 &j)+u(i,k-1,j)))
4565 a_ph(i-1,k,j) = a_ph(i-1,k,j)-(-0.66666667)*0.25*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,&
4566 &k,j)+u(i,k-1,j)))
4567 a_ph(i+2,k,j) = a_ph(i+2,k,j)-(-0.083333333)*0.25*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,&
4568 &k,j)+u(i,k-1,j)))
4569 a_ph(i+1,k,j) = a_ph(i+1,k,j)-0.66666667*0.25*a_ph_tend(i,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)&
4570 &+u(i,k-1,j)))
4571 a_u(i+1,k-1,j) = a_u(i+1,k-1,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)&
4572 &-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)))
4573 a_u(i,k-1,j) = a_u(i,k-1,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*muu(i,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-&
4574 &2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
4575 a_u(i+1,k,j) = a_u(i+1,k,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-&
4576 &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)))
4577 a_u(i,k,j) = a_u(i,k,j)-0.083333333*0.25*a_ph_tend(i,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,&
4578 &j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
4579 end do
4580 end do
4581 end do
4582 ! recdepend vars : its
4583 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1475
4584 ! recompute vars : i_start
4585 i_start = its
4586 ! recompute vars : i_start
4587 ! recdepend vars : i_start,jts
4588 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1476
4589 ! recompute vars : j_start
4590 j_start = jts
4591 ! recompute vars : j_start
4592 ! recdepend vars : i_start,ide,ite,j_start
4593 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1477
4594 ! recompute vars : itf
4595 itf = min(ite,ide-1)
4596 ! recompute vars : itf
4597 ! recdepend vars : i_start,itf,j_start,jde,jte
4598 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1478
4599 ! recompute vars : jtf
4600 jtf = min(jte,jde-1)
4601 ! recompute vars : jtf
4602 ! recdepend vars : config_flags,i_start,itf,j_start,jds,jtf,jts
4603 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:1480
4604 ! recompute vars : j_start
4605 if (config_flags%open_ys .and. jts .eq. jds) then
4606 j_start = jts+1
4607 endif
4608 ! recompute vars : j_start
4609 ! recdepend vars : config_flags,i_start,itf,j_start,jde,jte,jtf
4610 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:1481
4611 ! recompute vars : jtf
4612 if (config_flags%open_ye .and. jte .eq. jde) then
4613 jtf = jtf-1
4614 endif
4615 ! recompute vars : jtf
4616 do j = jtf, j_start, -1
4617 k = kte
4618 ! recompute : k
4619 do i = i_start, itf
4620 a_muv(i,j+1) = a_muv(i,j+1)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*(8.*(ph(i,k,j+1)-ph(i,&
4621 &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)))
4622 a_muv(i,j) = a_muv(i,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-&
4623 &(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)))
4624 a_ph(i,k,j-2) = a_ph(i,k,j-2)-0.083333333*0.5*a_ph_tend(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)*&
4625 &(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
4626 a_ph(i,k,j-1) = a_ph(i,k,j-1)-(-0.66666667)*0.5*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,&
4627 &j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
4628 a_ph(i,k,j+2) = a_ph(i,k,j+2)-(-0.083333333)*0.5*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,&
4629 &j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
4630 a_ph(i,k,j+1) = a_ph(i,k,j+1)-0.66666667*0.5*a_ph_tend(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)*&
4631 &(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
4632 a_v(i,k-2,j+1) = a_v(i,k-2,j+1)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*cfn1*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+&
4633 &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)))
4634 a_v(i,k-2,j) = a_v(i,k-2,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j)*cfn1*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-&
4635 &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)))
4636 a_v(i,k-1,j+1) = a_v(i,k-1,j+1)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*cfn*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+&
4637 &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)))
4638 a_v(i,k-1,j) = a_v(i,k-1,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j)*cfn*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-&
4639 &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)))
4640 end do
4641 do k = 2, kte-1
4642 do i = i_start, itf
4643 a_muv(i,j+1) = a_muv(i,j+1)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*(v(i,k,j+1)+v(i,k-1,j+1))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-&
4644 &(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)))
4645 a_muv(i,j) = a_muv(i,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*(v(i,k,j)+v(i,k-1,j))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,&
4646 &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)))
4647 a_ph(i,k,j-2) = a_ph(i,k,j-2)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,&
4648 &j)+v(i,k-1,j)))
4649 a_ph(i,k,j-1) = a_ph(i,k,j-1)-(-0.66666667)*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,&
4650 &k,j)+v(i,k-1,j)))
4651 a_ph(i,k,j+2) = a_ph(i,k,j+2)-(-0.083333333)*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,&
4652 &k,j)+v(i,k-1,j)))
4653 a_ph(i,k,j+1) = a_ph(i,k,j+1)-0.66666667*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)&
4654 &+v(i,k-1,j)))
4655 a_v(i,k-1,j+1) = a_v(i,k-1,j+1)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)&
4656 &-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)))
4657 a_v(i,k-1,j) = a_v(i,k-1,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*muv(i,j)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,&
4658 &k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
4659 a_v(i,k,j+1) = a_v(i,k,j+1)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-&
4660 &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)))
4661 a_v(i,k,j) = a_v(i,k,j)-0.083333333*0.25*a_ph_tend(i,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-&
4662 &2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
4663 end do
4664 end do
4665 end do
4666 else if (advective_order .le. 6) then
4667 i_start = its
4668 ! recompute : i_start
4669 j_start = jts
4670 ! recompute : j_start
4671 itf = min(ite,ide-1)
4672 ! recompute : itf
4673 jtf = min(jte,jde-1)
4674 ! recompute : jtf
4675 if (config_flags%open_xs .or. specified) then
4676 i_start = max(its,ids+2)
4677 endif
4678 ! recompute : i_start
4679 if (config_flags%open_xe .or. specified) then
4680 itf = min(itf,ide-3)
4681 endif
4682 ! recompute : itf
4683 if (config_flags%open_xe .and. ite .ge. ide-2) then
4684 i = ide-2
4685 ! recompute : i
4686 do j = jtf, j_start, -1
4687 k = kte
4688 ! recompute : k
4689 a_muu(i+1,j) = a_muu(i+1,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*(8.*(ph(i+1,k,j)-ph(i-&
4690 &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)))
4691 a_muu(i,j) = a_muu(i,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-&
4692 &(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)))
4693 a_ph(i-2,k,j) = a_ph(i-2,k,j)-0.083333333*0.5*a_ph_tend(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)*&
4694 &(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4695 a_ph(i-1,k,j) = a_ph(i-1,k,j)-(-0.66666667)*0.5*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,&
4696 &j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4697 a_ph(i+2,k,j) = a_ph(i+2,k,j)-(-0.083333333)*0.5*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,&
4698 &j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4699 a_ph(i+1,k,j) = a_ph(i+1,k,j)-0.66666667*0.5*a_ph_tend(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)*&
4700 &(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4701 a_u(i+1,k-2,j) = a_u(i+1,k-2,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*cfn1*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,&
4702 &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)))
4703 a_u(i,k-2,j) = a_u(i,k-2,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*muu(i,j)*cfn1*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-&
4704 &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)))
4705 a_u(i+1,k-1,j) = a_u(i+1,k-1,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*cfn*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,&
4706 &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)))
4707 a_u(i,k-1,j) = a_u(i,k-1,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*muu(i,j)*cfn*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-&
4708 &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)))
4709 do k = 2, kte-1
4710 a_muu(i+1,j) = a_muu(i+1,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*(u(i+1,k,j)+u(i+1,k-1,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-&
4711 &(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)))
4712 a_muu(i,j) = a_muu(i,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*(u(i,k,j)+u(i,k-1,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,&
4713 &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)))
4714 a_ph(i-2,k,j) = a_ph(i-2,k,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,&
4715 &j)+u(i,k-1,j)))
4716 a_ph(i-1,k,j) = a_ph(i-1,k,j)-(-0.66666667)*0.25*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,&
4717 &k,j)+u(i,k-1,j)))
4718 a_ph(i+2,k,j) = a_ph(i+2,k,j)-(-0.083333333)*0.25*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,&
4719 &k,j)+u(i,k-1,j)))
4720 a_ph(i+1,k,j) = a_ph(i+1,k,j)-0.66666667*0.25*a_ph_tend(i,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)&
4721 &+u(i,k-1,j)))
4722 a_u(i+1,k-1,j) = a_u(i+1,k-1,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)&
4723 &-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)))
4724 a_u(i,k-1,j) = a_u(i,k-1,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*muu(i,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-&
4725 &2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
4726 a_u(i+1,k,j) = a_u(i+1,k,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-&
4727 &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)))
4728 a_u(i,k,j) = a_u(i,k,j)-0.083333333*0.25*a_ph_tend(i,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,&
4729 &j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
4730 end do
4731 end do
4732 endif
4733 if (config_flags%open_xs .and. its .le. ids+1) then
4734 i = ids+1
4735 ! recompute : i
4736 do j = jtf, j_start, -1
4737 k = kte
4738 ! recompute : k
4739 a_muu(i+1,j) = a_muu(i+1,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*(8.*(ph(i+1,k,j)-ph(i-&
4740 &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)))
4741 a_muu(i,j) = a_muu(i,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-&
4742 &(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)))
4743 a_ph(i-2,k,j) = a_ph(i-2,k,j)-0.083333333*0.5*a_ph_tend(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)*&
4744 &(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4745 a_ph(i-1,k,j) = a_ph(i-1,k,j)-(-0.66666667)*0.5*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,&
4746 &j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4747 a_ph(i+2,k,j) = a_ph(i+2,k,j)-(-0.083333333)*0.5*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,&
4748 &j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4749 a_ph(i+1,k,j) = a_ph(i+1,k,j)-0.66666667*0.5*a_ph_tend(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)*&
4750 &(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4751 a_u(i+1,k-2,j) = a_u(i+1,k-2,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*cfn1*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,&
4752 &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)))
4753 a_u(i,k-2,j) = a_u(i,k-2,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*muu(i,j)*cfn1*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-&
4754 &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)))
4755 a_u(i+1,k-1,j) = a_u(i+1,k-1,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*cfn*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,&
4756 &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)))
4757 a_u(i,k-1,j) = a_u(i,k-1,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdx*muu(i,j)*cfn*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-&
4758 &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)))
4759 do k = 2, kte-1
4760 a_muu(i+1,j) = a_muu(i+1,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*(u(i+1,k,j)+u(i+1,k-1,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-&
4761 &(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)))
4762 a_muu(i,j) = a_muu(i,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*(u(i,k,j)+u(i,k-1,j))*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,&
4763 &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)))
4764 a_ph(i-2,k,j) = a_ph(i-2,k,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,&
4765 &j)+u(i,k-1,j)))
4766 a_ph(i-1,k,j) = a_ph(i-1,k,j)-(-0.66666667)*0.25*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,&
4767 &k,j)+u(i,k-1,j)))
4768 a_ph(i+2,k,j) = a_ph(i+2,k,j)-(-0.083333333)*0.25*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,&
4769 &k,j)+u(i,k-1,j)))
4770 a_ph(i+1,k,j) = a_ph(i+1,k,j)-0.66666667*0.25*a_ph_tend(i,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)&
4771 &+u(i,k-1,j)))
4772 a_u(i+1,k-1,j) = a_u(i+1,k-1,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)&
4773 &-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)))
4774 a_u(i,k-1,j) = a_u(i,k-1,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*muu(i,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-ph(i-&
4775 &2,k,j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
4776 a_u(i+1,k,j) = a_u(i+1,k,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*(8.*(ph(i+1,k,j)-ph(i-1,k,j))-(ph(i+2,k,j)-&
4777 &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)))
4778 a_u(i,k,j) = a_u(i,k,j)-0.083333333*0.25*a_ph_tend(i,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,&
4779 &j))+8.*(phb(i+1,k,j)-phb(i-1,k,j))-(phb(i+2,k,j)-phb(i-2,k,j)))
4780 end do
4781 end do
4782 endif
4783 do j = jtf, j_start, -1
4784 k = kte
4785 ! recompute : k
4786 do i = i_start, itf
4787 a_muu(i+1,j) = a_muu(i+1,j)-0.016666667*0.5*a_ph_tend(i,k,j)*rdx*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*(45.*(ph(i+1,k,j)-ph(i-&
4788 &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.*(phb(i+2,k,j)-phb(i-2,k,j))+&
4789 &phb(i+3,k,j)-phb(i-3,k,j))
4790 a_muu(i,j) = a_muu(i,j)-0.016666667*0.5*a_ph_tend(i,k,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))-&
4791 &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,&
4792 &k,j)-phb(i-3,k,j))
4793 a_ph(i-3,k,j) = a_ph(i-3,k,j)-(-0.016666667)*0.5*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))+muu(i,&
4794 &j)*(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4795 a_ph(i-2,k,j) = a_ph(i-2,k,j)-0.15*0.5*a_ph_tend(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*&
4796 &u(i,k-1,j)+cfn1*u(i,k-2,j)))
4797 a_ph(i-1,k,j) = a_ph(i-1,k,j)-(-0.75)*0.5*a_ph_tend(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)*&
4798 &(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4799 a_ph(i+3,k,j) = a_ph(i+3,k,j)-0.016666667*0.5*a_ph_tend(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)*&
4800 &(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4801 a_ph(i+2,k,j) = a_ph(i+2,k,j)-(-0.15)*0.5*a_ph_tend(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)*&
4802 &(cfn*u(i,k-1,j)+cfn1*u(i,k-2,j)))
4803 a_ph(i+1,k,j) = a_ph(i+1,k,j)-0.75*0.5*a_ph_tend(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*&
4804 &u(i,k-1,j)+cfn1*u(i,k-2,j)))
4805 a_u(i+1,k-2,j) = a_u(i+1,k-2,j)-0.016666667*0.5*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*cfn1*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+&
4806 &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)-&
4807 &phb(i-3,k,j))
4808 a_u(i,k-2,j) = a_u(i,k-2,j)-0.016666667*0.5*a_ph_tend(i,k,j)*rdx*muu(i,j)*cfn1*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)&
4809 &-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,k,j))
4810 a_u(i+1,k-1,j) = a_u(i+1,k-1,j)-0.016666667*0.5*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*cfn*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+&
4811 &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)-&
4812 &phb(i-3,k,j))
4813 a_u(i,k-1,j) = a_u(i,k-1,j)-0.016666667*0.5*a_ph_tend(i,k,j)*rdx*muu(i,j)*cfn*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)-&
4814 &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,k,j))
4815 end do
4816 do k = 2, kte-1
4817 do i = i_start, itf
4818 a_muu(i+1,j) = a_muu(i+1,j)-0.016666667*0.25*a_ph_tend(i,k,j)*rdx*(u(i+1,k,j)+u(i+1,k-1,j))*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-&
4819 &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+&
4820 &3,k,j)-phb(i-3,k,j))
4821 a_muu(i,j) = a_muu(i,j)-0.016666667*0.25*a_ph_tend(i,k,j)*rdx*(u(i,k,j)+u(i,k-1,j))*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*&
4822 &(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,&
4823 &k,j)-phb(i-3,k,j))
4824 a_ph(i-3,k,j) = a_ph(i-3,k,j)-(-0.016666667)*0.25*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,&
4825 &k,j)+u(i,k-1,j)))
4826 a_ph(i-2,k,j) = a_ph(i-2,k,j)-0.15*0.25*a_ph_tend(i,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,&
4827 &k-1,j)))
4828 a_ph(i-1,k,j) = a_ph(i-1,k,j)-(-0.75)*0.25*a_ph_tend(i,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)+&
4829 &u(i,k-1,j)))
4830 a_ph(i+3,k,j) = a_ph(i+3,k,j)-0.016666667*0.25*a_ph_tend(i,k,j)*rdx*(muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))+muu(i,j)*(u(i,k,&
4831 &j)+u(i,k-1,j)))
4832 a_ph(i+2,k,j) = a_ph(i+2,k,j)-(-0.15)*0.25*a_ph_tend(i,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)+&
4833 &u(i,k-1,j)))
4834 a_ph(i+1,k,j) = a_ph(i+1,k,j)-0.75*0.25*a_ph_tend(i,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,&
4835 &k-1,j)))
4836 a_u(i+1,k-1,j) = a_u(i+1,k-1,j)-0.016666667*0.25*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,&
4837 &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)-phb(i-3,k,j))
4838 a_u(i,k-1,j) = a_u(i,k-1,j)-0.016666667*0.25*a_ph_tend(i,k,j)*rdx*muu(i,j)*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)-&
4839 &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,k,j))
4840 a_u(i+1,k,j) = a_u(i+1,k,j)-0.016666667*0.25*a_ph_tend(i,k,j)*rdx*muu(i+1,j)*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)&
4841 &-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,k,j))
4842 a_u(i,k,j) = a_u(i,k,j)-0.016666667*0.25*a_ph_tend(i,k,j)*rdx*muu(i,j)*(45.*(ph(i+1,k,j)-ph(i-1,k,j))-9.*(ph(i+2,k,j)-ph(i-&
4843 &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))
4844 end do
4845 end do
4846 end do
4847 ! recdepend vars : its
4848 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1555
4849 ! recompute vars : i_start
4850 i_start = its
4851 ! recompute vars : i_start
4852 ! recdepend vars : i_start,ide,ite
4853 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1557
4854 ! recompute vars : itf
4855 itf = min(ite,ide-1)
4856 ! recompute vars : itf
4857 if (config_flags%open_ye .and. jte .ge. jde-2) then
4858 j = jde-2
4859 ! recompute : j
4860 k = kte
4861 ! recompute : k
4862 do i = i_start, itf
4863 a_muv(i,j+1) = a_muv(i,j+1)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*(8.*(ph(i,k,j+1)-ph(i,&
4864 &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)))
4865 a_muv(i,j) = a_muv(i,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-&
4866 &(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)))
4867 a_ph(i,k,j-2) = a_ph(i,k,j-2)-0.083333333*0.5*a_ph_tend(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)*&
4868 &(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
4869 a_ph(i,k,j-1) = a_ph(i,k,j-1)-(-0.66666667)*0.5*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,&
4870 &j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
4871 a_ph(i,k,j+2) = a_ph(i,k,j+2)-(-0.083333333)*0.5*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,&
4872 &j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
4873 a_ph(i,k,j+1) = a_ph(i,k,j+1)-0.66666667*0.5*a_ph_tend(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)*&
4874 &(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
4875 a_v(i,k-2,j+1) = a_v(i,k-2,j+1)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*cfn1*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+&
4876 &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)))
4877 a_v(i,k-2,j) = a_v(i,k-2,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j)*cfn1*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-&
4878 &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)))
4879 a_v(i,k-1,j+1) = a_v(i,k-1,j+1)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*cfn*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+&
4880 &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)))
4881 a_v(i,k-1,j) = a_v(i,k-1,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j)*cfn*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-&
4882 &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)))
4883 end do
4884 do k = 2, kte-1
4885 do i = i_start, itf
4886 a_muv(i,j+1) = a_muv(i,j+1)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*(v(i,k,j+1)+v(i,k-1,j+1))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-&
4887 &(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)))
4888 a_muv(i,j) = a_muv(i,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*(v(i,k,j)+v(i,k-1,j))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,&
4889 &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)))
4890 a_ph(i,k,j-2) = a_ph(i,k,j-2)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,&
4891 &j)+v(i,k-1,j)))
4892 a_ph(i,k,j-1) = a_ph(i,k,j-1)-(-0.66666667)*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,&
4893 &k,j)+v(i,k-1,j)))
4894 a_ph(i,k,j+2) = a_ph(i,k,j+2)-(-0.083333333)*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,&
4895 &k,j)+v(i,k-1,j)))
4896 a_ph(i,k,j+1) = a_ph(i,k,j+1)-0.66666667*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)&
4897 &+v(i,k-1,j)))
4898 a_v(i,k-1,j+1) = a_v(i,k-1,j+1)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)&
4899 &-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)))
4900 a_v(i,k-1,j) = a_v(i,k-1,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*muv(i,j)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,&
4901 &k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
4902 a_v(i,k,j+1) = a_v(i,k,j+1)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-&
4903 &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)))
4904 a_v(i,k,j) = a_v(i,k,j)-0.083333333*0.25*a_ph_tend(i,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-&
4905 &2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
4906 end do
4907 end do
4908 endif
4909 ! recdepend vars : its
4910 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1555
4911 ! recompute vars : i_start
4912 i_start = its
4913 ! recompute vars : i_start
4914 ! recdepend vars : i_start,ide,ite
4915 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1557
4916 ! recompute vars : itf
4917 itf = min(ite,ide-1)
4918 ! recompute vars : itf
4919 if (config_flags%open_ys .and. jts .le. jds+1) then
4920 j = jds+1
4921 ! recompute : j
4922 k = kte
4923 ! recompute : k
4924 do i = i_start, itf
4925 a_muv(i,j+1) = a_muv(i,j+1)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*(8.*(ph(i,k,j+1)-ph(i,&
4926 &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)))
4927 a_muv(i,j) = a_muv(i,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-&
4928 &(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)))
4929 a_ph(i,k,j-2) = a_ph(i,k,j-2)-0.083333333*0.5*a_ph_tend(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)*&
4930 &(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
4931 a_ph(i,k,j-1) = a_ph(i,k,j-1)-(-0.66666667)*0.5*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,&
4932 &j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
4933 a_ph(i,k,j+2) = a_ph(i,k,j+2)-(-0.083333333)*0.5*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,&
4934 &j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
4935 a_ph(i,k,j+1) = a_ph(i,k,j+1)-0.66666667*0.5*a_ph_tend(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)*&
4936 &(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
4937 a_v(i,k-2,j+1) = a_v(i,k-2,j+1)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*cfn1*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+&
4938 &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)))
4939 a_v(i,k-2,j) = a_v(i,k-2,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j)*cfn1*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-&
4940 &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)))
4941 a_v(i,k-1,j+1) = a_v(i,k-1,j+1)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*cfn*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+&
4942 &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)))
4943 a_v(i,k-1,j) = a_v(i,k-1,j)-0.083333333*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j)*cfn*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-&
4944 &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)))
4945 end do
4946 do k = 2, kte-1
4947 do i = i_start, itf
4948 a_muv(i,j+1) = a_muv(i,j+1)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*(v(i,k,j+1)+v(i,k-1,j+1))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-&
4949 &(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)))
4950 a_muv(i,j) = a_muv(i,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*(v(i,k,j)+v(i,k-1,j))*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,&
4951 &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)))
4952 a_ph(i,k,j-2) = a_ph(i,k,j-2)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,&
4953 &j)+v(i,k-1,j)))
4954 a_ph(i,k,j-1) = a_ph(i,k,j-1)-(-0.66666667)*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,&
4955 &k,j)+v(i,k-1,j)))
4956 a_ph(i,k,j+2) = a_ph(i,k,j+2)-(-0.083333333)*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,&
4957 &k,j)+v(i,k-1,j)))
4958 a_ph(i,k,j+1) = a_ph(i,k,j+1)-0.66666667*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)&
4959 &+v(i,k-1,j)))
4960 a_v(i,k-1,j+1) = a_v(i,k-1,j+1)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)&
4961 &-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)))
4962 a_v(i,k-1,j) = a_v(i,k-1,j)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*muv(i,j)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-ph(i,&
4963 &k,j-2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
4964 a_v(i,k,j+1) = a_v(i,k,j+1)-0.083333333*0.25*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*(8.*(ph(i,k,j+1)-ph(i,k,j-1))-(ph(i,k,j+2)-&
4965 &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)))
4966 a_v(i,k,j) = a_v(i,k,j)-0.083333333*0.25*a_ph_tend(i,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-&
4967 &2))+8.*(phb(i,k,j+1)-phb(i,k,j-1))-(phb(i,k,j+2)-phb(i,k,j-2)))
4968 end do
4969 end do
4970 endif
4971 ! recdepend vars : its
4972 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1555
4973 ! recompute vars : i_start
4974 i_start = its
4975 ! recompute vars : i_start
4976 ! recdepend vars : i_start,jts
4977 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1556
4978 ! recompute vars : j_start
4979 j_start = jts
4980 ! recompute vars : j_start
4981 ! recdepend vars : i_start,ide,ite,j_start
4982 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1557
4983 ! recompute vars : itf
4984 itf = min(ite,ide-1)
4985 ! recompute vars : itf
4986 ! recdepend vars : i_start,itf,j_start,jde,jte
4987 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1558
4988 ! recompute vars : jtf
4989 jtf = min(jte,jde-1)
4990 ! recompute vars : jtf
4991 ! recdepend vars : config_flags,i_start,itf,j_start,jds,jtf,jts,specifi
4992 ! ed
4993 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:1563
4994 ! recompute vars : j_start
4995 if (config_flags%open_ys .or. specified) then
4996 j_start = max(jts,jds+2)
4997 endif
4998 ! recompute vars : j_start
4999 ! recdepend vars : config_flags,i_start,itf,j_start,jde,jtf,specified
5000 ! recompute pos : IF_STMT module_big_step_utilities_em.f90:1564
5001 ! recompute vars : jtf
5002 if (config_flags%open_ye .or. specified) then
5003 jtf = min(jtf,jde-3)
5004 endif
5005 ! recompute vars : jtf
5006 do j = jtf, j_start, -1
5007 k = kte
5008 ! recompute : k
5009 do i = i_start, itf
5010 a_muv(i,j+1) = a_muv(i,j+1)-0.016666667*0.5*a_ph_tend(i,k,j)*rdy*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*(45.*(ph(i,k,j+1)-ph(i,&
5011 &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.*(phb(i,k,j+2)-phb(i,k,j-2))+&
5012 &phb(i,k,j+3)-phb(i,k,j-3))
5013 a_muv(i,j) = a_muv(i,j)-0.016666667*0.5*a_ph_tend(i,k,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))-&
5014 &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,&
5015 &j+3)-phb(i,k,j-3))
5016 a_ph(i,k,j-3) = a_ph(i,k,j-3)-(-0.016666667)*0.5*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))+muv(i,&
5017 &j)*(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
5018 a_ph(i,k,j-2) = a_ph(i,k,j-2)-0.15*0.5*a_ph_tend(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*&
5019 &v(i,k-1,j)+cfn1*v(i,k-2,j)))
5020 a_ph(i,k,j-1) = a_ph(i,k,j-1)-(-0.75)*0.5*a_ph_tend(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)*&
5021 &(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
5022 a_ph(i,k,j+3) = a_ph(i,k,j+3)-0.016666667*0.5*a_ph_tend(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)*&
5023 &(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
5024 a_ph(i,k,j+2) = a_ph(i,k,j+2)-(-0.15)*0.5*a_ph_tend(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)*&
5025 &(cfn*v(i,k-1,j)+cfn1*v(i,k-2,j)))
5026 a_ph(i,k,j+1) = a_ph(i,k,j+1)-0.75*0.5*a_ph_tend(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*&
5027 &v(i,k-1,j)+cfn1*v(i,k-2,j)))
5028 a_v(i,k-2,j+1) = a_v(i,k-2,j+1)-0.016666667*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*cfn1*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,&
5029 &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)-&
5030 &phb(i,k,j-3))
5031 a_v(i,k-2,j) = a_v(i,k-2,j)-0.016666667*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j)*cfn1*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)&
5032 &-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,j-3))
5033 a_v(i,k-1,j+1) = a_v(i,k-1,j+1)-0.016666667*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*cfn*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,&
5034 &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)-&
5035 &phb(i,k,j-3))
5036 a_v(i,k-1,j) = a_v(i,k-1,j)-0.016666667*0.5*a_ph_tend(i,k,j)*rdy*muv(i,j)*cfn*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)-&
5037 &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,j-3))
5038 end do
5039 do k = 2, kte-1
5040 do i = i_start, itf
5041 a_muv(i,j+1) = a_muv(i,j+1)-0.016666667*0.25*a_ph_tend(i,k,j)*rdy*(v(i,k,j+1)+v(i,k-1,j+1))*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-&
5042 &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,&
5043 &k,j+3)-phb(i,k,j-3))
5044 a_muv(i,j) = a_muv(i,j)-0.016666667*0.25*a_ph_tend(i,k,j)*rdy*(v(i,k,j)+v(i,k-1,j))*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*&
5045 &(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,&
5046 &j+3)-phb(i,k,j-3))
5047 a_ph(i,k,j-3) = a_ph(i,k,j-3)-(-0.016666667)*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,&
5048 &k,j)+v(i,k-1,j)))
5049 a_ph(i,k,j-2) = a_ph(i,k,j-2)-0.15*0.25*a_ph_tend(i,k,j)*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,&
5050 &k-1,j)))
5051 a_ph(i,k,j-1) = a_ph(i,k,j-1)-(-0.75)*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+&
5052 &v(i,k-1,j)))
5053 a_ph(i,k,j+3) = a_ph(i,k,j+3)-0.016666667*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,&
5054 &j)+v(i,k-1,j)))
5055 a_ph(i,k,j+2) = a_ph(i,k,j+2)-(-0.15)*0.25*a_ph_tend(i,k,j)*rdy*(muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))+muv(i,j)*(v(i,k,j)+&
5056 &v(i,k-1,j)))
5057 a_ph(i,k,j+1) = a_ph(i,k,j+1)-0.75*0.25*a_ph_tend(i,k,j)*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,&
5058 &k-1,j)))
5059 a_v(i,k-1,j+1) = a_v(i,k-1,j+1)-0.016666667*0.25*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,&
5060 &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)-phb(i,k,j-3))
5061 a_v(i,k-1,j) = a_v(i,k-1,j)-0.016666667*0.25*a_ph_tend(i,k,j)*rdy*muv(i,j)*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)-&
5062 &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,j-3))
5063 a_v(i,k,j+1) = a_v(i,k,j+1)-0.016666667*0.25*a_ph_tend(i,k,j)*rdy*muv(i,j+1)*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)&
5064 &-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,j-3))
5065 a_v(i,k,j) = a_v(i,k,j)-0.016666667*0.25*a_ph_tend(i,k,j)*rdy*muv(i,j)*(45.*(ph(i,k,j+1)-ph(i,k,j-1))-9.*(ph(i,k,j+2)-ph(i,&
5066 &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))
5067 end do
5068 end do
5069 end do
5070 endif
5071 ! recdepend vars : ide,ite
5072 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1362
5073 ! recompute vars : itf
5074 itf = min(ite,ide-1)
5075 ! recompute vars : itf
5076 ! recdepend vars : itf,jde,jte
5077 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1363
5078 ! recompute vars : jtf
5079 jtf = min(jte,jde-1)
5080 ! recompute vars : jtf
5081 if (non_hydrostatic) then
5082 do j = jts, jtf
5083 do k = 2, kte
5084 do i = its, itf
5085 a_mut(i,j) = a_mut(i,j)+a_ph_tend(i,k,j)*(g*w(i,k,j)/msft(i,j))
5086 a_w(i,k,j) = a_w(i,k,j)+a_ph_tend(i,k,j)*(mut(i,j)*g/msft(i,j))
5087 end do
5088 end do
5089 do i = its, itf
5090 a_ph_tend(i,kde,j) = 0.
5091 end do
5092 end do
5093 endif
5094 ! recdepend vars : ide,ite
5095 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1362
5096 ! recompute vars : itf
5097 itf = min(ite,ide-1)
5098 ! recompute vars : itf
5099 ! recdepend vars : itf,jde,jte
5100 ! recompute pos : ASSIGN_STMT module_big_step_utilities_em.f90:1363
5101 ! recompute vars : jtf
5102 jtf = min(jte,jde-1)
5103 ! recompute vars : jtf
5104 do j = jts, jtf
5105 do k = 2, kte-1
5106 do i = its, itf
5107 a_wdwn(i,k+1) = a_wdwn(i,k+1)-a_ph_tend(i,k,j)*fnm(k)
5108 a_wdwn(i,k) = a_wdwn(i,k)-a_ph_tend(i,k,j)*fnp(k)
5109 end do
5110 end do
5111 do k = 2, kte
5112 do i = its, itf
5113 a_ph(i,k-1,j) = a_ph(i,k-1,j)-0.5*a_wdwn(i,k)*(ww(i,k,j)+ww(i,k-1,j))*rdnw(k-1)
5114 a_ph(i,k,j) = a_ph(i,k,j)+0.5*a_wdwn(i,k)*(ww(i,k,j)+ww(i,k-1,j))*rdnw(k-1)
5115 a_ww(i,k-1,j) = a_ww(i,k-1,j)+0.5*a_wdwn(i,k)*rdnw(k-1)*(ph(i,k,j)-ph(i,k-1,j)+phb(i,k,j)-phb(i,k-1,j))
5116 a_ww(i,k,j) = a_ww(i,k,j)+0.5*a_wdwn(i,k)*rdnw(k-1)*(ph(i,k,j)-ph(i,k-1,j)+phb(i,k,j)-phb(i,k-1,j))
5117 a_wdwn(i,k) = 0.
5118 end do
5119 end do
5120 end do
5121
5122 end subroutine a_rhs_ph
5123
5124
5125 subroutine a_vertical_diffusion( name, field, a_field, a_tendency, alt, a_alt, mut, a_mut, rdn, rdnw, kvdif, ide, jde, kde, ims, &
5126 &ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
5127 !******************************************************************
5128 !******************************************************************
5129 !** This routine was generated by Automatic differentiation. **
5130 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
5131 !******************************************************************
5132 !******************************************************************
5133 !==============================================
5134 ! all entries are defined explicitly
5135 !==============================================
5136 implicit none
5137
5138 !==============================================
5139 ! declare arguments
5140 !==============================================
5141 integer, intent(in) :: ime
5142 integer, intent(in) :: ims
5143 integer, intent(in) :: jme
5144 integer, intent(in) :: jms
5145 integer, intent(in) :: kme
5146 integer, intent(in) :: kms
5147 real, intent(inout) :: a_alt(ims:ime,kms:kme,jms:jme)
5148 real, intent(inout) :: a_field(ims:ime,kms:kme,jms:jme)
5149 real, intent(inout) :: a_mut(ims:ime,jms:jme)
5150 real, intent(inout) :: a_tendency(ims:ime,kms:kme,jms:jme)
5151 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
5152 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
5153 integer, intent(in) :: ide
5154 integer, intent(in) :: ite
5155 integer, intent(in) :: its
5156 integer, intent(in) :: jde
5157 integer, intent(in) :: jte
5158 integer, intent(in) :: jts
5159 integer, intent(in) :: kde
5160 integer, intent(in) :: kte
5161 integer, intent(in) :: kts
5162 real, intent(in) :: kvdif
5163 real, intent(in) :: mut(ims:ime,jms:jme)
5164 character*(1), intent(in) :: name
5165 real, intent(in) :: rdn(kms:kme)
5166 real, intent(in) :: rdnw(kms:kme)
5167
5168 !==============================================
5169 ! declare local variables
5170 !==============================================
5171 real a_vflux(its:ite,0:kte+1)
5172 integer i
5173 integer i_end
5174 integer i_start
5175 integer j
5176 integer j_end
5177 integer j_start
5178 integer k
5179 integer ktf
5180 real vflux(its:ite,0:kte+1)
5181
5182 !----------------------------------------------
5183 ! RESET LOCAL ADJOINT VARIABLES
5184 !----------------------------------------------
5185 a_vflux(:,:) = 0.
5186
5187 !----------------------------------------------
5188 ! ROUTINE BODY
5189 !----------------------------------------------
5190 ktf = min(kte,kde-1)
5191 ! recompute : ktf
5192 if (name .eq. 'w') then
5193 i_start = its
5194 ! recompute : i_start
5195 i_end = min(ite,ide-1)
5196 ! recompute : i_end
5197 j_start = jts
5198 ! recompute : j_start
5199 j_end = min(jte,jde-1)
5200 ! recompute : j_end
5201 do j = j_start, j_end
5202 do k = kts, ktf-1
5203 do i = i_start, i_end
5204 vflux(i,k) = kvdif/alt(i,k,j)*rdnw(k)*(field(i,k+1,j)-field(i,k,j))
5205 end do
5206 end do
5207 do i = i_start, i_end
5208 vflux(i,ktf) = 0.
5209 end do
5210 ! recompute : vflux
5211 do k = kts+1, ktf
5212 do i = i_start, i_end
5213 a_alt(i,k-1,j) = a_alt(i,k-1,j)-a_tendency(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)+&
5214 &alt(i,k-1,j)))*(vflux(i,k)-vflux(i,k-1))
5215 a_alt(i,k,j) = a_alt(i,k,j)-a_tendency(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)+&
5216 &alt(i,k-1,j)))*(vflux(i,k)-vflux(i,k-1))
5217 a_mut(i,j) = a_mut(i,j)-a_tendency(i,k,j)*rdn(k)*g*g/(mut(i,j)*mut(i,j))/(0.5*(alt(i,k,j)+alt(i,k-1,j)))*(vflux(i,k)-&
5218 &vflux(i,k-1))
5219 a_vflux(i,k-1) = a_vflux(i,k-1)-a_tendency(i,k,j)*(rdn(k)*g*g/mut(i,j)/(0.5*(alt(i,k,j)+alt(i,k-1,j))))
5220 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*(rdn(k)*g*g/mut(i,j)/(0.5*(alt(i,k,j)+alt(i,k-1,j))))
5221 end do
5222 end do
5223 do i = i_start, i_end
5224 a_vflux(i,ktf) = 0.
5225 end do
5226 do k = kts, ktf-1
5227 do i = i_start, i_end
5228 a_alt(i,k,j) = a_alt(i,k,j)-a_vflux(i,k)*kvdif/(alt(i,k,j)*alt(i,k,j))*rdnw(k)*(field(i,k+1,j)-field(i,k,j))
5229 a_field(i,k+1,j) = a_field(i,k+1,j)+a_vflux(i,k)*kvdif/alt(i,k,j)*rdnw(k)
5230 a_field(i,k,j) = a_field(i,k,j)-a_vflux(i,k)*kvdif/alt(i,k,j)*rdnw(k)
5231 a_vflux(i,k) = 0.
5232 end do
5233 end do
5234 end do
5235 else if (name .eq. 'm') then
5236 i_start = its
5237 ! recompute : i_start
5238 i_end = min(ite,ide-1)
5239 ! recompute : i_end
5240 j_start = jts
5241 ! recompute : j_start
5242 j_end = min(jte,jde-1)
5243 ! recompute : j_end
5244 do j = j_start, j_end
5245 do k = kts, ktf-1
5246 do i = i_start, i_end
5247 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))
5248 end do
5249 end do
5250 ! recompute : vflux
5251 do i = i_start, i_end
5252 vflux(i,0) = vflux(i,1)
5253 end do
5254 do i = i_start, i_end
5255 vflux(i,ktf) = 0.
5256 end do
5257 ! recompute : vflux
5258 do k = kts, ktf
5259 do i = i_start, i_end
5260 a_alt(i,k,j) = a_alt(i,k,j)-a_tendency(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))
5261 a_mut(i,j) = a_mut(i,j)-a_tendency(i,k,j)*g*g/(mut(i,j)*mut(i,j))/alt(i,k,j)*rdnw(k)*(vflux(i,k)-vflux(i,k-1))
5262 a_vflux(i,k-1) = a_vflux(i,k-1)-a_tendency(i,k,j)*g*g/mut(i,j)/alt(i,k,j)*rdnw(k)
5263 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*g*g/mut(i,j)/alt(i,k,j)*rdnw(k)
5264 end do
5265 end do
5266 do i = i_start, i_end
5267 a_vflux(i,ktf) = 0.
5268 end do
5269 do i = i_start, i_end
5270 a_vflux(i,1) = a_vflux(i,1)+a_vflux(i,0)
5271 a_vflux(i,0) = 0.
5272 end do
5273 do k = kts, ktf-1
5274 do i = i_start, i_end
5275 a_alt(i,k+1,j) = a_alt(i,k+1,j)-a_vflux(i,k)*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)&
5276 &))*(field(i,k+1,j)-field(i,k,j))
5277 a_alt(i,k,j) = a_alt(i,k,j)-a_vflux(i,k)*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)))*&
5278 &(field(i,k+1,j)-field(i,k,j))
5279 a_field(i,k+1,j) = a_field(i,k+1,j)+a_vflux(i,k)*(kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))))
5280 a_field(i,k,j) = a_field(i,k,j)-a_vflux(i,k)*(kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))))
5281 a_vflux(i,k) = 0.
5282 end do
5283 end do
5284 end do
5285 endif
5286
5287 end subroutine a_vertical_diffusion
5288
5289
5290 subroutine a_vertical_diffusion_3dmp( field, a_field, a_tendency, base_3d, alt, a_alt, mut, a_mut, rdn, rdnw, kvdif, ide, jde, kde,&
5291 & ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
5292 !******************************************************************
5293 !******************************************************************
5294 !** This routine was generated by Automatic differentiation. **
5295 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
5296 !******************************************************************
5297 !******************************************************************
5298 !==============================================
5299 ! all entries are defined explicitly
5300 !==============================================
5301 implicit none
5302
5303 !==============================================
5304 ! declare arguments
5305 !==============================================
5306 integer, intent(in) :: ime
5307 integer, intent(in) :: ims
5308 integer, intent(in) :: jme
5309 integer, intent(in) :: jms
5310 integer, intent(in) :: kme
5311 integer, intent(in) :: kms
5312 real, intent(inout) :: a_alt(ims:ime,kms:kme,jms:jme)
5313 real, intent(inout) :: a_field(ims:ime,kms:kme,jms:jme)
5314 real, intent(inout) :: a_mut(ims:ime,jms:jme)
5315 real, intent(inout) :: a_tendency(ims:ime,kms:kme,jms:jme)
5316 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
5317 real, intent(in) :: base_3d(ims:ime,kms:kme,jms:jme)
5318 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
5319 integer, intent(in) :: ide
5320 integer, intent(in) :: ite
5321 integer, intent(in) :: its
5322 integer, intent(in) :: jde
5323 integer, intent(in) :: jte
5324 integer, intent(in) :: jts
5325 integer, intent(in) :: kde
5326 integer, intent(in) :: kte
5327 integer, intent(in) :: kts
5328 real, intent(in) :: kvdif
5329 real, intent(in) :: mut(ims:ime,jms:jme)
5330 real, intent(in) :: rdn(kms:kme)
5331 real, intent(in) :: rdnw(kms:kme)
5332
5333 !==============================================
5334 ! declare local variables
5335 !==============================================
5336 real a_vflux(its:ite,0:kte+1)
5337 integer i
5338 integer i_end
5339 integer i_start
5340 integer j
5341 integer j_end
5342 integer j_start
5343 integer k
5344 integer ktf
5345 real vflux(its:ite,0:kte+1)
5346
5347 !----------------------------------------------
5348 ! RESET LOCAL ADJOINT VARIABLES
5349 !----------------------------------------------
5350 a_vflux(:,:) = 0.
5351
5352 !----------------------------------------------
5353 ! ROUTINE BODY
5354 !----------------------------------------------
5355 ktf = min(kte,kde-1)
5356 ! recompute : ktf
5357 i_start = its
5358 ! recompute : i_start
5359 i_end = min(ite,ide-1)
5360 ! recompute : i_end
5361 j_start = jts
5362 ! recompute : j_start
5363 j_end = min(jte,jde-1)
5364 ! recompute : j_end
5365 do j = j_start, j_end
5366 do k = kts, ktf-1
5367 do i = i_start, i_end
5368 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))
5369 end do
5370 end do
5371 ! recompute : vflux
5372 do i = i_start, i_end
5373 vflux(i,0) = vflux(i,1)
5374 end do
5375 do i = i_start, i_end
5376 vflux(i,ktf) = 0.
5377 end do
5378 ! recompute : vflux
5379 do k = kts, ktf
5380 do i = i_start, i_end
5381 a_alt(i,k,j) = a_alt(i,k,j)-a_tendency(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))
5382 a_mut(i,j) = a_mut(i,j)-a_tendency(i,k,j)*g*g/(mut(i,j)*mut(i,j))/alt(i,k,j)*rdnw(k)*(vflux(i,k)-vflux(i,k-1))
5383 a_vflux(i,k-1) = a_vflux(i,k-1)-a_tendency(i,k,j)*g*g/mut(i,j)/alt(i,k,j)*rdnw(k)
5384 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*g*g/mut(i,j)/alt(i,k,j)*rdnw(k)
5385 end do
5386 end do
5387 do i = i_start, i_end
5388 a_vflux(i,ktf) = 0.
5389 end do
5390 do i = i_start, i_end
5391 a_vflux(i,1) = a_vflux(i,1)+a_vflux(i,0)
5392 a_vflux(i,0) = 0.
5393 end do
5394 do k = kts, ktf-1
5395 do i = i_start, i_end
5396 a_alt(i,k+1,j) = a_alt(i,k+1,j)-a_vflux(i,k)*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)))&
5397 &*(field(i,k+1,j)-field(i,k,j)-base_3d(i,k+1,j)+base_3d(i,k,j))
5398 a_alt(i,k,j) = a_alt(i,k,j)-a_vflux(i,k)*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)))*&
5399 &(field(i,k+1,j)-field(i,k,j)-base_3d(i,k+1,j)+base_3d(i,k,j))
5400 a_field(i,k+1,j) = a_field(i,k+1,j)+a_vflux(i,k)*(kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))))
5401 a_field(i,k,j) = a_field(i,k,j)-a_vflux(i,k)*(kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))))
5402 a_vflux(i,k) = 0.
5403 end do
5404 end do
5405 end do
5406
5407 end subroutine a_vertical_diffusion_3dmp
5408
5409
5410 subroutine a_vertical_diffusion_mp( field, a_field, a_tendency, base, alt, a_alt, mut, a_mut, rdn, rdnw, kvdif, ide, jde, kde, ims,&
5411 & ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
5412 !******************************************************************
5413 !******************************************************************
5414 !** This routine was generated by Automatic differentiation. **
5415 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
5416 !******************************************************************
5417 !******************************************************************
5418 !==============================================
5419 ! all entries are defined explicitly
5420 !==============================================
5421 implicit none
5422
5423 !==============================================
5424 ! declare arguments
5425 !==============================================
5426 integer, intent(in) :: ime
5427 integer, intent(in) :: ims
5428 integer, intent(in) :: jme
5429 integer, intent(in) :: jms
5430 integer, intent(in) :: kme
5431 integer, intent(in) :: kms
5432 real, intent(inout) :: a_alt(ims:ime,kms:kme,jms:jme)
5433 real, intent(inout) :: a_field(ims:ime,kms:kme,jms:jme)
5434 real, intent(inout) :: a_mut(ims:ime,jms:jme)
5435 real, intent(inout) :: a_tendency(ims:ime,kms:kme,jms:jme)
5436 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
5437 real, intent(in) :: base(kms:kme)
5438 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
5439 integer, intent(in) :: ide
5440 integer, intent(in) :: ite
5441 integer, intent(in) :: its
5442 integer, intent(in) :: jde
5443 integer, intent(in) :: jte
5444 integer, intent(in) :: jts
5445 integer, intent(in) :: kde
5446 integer, intent(in) :: kte
5447 integer, intent(in) :: kts
5448 real, intent(in) :: kvdif
5449 real, intent(in) :: mut(ims:ime,jms:jme)
5450 real, intent(in) :: rdn(kms:kme)
5451 real, intent(in) :: rdnw(kms:kme)
5452
5453 !==============================================
5454 ! declare local variables
5455 !==============================================
5456 real a_vflux(its:ite,0:kte+1)
5457 integer i
5458 integer i_end
5459 integer i_start
5460 integer j
5461 integer j_end
5462 integer j_start
5463 integer k
5464 integer ktf
5465 real vflux(its:ite,0:kte+1)
5466
5467 !----------------------------------------------
5468 ! RESET LOCAL ADJOINT VARIABLES
5469 !----------------------------------------------
5470 a_vflux(:,:) = 0.
5471
5472 !----------------------------------------------
5473 ! ROUTINE BODY
5474 !----------------------------------------------
5475 ktf = min(kte,kde-1)
5476 ! recompute : ktf
5477 i_start = its
5478 ! recompute : i_start
5479 i_end = min(ite,ide-1)
5480 ! recompute : i_end
5481 j_start = jts
5482 ! recompute : j_start
5483 j_end = min(jte,jde-1)
5484 ! recompute : j_end
5485 do j = j_start, j_end
5486 do k = kts, ktf-1
5487 do i = i_start, i_end
5488 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))
5489 end do
5490 end do
5491 ! recompute : vflux
5492 do i = i_start, i_end
5493 vflux(i,0) = vflux(i,1)
5494 end do
5495 do i = i_start, i_end
5496 vflux(i,ktf) = 0.
5497 end do
5498 ! recompute : vflux
5499 do k = kts, ktf
5500 do i = i_start, i_end
5501 a_alt(i,k,j) = a_alt(i,k,j)-a_tendency(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))
5502 a_mut(i,j) = a_mut(i,j)-a_tendency(i,k,j)*g*g/(mut(i,j)*mut(i,j))/alt(i,k,j)*rdnw(k)*(vflux(i,k)-vflux(i,k-1))
5503 a_vflux(i,k-1) = a_vflux(i,k-1)-a_tendency(i,k,j)*g*g/mut(i,j)/alt(i,k,j)*rdnw(k)
5504 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*g*g/mut(i,j)/alt(i,k,j)*rdnw(k)
5505 end do
5506 end do
5507 do i = i_start, i_end
5508 a_vflux(i,ktf) = 0.
5509 end do
5510 do i = i_start, i_end
5511 a_vflux(i,1) = a_vflux(i,1)+a_vflux(i,0)
5512 a_vflux(i,0) = 0.
5513 end do
5514 do k = kts, ktf-1
5515 do i = i_start, i_end
5516 a_alt(i,k+1,j) = a_alt(i,k+1,j)-a_vflux(i,k)*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)))&
5517 &*(field(i,k+1,j)-field(i,k,j)-base(k+1)+base(k))
5518 a_alt(i,k,j) = a_alt(i,k,j)-a_vflux(i,k)*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)))*&
5519 &(field(i,k+1,j)-field(i,k,j)-base(k+1)+base(k))
5520 a_field(i,k+1,j) = a_field(i,k+1,j)+a_vflux(i,k)*(kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))))
5521 a_field(i,k,j) = a_field(i,k,j)-a_vflux(i,k)*(kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))))
5522 a_vflux(i,k) = 0.
5523 end do
5524 end do
5525 end do
5526
5527 end subroutine a_vertical_diffusion_mp
5528
5529
5530 subroutine a_vertical_diffusion_u( field, a_field, a_tendency, config_flags, u_base, alt, a_alt, muu, a_muu, rdn, rdnw, kvdif, ids,&
5531 & ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
5532 !******************************************************************
5533 !******************************************************************
5534 !** This routine was generated by Automatic differentiation. **
5535 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
5536 !******************************************************************
5537 !******************************************************************
5538 !==============================================
5539 ! all entries are defined explicitly
5540 !==============================================
5541 implicit none
5542
5543 !==============================================
5544 ! declare arguments
5545 !==============================================
5546 integer, intent(in) :: ime
5547 integer, intent(in) :: ims
5548 integer, intent(in) :: jme
5549 integer, intent(in) :: jms
5550 integer, intent(in) :: kme
5551 integer, intent(in) :: kms
5552 real, intent(inout) :: a_alt(ims:ime,kms:kme,jms:jme)
5553 real, intent(inout) :: a_field(ims:ime,kms:kme,jms:jme)
5554 real, intent(inout) :: a_muu(ims:ime,jms:jme)
5555 real, intent(inout) :: a_tendency(ims:ime,kms:kme,jms:jme)
5556 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
5557 type (grid_config_rec_type), intent(in) :: config_flags
5558 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
5559 integer, intent(in) :: ide
5560 integer, intent(in) :: ids
5561 integer, intent(in) :: ite
5562 integer, intent(in) :: its
5563 integer, intent(in) :: jde
5564 integer, intent(in) :: jte
5565 integer, intent(in) :: jts
5566 integer, intent(in) :: kde
5567 integer, intent(in) :: kte
5568 integer, intent(in) :: kts
5569 real, intent(in) :: kvdif
5570 real, intent(in) :: muu(ims:ime,jms:jme)
5571 real, intent(in) :: rdn(kms:kme)
5572 real, intent(in) :: rdnw(kms:kme)
5573 real, intent(in) :: u_base(kms:kme)
5574
5575 !==============================================
5576 ! declare local variables
5577 !==============================================
5578 real a_vflux(its:ite,0:kte+1)
5579 integer i
5580 integer i_end
5581 integer i_start
5582 integer j
5583 integer j_end
5584 integer j_start
5585 integer k
5586 integer ktf
5587 logical specified
5588 real vflux(its:ite,0:kte+1)
5589
5590 !----------------------------------------------
5591 ! RESET LOCAL ADJOINT VARIABLES
5592 !----------------------------------------------
5593 a_vflux(:,:) = 0.
5594
5595 !----------------------------------------------
5596 ! ROUTINE BODY
5597 !----------------------------------------------
5598 specified = .false.
5599 ! recompute : specified
5600 if (config_flags%specified .or. config_flags%nested) then
5601 specified = .true.
5602 endif
5603 ! recompute : specified
5604 ktf = min(kte,kde-1)
5605 ! recompute : ktf
5606 i_start = its
5607 ! recompute : i_start
5608 i_end = ite
5609 ! recompute : i_end
5610 j_start = jts
5611 ! recompute : j_start
5612 j_end = min(jte,jde-1)
5613 ! recompute : j_end
5614 if (config_flags%open_xs .or. specified) then
5615 i_start = max(ids+1,its)
5616 endif
5617 ! recompute : i_start
5618 if (config_flags%open_xe .or. specified) then
5619 i_end = min(ide-1,ite)
5620 endif
5621 ! recompute : i_end
5622 do j = j_start, j_end
5623 do k = kts, ktf-1
5624 do i = i_start, i_end
5625 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)-&
5626 &u_base(k+1)+u_base(k))
5627 end do
5628 end do
5629 ! recompute : vflux
5630 do i = i_start, i_end
5631 vflux(i,0) = vflux(i,1)
5632 end do
5633 do i = i_start, i_end
5634 vflux(i,ktf) = 0.
5635 end do
5636 ! recompute : vflux
5637 do k = kts, ktf-1
5638 do i = i_start, i_end
5639 a_alt(i-1,k,j) = a_alt(i-1,k,j)-a_tendency(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)&
5640 &+alt(i,k,j)))*(vflux(i,k)-vflux(i,k-1))
5641 a_alt(i,k,j) = a_alt(i,k,j)-a_tendency(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)+&
5642 &alt(i,k,j)))*(vflux(i,k)-vflux(i,k-1))
5643 a_muu(i,j) = a_muu(i,j)-a_tendency(i,k,j)*g*g*rdnw(k)/(muu(i,j)*muu(i,j))/(0.5*(alt(i-1,k,j)+alt(i,k,j)))*(vflux(i,k)-&
5644 &vflux(i,k-1))
5645 a_vflux(i,k-1) = a_vflux(i,k-1)-a_tendency(i,k,j)*(g*g*rdnw(k)/muu(i,j)/(0.5*(alt(i-1,k,j)+alt(i,k,j))))
5646 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*(g*g*rdnw(k)/muu(i,j)/(0.5*(alt(i-1,k,j)+alt(i,k,j))))
5647 end do
5648 end do
5649 do i = i_start, i_end
5650 a_vflux(i,ktf) = 0.
5651 end do
5652 do i = i_start, i_end
5653 a_vflux(i,1) = a_vflux(i,1)+a_vflux(i,0)
5654 a_vflux(i,0) = 0.
5655 end do
5656 do k = kts, ktf-1
5657 do i = i_start, i_end
5658 a_alt(i-1,k+1,j) = a_alt(i-1,k+1,j)-a_vflux(i,k)*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-&
5659 &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,k,j)-u_base(k+1)+u_base(k))
5660 a_alt(i,k+1,j) = a_alt(i,k+1,j)-a_vflux(i,k)*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+&
5661 &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,k,j)-u_base(k+1)+u_base(k))
5662 a_alt(i-1,k,j) = a_alt(i-1,k,j)-a_vflux(i,k)*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+&
5663 &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,k,j)-u_base(k+1)+u_base(k))
5664 a_alt(i,k,j) = a_alt(i,k,j)-a_vflux(i,k)*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))&
5665 &*(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))
5666 a_field(i,k+1,j) = a_field(i,k+1,j)+a_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))))
5667 a_field(i,k,j) = a_field(i,k,j)-a_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))))
5668 a_vflux(i,k) = 0.
5669 end do
5670 end do
5671 end do
5672
5673 end subroutine a_vertical_diffusion_u
5674
5675
5676 subroutine a_vertical_diffusion_v( field, a_field, a_tendency, config_flags, v_base, alt, a_alt, muv, a_muv, rdn, rdnw, kvdif, ide,&
5677 & jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
5678 !******************************************************************
5679 !******************************************************************
5680 !** This routine was generated by Automatic differentiation. **
5681 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
5682 !******************************************************************
5683 !******************************************************************
5684 !==============================================
5685 ! all entries are defined explicitly
5686 !==============================================
5687 implicit none
5688
5689 !==============================================
5690 ! declare arguments
5691 !==============================================
5692 integer, intent(in) :: ime
5693 integer, intent(in) :: ims
5694 integer, intent(in) :: jme
5695 integer, intent(in) :: jms
5696 integer, intent(in) :: kme
5697 integer, intent(in) :: kms
5698 real, intent(inout) :: a_alt(ims:ime,kms:kme,jms:jme)
5699 real, intent(inout) :: a_field(ims:ime,kms:kme,jms:jme)
5700 real, intent(inout) :: a_muv(ims:ime,jms:jme)
5701 real, intent(inout) :: a_tendency(ims:ime,kms:kme,jms:jme)
5702 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
5703 type (grid_config_rec_type), intent(in) :: config_flags
5704 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
5705 integer, intent(in) :: ide
5706 integer, intent(in) :: ite
5707 integer, intent(in) :: its
5708 integer, intent(in) :: jde
5709 integer, intent(in) :: jds
5710 integer, intent(in) :: jte
5711 integer, intent(in) :: jts
5712 integer, intent(in) :: kde
5713 integer, intent(in) :: kte
5714 integer, intent(in) :: kts
5715 real, intent(in) :: kvdif
5716 real, intent(in) :: muv(ims:ime,jms:jme)
5717 real, intent(in) :: rdn(kms:kme)
5718 real, intent(in) :: rdnw(kms:kme)
5719 real, intent(in) :: v_base(kms:kme)
5720
5721 !==============================================
5722 ! declare local variables
5723 !==============================================
5724 real a_vflux(its:ite,0:kte+1)
5725 integer i
5726 integer i_end
5727 integer i_start
5728 integer j
5729 integer j_end
5730 integer j_start
5731 integer jm1
5732 integer k
5733 integer ktf
5734 logical specified
5735 real vflux(its:ite,0:kte+1)
5736
5737 !----------------------------------------------
5738 ! RESET LOCAL ADJOINT VARIABLES
5739 !----------------------------------------------
5740 a_vflux(:,:) = 0.
5741
5742 !----------------------------------------------
5743 ! ROUTINE BODY
5744 !----------------------------------------------
5745 specified = .false.
5746 ! recompute : specified
5747 if (config_flags%specified .or. config_flags%nested) then
5748 specified = .true.
5749 endif
5750 ! recompute : specified
5751 ktf = min(kte,kde-1)
5752 ! recompute : ktf
5753 i_start = its
5754 ! recompute : i_start
5755 i_end = min(ite,ide-1)
5756 ! recompute : i_end
5757 j_start = jts
5758 ! recompute : j_start
5759 j_end = min(jte,jde-1)
5760 ! recompute : j_end
5761 if (config_flags%open_ys .or. specified) then
5762 j_start = max(jds+1,jts)
5763 endif
5764 ! recompute : j_start
5765 if (config_flags%open_ye .or. specified) then
5766 j_end = min(jde-1,jte)
5767 endif
5768 ! recompute : j_end
5769 do j = j_start, j_end
5770 jm1 = j-1
5771 ! recompute : jm1
5772 do k = kts, ktf-1
5773 do i = i_start, i_end
5774 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)-&
5775 &v_base(k+1)+v_base(k))
5776 end do
5777 end do
5778 ! recompute : vflux
5779 do i = i_start, i_end
5780 vflux(i,0) = vflux(i,1)
5781 end do
5782 do i = i_start, i_end
5783 vflux(i,ktf) = 0.
5784 end do
5785 ! recompute : vflux
5786 do k = kts, ktf-1
5787 do i = i_start, i_end
5788 a_alt(i,k,j) = a_alt(i,k,j)-a_tendency(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)+&
5789 &alt(i,k,j)))*(vflux(i,k)-vflux(i,k-1))
5790 a_alt(i,k,jm1) = a_alt(i,k,jm1)-a_tendency(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)&
5791 &+alt(i,k,j)))*(vflux(i,k)-vflux(i,k-1))
5792 a_muv(i,j) = a_muv(i,j)-a_tendency(i,k,j)*g*g*rdnw(k)/(muv(i,j)*muv(i,j))/(0.5*(alt(i,k,jm1)+alt(i,k,j)))*(vflux(i,k)-&
5793 &vflux(i,k-1))
5794 a_vflux(i,k-1) = a_vflux(i,k-1)-a_tendency(i,k,j)*(g*g*rdnw(k)/muv(i,j)/(0.5*(alt(i,k,jm1)+alt(i,k,j))))
5795 a_vflux(i,k) = a_vflux(i,k)+a_tendency(i,k,j)*(g*g*rdnw(k)/muv(i,j)/(0.5*(alt(i,k,jm1)+alt(i,k,j))))
5796 end do
5797 end do
5798 do i = i_start, i_end
5799 a_vflux(i,ktf) = 0.
5800 end do
5801 do i = i_start, i_end
5802 a_vflux(i,1) = a_vflux(i,1)+a_vflux(i,0)
5803 a_vflux(i,0) = 0.
5804 end do
5805 do k = kts, ktf-1
5806 do i = i_start, i_end
5807 a_alt(i,k+1,j) = a_alt(i,k+1,j)-a_vflux(i,k)*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,&
5808 &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,j)-v_base(k+1)+v_base(k))
5809 a_alt(i,k+1,jm1) = a_alt(i,k+1,jm1)-a_vflux(i,k)*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,&
5810 &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,j)-v_base(k+1)+v_base(k))
5811 a_alt(i,k,j) = a_alt(i,k,j)-a_vflux(i,k)*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))&
5812 &*(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))
5813 a_alt(i,k,jm1) = a_alt(i,k,jm1)-a_vflux(i,k)*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,&
5814 &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,j)-v_base(k+1)+v_base(k))
5815 a_field(i,k+1,j) = a_field(i,k+1,j)+a_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))))
5816 a_field(i,k,j) = a_field(i,k,j)-a_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))))
5817 a_vflux(i,k) = 0.
5818 end do
5819 end do
5820 end do
5821
5822 end subroutine a_vertical_diffusion_v
5823
5824
5825 subroutine a_w_damp( a_rw_tend, ww, a_ww, w, a_w, mut, a_mut, rdnw, dt, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts,&
5826 & jte )
5827 !******************************************************************
5828 !******************************************************************
5829 !** This routine was generated by Automatic differentiation. **
5830 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
5831 !******************************************************************
5832 !******************************************************************
5833 !==============================================
5834 ! all entries are defined explicitly
5835 !==============================================
5836 implicit none
5837
5838 !==============================================
5839 ! declare arguments
5840 !==============================================
5841 integer, intent(in) :: ime
5842 integer, intent(in) :: ims
5843 integer, intent(in) :: jme
5844 integer, intent(in) :: jms
5845 real, intent(inout) :: a_mut(ims:ime,jms:jme)
5846 integer, intent(in) :: kme
5847 integer, intent(in) :: kms
5848 real, intent(inout) :: a_rw_tend(ims:ime,kms:kme,jms:jme)
5849 real, intent(inout) :: a_w(ims:ime,kms:kme,jms:jme)
5850 real, intent(inout) :: a_ww(ims:ime,kms:kme,jms:jme)
5851 real, intent(in) :: dt
5852 integer, intent(in) :: ide
5853 integer, intent(in) :: ite
5854 integer, intent(in) :: its
5855 integer, intent(in) :: jde
5856 integer, intent(in) :: jte
5857 integer, intent(in) :: jts
5858 integer, intent(in) :: kde
5859 real, intent(in) :: mut(ims:ime,jms:jme)
5860 real, intent(in) :: rdnw(kms:kme)
5861 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
5862 real, intent(in) :: ww(ims:ime,kms:kme,jms:jme)
5863
5864 !==============================================
5865 ! declare local variables
5866 !==============================================
5867 real a_cf_d
5868 real a_cf_n
5869 real cf_d
5870 real cf_n
5871 real cfl
5872 integer i
5873 integer itf
5874 integer j
5875 integer jtf
5876 integer k
5877
5878 !----------------------------------------------
5879 ! RESET LOCAL ADJOINT VARIABLES
5880 !----------------------------------------------
5881 a_cf_d = 0.
5882 a_cf_n = 0.
5883
5884 !----------------------------------------------
5885 ! ROUTINE BODY
5886 !----------------------------------------------
5887 itf = min(ite,ide-1)
5888 ! recompute : itf
5889 jtf = min(jte,jde-1)
5890 ! recompute : jtf
5891 do j = jts, jtf
5892 a_cf_d = 0.
5893 a_cf_n = 0.
5894 do k = 2, kde-1
5895 a_cf_d = 0.
5896 a_cf_n = 0.
5897 do i = its, itf
5898 a_cf_d = 0.
5899 a_cf_n = 0.
5900 cf_n = abs(ww(i,k,j))
5901 ! recompute : cf_n
5902 cf_d = abs(mut(i,j)*rdnw(k)*dt)
5903 ! recompute : cf_d
5904 if (cf_n .gt. cf_d*w_beta) then
5905 a_mut(i,j) = a_mut(i,j)-a_rw_tend(i,k,j)*w_alpha*(cfl-w_beta)*sign(1.,w(i,k,j))
5906 endif
5907 a_mut(i,j) = a_mut(i,j)+a_cf_d*rdnw(k)*dt*sign(1.,mut(i,j)*rdnw(k)*dt)
5908 a_cf_d = 0.
5909 a_ww(i,k,j) = a_ww(i,k,j)+a_cf_n*sign(1.,ww(i,k,j))
5910 a_cf_n = 0.
5911 end do
5912 end do
5913 end do
5914
5915 end subroutine a_w_damp
5916
5917
5918 subroutine a_zero_tend( a_tendency, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
5919 !******************************************************************
5920 !******************************************************************
5921 !** This routine was generated by Automatic differentiation. **
5922 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
5923 !******************************************************************
5924 !******************************************************************
5925 !==============================================
5926 ! all entries are defined explicitly
5927 !==============================================
5928 implicit none
5929
5930 !==============================================
5931 ! declare arguments
5932 !==============================================
5933 integer, intent(in) :: ime
5934 integer, intent(in) :: ims
5935 integer, intent(in) :: jme
5936 integer, intent(in) :: jms
5937 integer, intent(in) :: kme
5938 integer, intent(in) :: kms
5939 real, intent(inout) :: a_tendency(ims:ime,kms:kme,jms:jme)
5940 integer, intent(in) :: ite
5941 integer, intent(in) :: its
5942 integer, intent(in) :: jte
5943 integer, intent(in) :: jts
5944 integer, intent(in) :: kte
5945 integer, intent(in) :: kts
5946
5947 !==============================================
5948 ! declare local variables
5949 !==============================================
5950 integer i
5951 integer j
5952 integer k
5953
5954 !----------------------------------------------
5955 ! ROUTINE BODY
5956 !----------------------------------------------
5957 do j = jts, jte
5958 do k = kts, kte
5959 do i = its, ite
5960 a_tendency(i,k,j) = 0.
5961 end do
5962 end do
5963 end do
5964
5965 end subroutine a_zero_tend
5966
5967
5968 end module a_module_big_step_utilities_em
5969
5970