module_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_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_model_constants
34 use module_advect_em
35 use a_module_advect_em
36 use module_big_step_utilities_em
37 use a_module_big_step_utilities_em
38 use module_state_description
39 use module_em
40
41 !==============================================
42 ! all entries are defined explicitly
43 !==============================================
44 implicit none
45
46 contains
47 subroutine a_init_zero_tendency( a_ru_tendf, a_rv_tendf, a_rw_tendf, &
48 a_ph_tendf, a_t_tendf, &
49 a_tke_tendf, a_moist_tendf, a_chem_tendf, a_scalar_tendf, &
50 n_moist, n_chem,n_scalar, ims, ime, jms, &
51 &jme, kms, kme, its, ite, jts, jte, kts, kte )
52 !******************************************************************
53 !******************************************************************
54 !** This routine was generated by Automatic differentiation. **
55 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
56 !******************************************************************
57 !******************************************************************
58 !==============================================
59 ! all entries are defined explicitly
60 !==============================================
61 implicit none
62
63 !==============================================
64 ! declare arguments
65 !==============================================
66 integer, intent(in) :: ime
67 integer, intent(in) :: ims
68 integer, intent(in) :: jme
69 integer, intent(in) :: jms
70 integer, intent(in) :: kme
71 integer, intent(in) :: kms
72 integer, intent(in) :: n_moist, n_chem,n_scalar
73 real, intent(inout) :: a_moist_tendf(ims:ime,kms:kme,jms:jme,n_moist)
74 real, intent(inout) :: a_chem_tendf(ims:ime,kms:kme,jms:jme,n_chem)
75 real, intent(inout) :: a_scalar_tendf(ims:ime,kms:kme,jms:jme,n_scalar)
76 real, intent(inout) :: a_ph_tendf(ims:ime,kms:kme,jms:jme)
77 real, intent(inout) :: a_ru_tendf(ims:ime,kms:kme,jms:jme)
78 real, intent(inout) :: a_rv_tendf(ims:ime,kms:kme,jms:jme)
79 real, intent(inout) :: a_rw_tendf(ims:ime,kms:kme,jms:jme)
80 real, intent(inout) :: a_t_tendf(ims:ime,kms:kme,jms:jme)
81 real, intent(inout) :: a_tke_tendf(ims:ime,kms:kme,jms:jme)
82 integer, intent(in) :: ite
83 integer, intent(in) :: its
84 integer, intent(in) :: jte
85 integer, intent(in) :: jts
86 integer, intent(in) :: kte
87 integer, intent(in) :: kts
88
89 !==============================================
90 ! declare local variables
91 !==============================================
92 integer im
93
94 !----------------------------------------------
95 ! ROUTINE BODY
96 !----------------------------------------------
97 do im = n_moist, 1, -1
98 call a_zero_tend( a_moist_tendf(ims,kms,jms,im),ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
99 end do
100 call a_zero_tend( a_t_tendf,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
101 call a_zero_tend( a_ph_tendf,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
102 call a_zero_tend( a_rw_tendf,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
103 call a_zero_tend( a_rv_tendf,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
104 call a_zero_tend( a_ru_tendf,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
105
106 end subroutine a_init_zero_tendency
107
108
109 subroutine a_rk_addtend_dry( a_ru_tend, a_rv_tend, a_rw_tend, a_ph_tend, a_t_tend, a_ru_tendf, a_rv_tendf, a_rw_tendf, a_ph_tendf, &
110 &a_t_tendf, a_u_save, a_v_save, a_w_save, a_ph_save, a_t_save, rk_step, h_diabatic, a_mut, msft, msfu, msfv, ide, jde, ims, ime, &
111 &jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
112 !******************************************************************
113 !******************************************************************
114 !** This routine was generated by Automatic differentiation. **
115 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
116 !******************************************************************
117 !******************************************************************
118 !==============================================
119 ! all entries are defined explicitly
120 !==============================================
121 implicit none
122
123 !==============================================
124 ! declare arguments
125 !==============================================
126 integer, intent(in) :: ime
127 integer, intent(in) :: ims
128 integer, intent(in) :: jme
129 integer, intent(in) :: jms
130 real, intent(inout) :: a_mut(ims:ime,jms:jme)
131 integer, intent(in) :: kme
132 integer, intent(in) :: kms
133 real, intent(inout) :: a_ph_save(ims:ime,kms:kme,jms:jme)
134 real, intent(inout) :: a_ph_tend(ims:ime,kms:kme,jms:jme)
135 real, intent(inout) :: a_ph_tendf(ims:ime,kms:kme,jms:jme)
136 real, intent(inout) :: a_ru_tend(ims:ime,kms:kme,jms:jme)
137 real, intent(inout) :: a_ru_tendf(ims:ime,kms:kme,jms:jme)
138 real, intent(inout) :: a_rv_tend(ims:ime,kms:kme,jms:jme)
139 real, intent(inout) :: a_rv_tendf(ims:ime,kms:kme,jms:jme)
140 real, intent(inout) :: a_rw_tend(ims:ime,kms:kme,jms:jme)
141 real, intent(inout) :: a_rw_tendf(ims:ime,kms:kme,jms:jme)
142 real, intent(inout) :: a_t_save(ims:ime,kms:kme,jms:jme)
143 real, intent(inout) :: a_t_tend(ims:ime,kms:kme,jms:jme)
144 real, intent(inout) :: a_t_tendf(ims:ime,kms:kme,jms:jme)
145 real, intent(inout) :: a_u_save(ims:ime,kms:kme,jms:jme)
146 real, intent(inout) :: a_v_save(ims:ime,kms:kme,jms:jme)
147 real, intent(inout) :: a_w_save(ims:ime,kms:kme,jms:jme)
148 real, intent(in) :: h_diabatic(ims:ime,kms:kme,jms:jme)
149 integer, intent(in) :: ide
150 integer, intent(in) :: ite
151 integer, intent(in) :: its
152 integer, intent(in) :: jde
153 integer, intent(in) :: jte
154 integer, intent(in) :: jts
155 integer, intent(in) :: kte
156 integer, intent(in) :: kts
157 real, intent(in) :: msft(ims:ime,jms:jme)
158 real, intent(in) :: msfu(ims:ime,jms:jme)
159 real, intent(in) :: msfv(ims:ime,jms:jme)
160 integer, intent(in) :: rk_step
161
162 !==============================================
163 ! declare local variables
164 !==============================================
165 integer i
166 integer j
167 integer k
168
169 !----------------------------------------------
170 ! ROUTINE BODY
171 !----------------------------------------------
172 do j = jts, min(jte,jde-1)
173 do k = kts, kte-1
174 do i = its, min(ite,ide-1)
175 a_mut(i,j) = a_mut(i,j)+a_t_tend(i,k,j)*(h_diabatic(i,k,j)/msft(i,j))
176 a_t_tendf(i,k,j) = a_t_tendf(i,k,j)+a_t_tend(i,k,j)/msft(i,j)
177 if (rk_step .eq. 1) then
178 a_t_save(i,k,j) = a_t_save(i,k,j)+a_t_tendf(i,k,j)
179 endif
180 end do
181 end do
182 end do
183 do j = jts, min(jte,jde-1)
184 do k = kts, kte
185 do i = its, min(ite,ide-1)
186 a_ph_tendf(i,k,j) = a_ph_tendf(i,k,j)+a_ph_tend(i,k,j)/msft(i,j)
187 if (rk_step .eq. 1) then
188 a_ph_save(i,k,j) = a_ph_save(i,k,j)+a_ph_tendf(i,k,j)
189 endif
190 a_rw_tendf(i,k,j) = a_rw_tendf(i,k,j)+a_rw_tend(i,k,j)/msft(i,j)
191 if (rk_step .eq. 1) then
192 a_w_save(i,k,j) = a_w_save(i,k,j)+a_rw_tendf(i,k,j)*msft(i,j)
193 endif
194 end do
195 end do
196 end do
197 do j = jts, jte
198 do k = kts, kte-1
199 do i = its, min(ite,ide-1)
200 a_rv_tendf(i,k,j) = a_rv_tendf(i,k,j)+a_rv_tend(i,k,j)/msfv(i,j)
201 if (rk_step .eq. 1) then
202 a_v_save(i,k,j) = a_v_save(i,k,j)+a_rv_tendf(i,k,j)*msfv(i,j)
203 endif
204 end do
205 end do
206 end do
207 do j = jts, min(jte,jde-1)
208 do k = kts, kte-1
209 do i = its, ite
210 a_ru_tendf(i,k,j) = a_ru_tendf(i,k,j)+a_ru_tend(i,k,j)/msfu(i,j)
211 if (rk_step .eq. 1) then
212 a_u_save(i,k,j) = a_u_save(i,k,j)+a_ru_tendf(i,k,j)*msfu(i,j)
213 endif
214 end do
215 end do
216 end do
217
218 end subroutine a_rk_addtend_dry
219
220
221 subroutine a_rk_scalar_tend( scs, sce, config_flags, rk_step, ru, a_ru, rv, a_rv, ww, a_ww, mut, a_mut, alt, a_alt, &
222 scalar, a_scalar, a_scalar_tends, a_advect_tend, base, moist_step, fnm, fnp, msfu, msfv, msft, rdx, rdy, rdn, rdnw, &
223 &kvdif, xkmhd, a_xkmhd, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
224 !******************************************************************
225 !******************************************************************
226 !** This routine was generated by Automatic differentiation. **
227 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
228 !******************************************************************
229 !******************************************************************
230 !==============================================
231 ! all entries are defined explicitly
232 !==============================================
233 implicit none
234
235 !==============================================
236 ! declare arguments
237 !==============================================
238 integer, intent(in) :: ime
239 integer, intent(in) :: ims
240 integer, intent(in) :: jme
241 integer, intent(in) :: jms
242 integer, intent(in) :: kme
243 integer, intent(in) :: kms
244 real a_advect_tend(ims:ime,kms:kme,jms:jme)
245 real, intent(inout) :: a_alt(ims:ime,kms:kme,jms:jme)
246 real, intent(inout) :: a_mut(ims:ime,jms:jme)
247 real, intent(inout) :: a_ru(ims:ime,kms:kme,jms:jme)
248 real, intent(inout) :: a_rv(ims:ime,kms:kme,jms:jme)
249 integer, intent(in) :: sce
250 integer, intent(in) :: scs
251 real, intent(inout) :: a_scalar(ims:ime,kms:kme,jms:jme,scs:sce)
252 real, intent(inout) :: a_scalar_tends(ims:ime,kms:kme,jms:jme,scs:sce)
253 real, intent(inout) :: a_ww(ims:ime,kms:kme,jms:jme)
254 real, intent(inout) :: a_xkmhd(ims:ime,kms:kme,jms:jme)
255 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
256 real, intent(in) :: base(kms:kme)
257 type (grid_config_rec_type), intent(in) :: config_flags
258 real, intent(in) :: fnm(kms:kme)
259 real, intent(in) :: fnp(kms:kme)
260 integer, intent(in) :: ide
261 integer, intent(in) :: ids
262 integer, intent(in) :: ite
263 integer, intent(in) :: its
264 integer, intent(in) :: jde
265 integer, intent(in) :: jds
266 integer, intent(in) :: jte
267 integer, intent(in) :: jts
268 integer, intent(in) :: kde
269 integer, intent(in) :: kte
270 integer, intent(in) :: kts
271 real, intent(in) :: kvdif
272 logical, intent(in) :: moist_step
273 real, intent(in) :: msft(ims:ime,jms:jme)
274 real, intent(in) :: msfu(ims:ime,jms:jme)
275 real, intent(in) :: msfv(ims:ime,jms:jme)
276 real, intent(in) :: mut(ims:ime,jms:jme)
277 real, intent(in) :: rdn(kms:kme)
278 real, intent(in) :: rdnw(kms:kme)
279 real, intent(in) :: rdx
280 real, intent(in) :: rdy
281 integer, intent(in) :: rk_step
282 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
283 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
284 real, intent(inout) :: scalar(ims:ime,kms:kme,jms:jme,scs:sce)
285 real, intent(in) :: ww(ims:ime,kms:kme,jms:jme)
286 real, intent(in) :: xkmhd(ims:ime,kms:kme,jms:jme)
287
288 !==============================================
289 ! declare local variables
290 !==============================================
291 integer im
292 real kvdq
293
294 !----------------------------------------------
295 ! ROUTINE BODY
296 !----------------------------------------------
297 kvdq = kvdif/prandtl
298 ! recompute : kvdq
299 a_scalar_loop: do im = sce, scs, -1
300 a_diff_opt1: if (config_flags%diff_opt .eq. 1) then
301 a_rk_step_1: if (rk_step .eq. 1) then
302 a_pbl_test: if (config_flags%bl_pbl_physics .eq. 0) then
303 if (moist_step .and. im .eq. p_qv) then
304 call a_vertical_diffusion_mp( scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im),a_scalar_tends(ims,kms,jms,im),base,alt,&
305 &a_alt,mut,a_mut,rdn,rdnw,kvdq,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
306 else
307 call a_vertical_diffusion( 'm',scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im),a_scalar_tends(ims,kms,jms,im),alt,&
308 &a_alt,mut,a_mut,rdn,rdnw,kvdq,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
309 endif
310 endif a_pbl_test
311 call a_horizontal_diffusion( 'm',scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im),a_scalar_tends(ims,kms,jms,im),mut,a_mut,&
312 &config_flags,msfu,msfv,msft,xkmhd,a_xkmhd,rdx,rdy,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
313 endif a_rk_step_1
314 endif a_diff_opt1
315 call a_advect_scalar( scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im),scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im),&
316 &a_advect_tend(ims,kms,jms),ru,a_ru,rv,a_rv,ww,a_ww,config_flags,msft,fnm,fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kde,ims,ime,jms,jme,&
317 &kms,kme,its,ite,jts,jte,kts,kte )
318 call a_zero_tend( a_advect_tend(ims,kms,jms),ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
319 end do a_scalar_loop
320
321 end subroutine a_rk_scalar_tend
322
323
324 subroutine a_rk_step_prep( config_flags, u, a_u, v, a_v, w, a_w, a_ph, mu, a_mu, moist, a_moist, a_ru, a_rv, a_rw, a_ww, a_php, &
325 &a_alt, muu, a_muu, muv, a_muv, mub, mut, a_mut, a_al, a_cqu, a_cqv, a_cqw, msfu, msfv, msft, dnw, rdx, rdy, n_moist, ids, ide, &
326 &jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
327 !******************************************************************
328 !******************************************************************
329 !** This routine was generated by Automatic differentiation. **
330 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
331 !******************************************************************
332 !******************************************************************
333 !==============================================
334 ! all entries are defined explicitly
335 !==============================================
336 implicit none
337
338 !==============================================
339 ! declare arguments
340 !==============================================
341 integer, intent(in) :: ime
342 integer, intent(in) :: ims
343 integer, intent(in) :: jme
344 integer, intent(in) :: jms
345 integer, intent(in) :: kme
346 integer, intent(in) :: kms
347 real, intent(inout) :: a_al(ims:ime,kms:kme,jms:jme)
348 real, intent(inout) :: a_alt(ims:ime,kms:kme,jms:jme)
349 real, intent(inout) :: a_cqu(ims:ime,kms:kme,jms:jme)
350 real, intent(inout) :: a_cqv(ims:ime,kms:kme,jms:jme)
351 real, intent(inout) :: a_cqw(ims:ime,kms:kme,jms:jme)
352 integer, intent(in) :: n_moist
353 real, intent(inout) :: a_moist(ims:ime,kms:kme,jms:jme,n_moist)
354 real, intent(inout) :: a_mu(ims:ime,jms:jme)
355 real, intent(inout) :: a_mut(ims:ime,jms:jme)
356 real, intent(inout) :: a_muu(ims:ime,jms:jme)
357 real, intent(inout) :: a_muv(ims:ime,jms:jme)
358 real, intent(inout) :: a_ph(ims:ime,kms:kme,jms:jme)
359 real, intent(inout) :: a_php(ims:ime,kms:kme,jms:jme)
360 real, intent(inout) :: a_ru(ims:ime,kms:kme,jms:jme)
361 real, intent(inout) :: a_rv(ims:ime,kms:kme,jms:jme)
362 real, intent(inout) :: a_rw(ims:ime,kms:kme,jms:jme)
363 real, intent(inout) :: a_u(ims:ime,kms:kme,jms:jme)
364 real, intent(inout) :: a_v(ims:ime,kms:kme,jms:jme)
365 real, intent(inout) :: a_w(ims:ime,kms:kme,jms:jme)
366 real, intent(inout) :: a_ww(ims:ime,kms:kme,jms:jme)
367 type (grid_config_rec_type), intent(in) :: config_flags
368 real, intent(in) :: dnw(kms:kme)
369 integer, intent(in) :: ide
370 integer, intent(in) :: ids
371 integer, intent(in) :: ite
372 integer, intent(in) :: its
373 integer, intent(in) :: jde
374 integer, intent(in) :: jds
375 integer, intent(in) :: jte
376 integer, intent(in) :: jts
377 integer, intent(in) :: kde
378 integer, intent(in) :: kte
379 integer, intent(in) :: kts
380 real, intent(in) :: moist(ims:ime,kms:kme,jms:jme,n_moist)
381 real, intent(in) :: msft(ims:ime,jms:jme)
382 real, intent(in) :: msfu(ims:ime,jms:jme)
383 real, intent(in) :: msfv(ims:ime,jms:jme)
384 real, intent(in) :: mu(ims:ime,jms:jme)
385 real, intent(in) :: mub(ims:ime,jms:jme)
386 real, intent(out) :: mut(ims:ime,jms:jme)
387 real, intent(out) :: muu(ims:ime,jms:jme)
388 real, intent(out) :: muv(ims:ime,jms:jme)
389 real, intent(in) :: rdx
390 real, intent(in) :: rdy
391 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
392 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
393 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
394
395 !==============================================
396 ! declare local variables
397 !==============================================
398 integer kds
399
400 !----------------------------------------------
401 ! ROUTINE BODY
402 !----------------------------------------------
403 call calculate_full( mut,mub,mu,ids,ide,jds,jde,1,2,ims,ime,jms,jme,1,1,its,ite,jts,jte,1,1 )
404 ! recompute : mut
405 call calc_mu_uv( config_flags,mu,mub,muu,muv,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
406 ! recompute : muu,muv
407 call a_calc_php( a_php,a_ph,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
408 call a_calc_alt( a_alt,a_al,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
409 call 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,jte,kts,kte )
410 call a_calc_ww_cp( u,a_u,v,a_v,mu,a_mu,mub,a_ww,rdx,rdy,msft,msfu,msfv,dnw,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,&
411 &kte )
412 call 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,jde,kde,ims,ime,jms,jme,&
413 &kms,kme,its,ite,jts,jte,kts,kte )
414 call a_calc_mu_uv( config_flags,a_mu,a_muu,a_muv,ids,ide,jds,jde,ims,ime,jms,jme,its,ite,jts,jte )
415 call a_calculate_full( a_mut,a_mu,ide,jde,2,ims,ime,jms,jme,1,1,its,ite,jts,jte,1,1 )
416
417 end subroutine a_rk_step_prep
418
419
420 subroutine a_rk_tendency( config_flags, rk_step, a_ru_tend, a_rv_tend, a_rw_tend, a_ph_tend, a_t_tend, a_ru_tendf, a_rv_tendf, &
421 &a_rw_tendf, a_t_tendf, a_mu_tend, a_u_save, a_v_save, a_w_save, a_ph_save, a_t_save, ru, a_ru, rv, a_rv, rw, a_rw, ww, a_ww, u, &
422 &a_u, v, a_v, w, a_w, t, a_t, ph, a_ph, u_old, a_u_old, v_old, a_v_old, w_old, a_w_old, t_old, a_t_old, ph_old, a_ph_old, phb, &
423 &t_init, mu, a_mu, mut, a_mut, muu, a_muu, muv, a_muv, mub, al, a_al, alt, a_alt, p, a_p, pb, php, a_php, cqu, a_cqu, cqv, a_cqv, &
424 &cqw, a_cqw, u_base, v_base, z_base, msfu, msfv, msft, f, e, sina, cosa, fnm, fnp, rdn, rdnw, dt, rdx, rdy, kvdif, xkmhd, a_xkmhd, &
425 dampcoef,zdamp,damp_opt, &
426 &cf1, cf2, cf3, cfn, cfn1, non_hydrostatic, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, &
427 &kts, kte )
428 !******************************************************************
429 !******************************************************************
430 !** This routine was generated by Automatic differentiation. **
431 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
432 !******************************************************************
433 !******************************************************************
434 !==============================================
435 ! all entries are defined explicitly
436 !==============================================
437 implicit none
438
439 !==============================================
440 ! declare arguments
441 !==============================================
442 integer, intent(in) :: ime
443 integer, intent(in) :: ims
444 integer, intent(in) :: jme
445 integer, intent(in) :: jms
446 integer, intent(in) :: kme
447 integer, intent(in) :: kms
448 real, intent(inout) :: a_al(ims:ime,kms:kme,jms:jme)
449 real, intent(inout) :: a_alt(ims:ime,kms:kme,jms:jme)
450 real, intent(inout) :: a_cqu(ims:ime,kms:kme,jms:jme)
451 real, intent(inout) :: a_cqv(ims:ime,kms:kme,jms:jme)
452 real, intent(inout) :: a_cqw(ims:ime,kms:kme,jms:jme)
453 real, intent(inout) :: a_mu(ims:ime,jms:jme)
454 real, intent(inout) :: a_mu_tend(ims:ime,jms:jme)
455 real, intent(inout) :: a_mut(ims:ime,jms:jme)
456 real, intent(inout) :: a_muu(ims:ime,jms:jme)
457 real, intent(inout) :: a_muv(ims:ime,jms:jme)
458 real, intent(inout) :: a_p(ims:ime,kms:kme,jms:jme)
459 real, intent(inout) :: a_ph(ims:ime,kms:kme,jms:jme)
460 real, intent(inout) :: a_ph_old(ims:ime,kms:kme,jms:jme)
461 real, intent(inout) :: a_ph_save(ims:ime,kms:kme,jms:jme)
462 real, intent(inout) :: a_ph_tend(ims:ime,kms:kme,jms:jme)
463 real, intent(inout) :: a_php(ims:ime,kms:kme,jms:jme)
464 real, intent(inout) :: a_ru(ims:ime,kms:kme,jms:jme)
465 real, intent(inout) :: a_ru_tend(ims:ime,kms:kme,jms:jme)
466 real, intent(inout) :: a_ru_tendf(ims:ime,kms:kme,jms:jme)
467 real, intent(inout) :: a_rv(ims:ime,kms:kme,jms:jme)
468 real, intent(inout) :: a_rv_tend(ims:ime,kms:kme,jms:jme)
469 real, intent(inout) :: a_rv_tendf(ims:ime,kms:kme,jms:jme)
470 real, intent(inout) :: a_rw(ims:ime,kms:kme,jms:jme)
471 real, intent(inout) :: a_rw_tend(ims:ime,kms:kme,jms:jme)
472 real, intent(inout) :: a_rw_tendf(ims:ime,kms:kme,jms:jme)
473 real, intent(inout) :: a_t(ims:ime,kms:kme,jms:jme)
474 real, intent(inout) :: a_t_old(ims:ime,kms:kme,jms:jme)
475 real, intent(inout) :: a_t_save(ims:ime,kms:kme,jms:jme)
476 real, intent(inout) :: a_t_tend(ims:ime,kms:kme,jms:jme)
477 real, intent(inout) :: a_t_tendf(ims:ime,kms:kme,jms:jme)
478 real, intent(inout) :: a_u(ims:ime,kms:kme,jms:jme)
479 real, intent(inout) :: a_u_old(ims:ime,kms:kme,jms:jme)
480 real, intent(inout) :: a_u_save(ims:ime,kms:kme,jms:jme)
481 real, intent(inout) :: a_v(ims:ime,kms:kme,jms:jme)
482 real, intent(inout) :: a_v_old(ims:ime,kms:kme,jms:jme)
483 real, intent(inout) :: a_v_save(ims:ime,kms:kme,jms:jme)
484 real, intent(inout) :: a_w(ims:ime,kms:kme,jms:jme)
485 real, intent(inout) :: a_w_old(ims:ime,kms:kme,jms:jme)
486 real, intent(inout) :: a_w_save(ims:ime,kms:kme,jms:jme)
487 real, intent(inout) :: a_ww(ims:ime,kms:kme,jms:jme)
488 real, intent(inout) :: a_xkmhd(ims:ime,kms:kme,jms:jme)
489 real, intent(in) :: al(ims:ime,kms:kme,jms:jme)
490 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
491
492 INTEGER, INTENT( IN ) :: damp_opt
493
494 REAL, INTENT( IN ) :: zdamp, dampcoef
495 real cf1
496 real cf2
497 real cf3
498 real cfn
499 real cfn1
500 type (grid_config_rec_type), intent(in) :: config_flags
501 real, intent(in) :: cosa(ims:ime,jms:jme)
502 real, intent(in) :: cqu(ims:ime,kms:kme,jms:jme)
503 real, intent(in) :: cqv(ims:ime,kms:kme,jms:jme)
504 real, intent(inout) :: cqw(ims:ime,kms:kme,jms:jme)
505 real, intent(in) :: dt
506 real, intent(in) :: e(ims:ime,jms:jme)
507 real, intent(in) :: f(ims:ime,jms:jme)
508 real, intent(in) :: fnm(kms:kme)
509 real, intent(in) :: fnp(kms:kme)
510 integer, intent(in) :: ide
511 integer, intent(in) :: ids
512 integer, intent(in) :: ite
513 integer, intent(in) :: its
514 integer, intent(in) :: jde
515 integer, intent(in) :: jds
516 integer, intent(in) :: jte
517 integer, intent(in) :: jts
518 integer, intent(in) :: kde
519 integer, intent(in) :: kte
520 integer, intent(in) :: kts
521 real, intent(in) :: kvdif
522 real, intent(in) :: msft(ims:ime,jms:jme)
523 real, intent(in) :: msfu(ims:ime,jms:jme)
524 real, intent(in) :: msfv(ims:ime,jms:jme)
525 real, intent(in) :: mu(ims:ime,jms:jme)
526 real, intent(in) :: mub(ims:ime,jms:jme)
527 real, intent(in) :: mut(ims:ime,jms:jme)
528 real, intent(in) :: muu(ims:ime,jms:jme)
529 real, intent(in) :: muv(ims:ime,jms:jme)
530 logical, intent(in) :: non_hydrostatic
531 real, intent(in) :: p(ims:ime,kms:kme,jms:jme)
532 real, intent(in) :: pb(ims:ime,kms:kme,jms:jme)
533 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
534 real, intent(in) :: ph_old(ims:ime,kms:kme,jms:jme)
535 real, intent(in) :: phb(ims:ime,kms:kme,jms:jme)
536 real, intent(in) :: php(ims:ime,kms:kme,jms:jme)
537 real, intent(in) :: rdn(kms:kme)
538 real, intent(in) :: rdnw(kms:kme)
539 real, intent(in) :: rdx
540 real, intent(in) :: rdy
541 integer, intent(in) :: rk_step
542 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
543 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
544 real, intent(in) :: rw(ims:ime,kms:kme,jms:jme)
545 real, intent(in) :: sina(ims:ime,jms:jme)
546 real, intent(in) :: t(ims:ime,kms:kme,jms:jme)
547 real, intent(in) :: t_init(ims:ime,kms:kme,jms:jme)
548 real, intent(in) :: t_old(ims:ime,kms:kme,jms:jme)
549 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
550 real, intent(in) :: u_base(kms:kme)
551 real, intent(in) :: u_old(ims:ime,kms:kme,jms:jme)
552 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
553 real, intent(in) :: v_base(kms:kme)
554 real, intent(in) :: v_old(ims:ime,kms:kme,jms:jme)
555 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
556 real, intent(in) :: w_old(ims:ime,kms:kme,jms:jme)
557 real, intent(in) :: ww(ims:ime,kms:kme,jms:jme)
558 real, intent(in) :: xkmhd(ims:ime,kms:kme,jms:jme)
559 real, intent(in) :: z_base(kms:kme)
560
561 !==============================================
562 ! declare local variables
563 !==============================================
564 real kvdq
565
566 !----------------------------------------------
567 ! ROUTINE BODY
568 !----------------------------------------------
569 a_forward_step: if (rk_step .eq. 1) then
570 a_diff_opt1: if (config_flags%diff_opt .eq. 1) then
571 a_pbl_test: if (config_flags%bl_pbl_physics .eq. 0) then
572 kvdq = 3.*kvdif
573 ! recompute : kvdq
574 call a_vertical_diffusion_3dmp( t,a_t,a_t_tendf,t_init,alt,a_alt,mut,a_mut,rdn,rdnw,kvdq,ide,jde,kde,ims,ime,jms,jme,kms,&
575 &kme,its,ite,jts,jte,kts,kte )
576 if (non_hydrostatic) then
577 call a_vertical_diffusion( 'w',w,a_w,a_rw_tendf,alt,a_alt,mut,a_mut,rdn,rdnw,kvdif,ide,jde,kde,ims,ime,jms,jme,kms,kme,&
578 &its,ite,jts,jte,kts,kte )
579 endif
580 call a_vertical_diffusion_v( v,a_v,a_rv_tendf,config_flags,v_base,alt,a_alt,muv,a_muv,rdn,rdnw,kvdif,ide,jds,jde,kde,ims,&
581 &ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
582 call a_vertical_diffusion_u( u,a_u,a_ru_tendf,config_flags,u_base,alt,a_alt,muu,a_muu,rdn,rdnw,kvdif,ids,ide,jde,kde,ims,&
583 &ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
584 endif a_pbl_test
585 call a_horizontal_diffusion_3dmp( t,a_t,a_t_tendf,mut,a_mut,config_flags,t_init,msfu,msfv,msft,xkmhd,a_xkmhd,rdx,rdy,ids,ide,&
586 &jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
587 call a_horizontal_diffusion( 'w',w,a_w,a_rw_tendf,mut,a_mut,config_flags,msfu,msfv,msft,xkmhd,a_xkmhd,rdx,rdy,ids,ide,jds,&
588 &jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
589 call a_horizontal_diffusion( 'v',v,a_v,a_rv_tendf,mut,a_mut,config_flags,msfu,msfv,msft,xkmhd,a_xkmhd,rdx,rdy,ids,ide,jds,&
590 &jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
591 call a_horizontal_diffusion( 'u',u,a_u,a_ru_tendf,mut,a_mut,config_flags,msfu,msfv,msft,xkmhd,a_xkmhd,rdx,rdy,ids,ide,jds,&
592 &jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
593 endif a_diff_opt1
594 endif a_forward_step
595 call 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,fnm,fnp,rdx,rdy,ids,ide,&
596 &jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
597 if (config_flags%pert_coriolis) then
598 call a_perturbation_coriolis( a_ru,a_rv,a_rw,a_ru_tend,a_rv_tend,a_rw_tend,config_flags,u_base,v_base,z_base,muu,a_muu,muv,a_muv,&
599 &phb,ph,a_ph,f,e,sina,cosa,fnm,fnp,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
600 else
601 call a_coriolis( a_ru,a_rv,a_rw,a_ru_tend,a_rv_tend,a_rw_tend,config_flags,f,e,sina,cosa,fnm,fnp,ids,ide,jds,jde,kde,ims,ime,jms,&
602 &jme,kms,kme,its,ite,jts,jte,kts,kte )
603 endif
604 if (config_flags%w_damping .eq. 1) then
605 call 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,jte )
606 endif
607 if (non_hydrostatic) then
608 call 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,its,ite,jts,jte )
609 endif
610 call 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,a_cqu,cqv,a_cqv,muu,&
611 &a_muu,muv,a_muv,mu,a_mu,fnm,fnp,rdnw,cf1,cf2,cf3,rdx,rdy,config_flags,non_hydrostatic,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,&
612 &its,ite,jts,jte,kte )
613 call a_rhs_ph( a_ph_tend,u,a_u,v,a_v,ww,a_ww,ph,a_ph,ph,a_ph,phb,w,a_w,mut,a_mut,muu,a_muu,muv,a_muv,fnm,fnp,rdnw,cfn,cfn1,rdx,&
614 &rdy,msft,non_hydrostatic,config_flags,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
615 call a_advect_scalar( t,a_t,t,a_t,a_t_tend,ru,a_ru,rv,a_rv,ww,a_ww,config_flags,msft,fnm,fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kde,&
616 &ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
617 if (non_hydrostatic) then
618 call a_advect_w( w,a_w,w,a_w,a_rw_tend,ru,a_ru,rv,a_rv,ww,a_ww,config_flags,msft,fnm,fnp,rdx,rdy,rdn,ids,ide,jds,jde,kde,ims,&
619 &ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
620 endif
621 call a_advect_v( v,a_v,v,a_v,a_rv_tend,ru,a_ru,rv,a_rv,ww,a_ww,mut,a_mut,config_flags,msfv,fnm,fnp,rdx,rdy,rdnw,ids,ide,jds,jde,&
622 &kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
623 call a_advect_u( u,a_u,u,a_u,a_ru_tend,ru,a_ru,rv,a_rv,ww,a_ww,mut,a_mut,config_flags,msfu,fnm,fnp,rdx,rdy,rdnw,ids,ide,jds,jde,&
624 &kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
625 call a_zero_tend( a_mu_tend,ims,ime,jms,jme,1,1,its,ite,jts,jte,1,1 )
626 call a_zero_tend( a_t_save,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
627 call a_zero_tend( a_ph_save,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
628 call a_zero_tend( a_w_save,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
629 call a_zero_tend( a_v_save,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
630 call a_zero_tend( a_u_save,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
631 call a_zero_tend( a_ph_tend,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
632 call a_zero_tend( a_t_tend,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
633 call a_zero_tend( a_rw_tend,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
634 call a_zero_tend( a_rv_tend,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
635 call a_zero_tend( a_ru_tend,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
636
637 end subroutine a_rk_tendency
638
639
640 subroutine a_rk_update_scalar( scs, sce, scalar_1, a_scalar_1, scalar_2, a_scalar_2, sc_tend, a_sc_tend, advect_tend, &
641 &a_advect_tend, msft, mu_old, a_mu_old, mu_new, a_mu_new, mu_base, rk_step, dt, spec_zone, config_flags, ids, ide,&
642 & jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
643 !******************************************************************
644 !******************************************************************
645 !** This routine was generated by Automatic differentiation. **
646 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
647 !******************************************************************
648 !******************************************************************
649 !==============================================
650 ! all entries are defined explicitly
651 !==============================================
652 implicit none
653
654 !==============================================
655 ! declare arguments
656 !==============================================
657 integer, intent(in) :: ime
658 integer, intent(in) :: ims
659 integer, intent(in) :: jme
660 integer, intent(in) :: jms
661 integer, intent(in) :: kme
662 integer, intent(in) :: kms
663 real, intent(inout) :: a_advect_tend(ims:ime,kms:kme,jms:jme)
664 real, intent(inout) :: a_mu_new(ims:ime,jms:jme)
665 real, intent(inout) :: a_mu_old(ims:ime,jms:jme)
666 integer, intent(in) :: sce
667 integer, intent(in) :: scs
668 real, intent(inout) :: a_sc_tend(ims:ime,kms:kme,jms:jme,scs:sce)
669 real, intent(inout) :: a_scalar_1(ims:ime,kms:kme,jms:jme,scs:sce)
670 real, intent(inout) :: a_scalar_2(ims:ime,kms:kme,jms:jme,scs:sce)
671 real, intent(in) :: advect_tend(ims:ime,kms:kme,jms:jme)
672 type (grid_config_rec_type), intent(in) :: config_flags
673 real, intent(in) :: dt
674 integer, intent(in) :: ide
675 integer, intent(in) :: ids
676 integer, intent(in) :: ite
677 integer, intent(in) :: its
678 integer, intent(in) :: jde
679 integer, intent(in) :: jds
680 integer, intent(in) :: jte
681 integer, intent(in) :: jts
682 integer, intent(in) :: kde
683 integer, intent(in) :: kte
684 integer, intent(in) :: kts
685 real, intent(in) :: msft(ims:ime,jms:jme)
686 real, intent(in) :: mu_base(ims:ime,jms:jme)
687 real, intent(in) :: mu_new(ims:ime,jms:jme)
688 real, intent(in) :: mu_old(ims:ime,jms:jme)
689 integer, intent(in) :: rk_step
690 real, intent(inout) :: sc_tend(ims:ime,kms:kme,jms:jme,scs:sce)
691 real, intent(inout) :: scalar_1(ims:ime,kms:kme,jms:jme,scs:sce)
692 real, intent(inout) :: scalar_2(ims:ime,kms:kme,jms:jme,scs:sce)
693 integer, intent(in) :: spec_zone
694
695 !==============================================
696 ! declare local variables
697 !==============================================
698 real a_muold(its:ite)
699 real a_r_munew(its:ite)
700 real a_sc_middle
701 real a_tendency(its:ite,kts:kte,jts:jte)
702 integer i
703 integer i_end
704 integer i_end_spc
705 integer i_start
706 integer i_start_spc
707 integer im
708 integer j
709 integer j_end
710 integer j_end_spc
711 integer j_start
712 integer j_start_spc
713 integer k
714 integer k_end
715 integer k_end_spc
716 integer k_start
717 integer k_start_spc
718 real muold(its:ite)
719 real r_munew(its:ite)
720 real tendency(its:ite,kts:kte,jts:jte)
721
722 !----------------------------------------------
723 ! RESET LOCAL ADJOINT VARIABLES
724 !----------------------------------------------
725 a_muold(:) = 0.
726 a_r_munew(:) = 0.
727 a_sc_middle = 0.
728 a_tendency(:,:,:) = 0.
729
730 !----------------------------------------------
731 ! ROUTINE BODY
732 !----------------------------------------------
733 i_start = its
734 ! recompute : i_start
735 i_end = ite
736 ! recompute : i_end
737 j_start = jts
738 ! recompute : j_start
739 j_end = jte
740 ! recompute : j_end
741 k_start = kts
742 ! recompute : k_start
743 k_end = kte-1
744 ! recompute : k_end
745 if (j_end .eq. jde) then
746 j_end = j_end-1
747 endif
748 ! recompute : j_end
749 if (i_end .eq. ide) then
750 i_end = i_end-1
751 endif
752 ! recompute : i_end
753 i_start_spc = i_start
754 ! recompute : i_start_spc
755 i_end_spc = i_end
756 ! recompute : i_end_spc
757 j_start_spc = j_start
758 ! recompute : j_start_spc
759 j_end_spc = j_end
760 ! recompute : j_end_spc
761 k_start_spc = k_start
762 ! recompute : k_start_spc
763 k_end_spc = k_end
764 ! recompute : k_end_spc
765 if (config_flags%nested .or. config_flags%specified) then
766 i_start = max(its,ids+spec_zone)
767 i_end = min(ite,ide-spec_zone-1)
768 j_start = max(jts,jds+spec_zone)
769 j_end = min(jte,jde-spec_zone-1)
770 k_start = kts
771 k_end = min(kte,kde-1)
772 endif
773 ! recompute : i_end,i_start,j_end,j_start,k_end,k_start
774 if (rk_step .eq. 1) then
775 do im = scs, sce
776 do j = jts, min(jte,jde-1)
777 do k = kts, min(kte,kde-1)
778 do i = its, min(ite,ide-1)
779 tendency(i,k,j) = 0.
780 end do
781 end do
782 end do
783 do j = j_start, j_end
784 do k = k_start, k_end
785 do i = i_start, i_end
786 tendency(i,k,j) = advect_tend(i,k,j)*msft(i,j)
787 end do
788 end do
789 end do
790 ! recompute : tendency
791 do j = j_start_spc, j_end_spc
792 do k = k_start_spc, k_end_spc
793 do i = i_start_spc, i_end_spc
794 tendency(i,k,j) = tendency(i,k,j)+sc_tend(i,k,j,im)
795 end do
796 end do
797 end do
798 ! recompute : tendency
799 do j = jts, min(jte,jde-1)
800 do i = its, min(ite,ide-1)
801 muold(i) = mu_old(i,j)+mu_base(i,j)
802 r_munew(i) = 1./(mu_new(i,j)+mu_base(i,j))
803 end do
804 ! recompute : muold,r_munew
805 do k = kts, min(kte,kde-1)
806 do i = its, min(ite,ide-1)
807 scalar_1(i,k,j,im) = scalar_2(i,k,j,im)
808 ! recompute : scalar_1
809 a_muold(i) = a_muold(i)+a_scalar_2(i,k,j,im)*scalar_1(i,k,j,im)*r_munew(i)
810 a_r_munew(i) = a_r_munew(i)+a_scalar_2(i,k,j,im)*(muold(i)*scalar_1(i,k,j,im)+dt*tendency(i,k,j))
811 a_scalar_1(i,k,j,im) = a_scalar_1(i,k,j,im)+a_scalar_2(i,k,j,im)*muold(i)*r_munew(i)
812 a_tendency(i,k,j) = a_tendency(i,k,j)+a_scalar_2(i,k,j,im)*dt*r_munew(i)
813 a_scalar_2(i,k,j,im) = 0.
814 a_scalar_2(i,k,j,im) = a_scalar_2(i,k,j,im)+a_scalar_1(i,k,j,im)
815 a_scalar_1(i,k,j,im) = 0.
816 end do
817 end do
818 do i = its, min(ite,ide-1)
819 a_mu_new(i,j) = a_mu_new(i,j)-a_r_munew(i)/((mu_new(i,j)+mu_base(i,j))*(mu_new(i,j)+mu_base(i,j)))
820 a_r_munew(i) = 0.
821 a_mu_old(i,j) = a_mu_old(i,j)+a_muold(i)
822 a_muold(i) = 0.
823 end do
824 end do
825 do j = j_start_spc, j_end_spc
826 do k = k_start_spc, k_end_spc
827 do i = i_start_spc, i_end_spc
828 a_sc_tend(i,k,j,im) = a_sc_tend(i,k,j,im)+a_tendency(i,k,j)
829 end do
830 end do
831 end do
832 do j = j_start, j_end
833 do k = k_start, k_end
834 do i = i_start, i_end
835 a_advect_tend(i,k,j) = a_advect_tend(i,k,j)+a_tendency(i,k,j)*msft(i,j)
836 a_tendency(i,k,j) = 0.
837 end do
838 end do
839 end do
840 do j = jts, min(jte,jde-1)
841 do k = kts, min(kte,kde-1)
842 do i = its, min(ite,ide-1)
843 a_tendency(i,k,j) = 0.
844 end do
845 end do
846 end do
847 end do
848 else
849 do im = scs, sce
850 do j = jts, min(jte,jde-1)
851 do k = kts, min(kte,kde-1)
852 do i = its, min(ite,ide-1)
853 tendency(i,k,j) = 0.
854 end do
855 end do
856 end do
857 do j = j_start, j_end
858 do k = k_start, k_end
859 do i = i_start, i_end
860 tendency(i,k,j) = advect_tend(i,k,j)*msft(i,j)
861 end do
862 end do
863 end do
864 ! recompute : tendency
865 do j = j_start_spc, j_end_spc
866 do k = k_start_spc, k_end_spc
867 do i = i_start_spc, i_end_spc
868 tendency(i,k,j) = tendency(i,k,j)+sc_tend(i,k,j,im)
869 end do
870 end do
871 end do
872 ! recompute : tendency
873 do j = jts, min(jte,jde-1)
874 do i = its, min(ite,ide-1)
875 muold(i) = mu_old(i,j)+mu_base(i,j)
876 r_munew(i) = 1./(mu_new(i,j)+mu_base(i,j))
877 end do
878 ! recompute : muold,r_munew
879 do k = kts, min(kte,kde-1)
880 do i = its, min(ite,ide-1)
881 a_muold(i) = a_muold(i)+a_scalar_2(i,k,j,im)*scalar_1(i,k,j,im)*r_munew(i)
882 a_r_munew(i) = a_r_munew(i)+a_scalar_2(i,k,j,im)*(muold(i)*scalar_1(i,k,j,im)+dt*tendency(i,k,j))
883 a_scalar_1(i,k,j,im) = a_scalar_1(i,k,j,im)+a_scalar_2(i,k,j,im)*muold(i)*r_munew(i)
884 a_tendency(i,k,j) = a_tendency(i,k,j)+a_scalar_2(i,k,j,im)*dt*r_munew(i)
885 a_scalar_2(i,k,j,im) = 0.
886 end do
887 end do
888 do i = its, min(ite,ide-1)
889 a_mu_new(i,j) = a_mu_new(i,j)-a_r_munew(i)/((mu_new(i,j)+mu_base(i,j))*(mu_new(i,j)+mu_base(i,j)))
890 a_r_munew(i) = 0.
891 a_mu_old(i,j) = a_mu_old(i,j)+a_muold(i)
892 a_muold(i) = 0.
893 end do
894 end do
895 do j = j_start_spc, j_end_spc
896 do k = k_start_spc, k_end_spc
897 do i = i_start_spc, i_end_spc
898 a_sc_tend(i,k,j,im) = a_sc_tend(i,k,j,im)+a_tendency(i,k,j)
899 end do
900 end do
901 end do
902 do j = j_start, j_end
903 do k = k_start, k_end
904 do i = i_start, i_end
905 a_advect_tend(i,k,j) = a_advect_tend(i,k,j)+a_tendency(i,k,j)*msft(i,j)
906 a_tendency(i,k,j) = 0.
907 end do
908 end do
909 end do
910 do j = jts, min(jte,jde-1)
911 do k = kts, min(kte,kde-1)
912 do i = its, min(ite,ide-1)
913 a_tendency(i,k,j) = 0.
914 end do
915 end do
916 end do
917 end do
918 endif
919
920
921 end subroutine a_rk_update_scalar
922
923
924 end module a_module_em
925
926