module_em_tl.F
References to this file elsewhere.
1 ! DISCLAIMER
2 !
3 ! This file was generated by TAF version 1.7.18
4 !
5 ! FASTOPT DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED,
6 ! INCLUDING (WITHOUT LIMITATION) ALL IMPLIED WARRANTIES OF
7 ! MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, WITH
8 ! RESPECT TO THE SOFTWARE AND USER PROGRAMS. IN NO EVENT
9 ! SHALL FASTOPT BE LIABLE FOR ANY LOST OR ANTICIPATED PROF-
10 ! ITS, OR ANY INDIRECT, INCIDENTAL, EXEMPLARY, SPECIAL, OR
11 ! CONSEQUENTIAL DAMAGES, WHETHER OR NOT FASTOPT WAS ADVISED
12 ! OF THE POSSIBILITY OF SUCH DAMAGES.
13 !
14 ! Haftungsbeschraenkung
15 ! FastOpt gibt ausdruecklich keine Gewaehr, explizit oder indirekt,
16 ! bezueglich der Brauchbarkeit der Software fuer einen bestimmten
17 ! Zweck. Unter keinen Umstaenden ist FastOpt haftbar fuer
18 ! irgendeinen Verlust oder nicht eintretenden erwarteten Gewinn und
19 ! allen indirekten, zufaelligen, exemplarischen oder speziellen
20 ! Schaeden oder Folgeschaeden unabhaengig von einer eventuellen
21 ! Mitteilung darueber an FastOpt.
22 !
23 module g_module_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 module_big_step_utilities_em
36 use module_state_description
37 use module_em
38
39 use g_module_advect_em
40 use g_module_big_step_utilities_em
41
42 !==============================================
43 ! all entries are defined explicitly
44 !==============================================
45 implicit none
46
47 contains
48 subroutine g_init_zero_tendency( ru_tendf, g_ru_tendf, rv_tendf, g_rv_tendf, rw_tendf, g_rw_tendf, ph_tendf, g_ph_tendf, t_tendf, &
49 &g_t_tendf, moist_tendf, g_moist_tendf, chem_tendf, g_chem_tendf, scalar_tendf, g_scalar_tendf, &
50 n_moist, n_chem, n_scalar, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
51 !******************************************************************
52 !******************************************************************
53 !** This routine was generated by Automatic differentiation. **
54 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
55 !******************************************************************
56 !******************************************************************
57 !==============================================
58 ! all entries are defined explicitly
59 !==============================================
60 implicit none
61
62 !==============================================
63 ! declare arguments
64 !==============================================
65 integer, intent(in) :: ime
66 integer, intent(in) :: ims
67 integer, intent(in) :: jme
68 integer, intent(in) :: jms
69 integer, intent(in) :: kme
70 integer, intent(in) :: kms
71 integer, intent(in) :: n_moist, n_chem, n_scalar
72 real, intent(inout) :: g_moist_tendf(ims:ime,kms:kme,jms:jme,n_moist)
73 real, intent(inout) :: g_chem_tendf(ims:ime,kms:kme,jms:jme,n_chem)
74 real, intent(inout) :: g_scalar_tendf(ims:ime,kms:kme,jms:jme,n_scalar)
75 real, intent(inout) :: g_ph_tendf(ims:ime,kms:kme,jms:jme)
76 real, intent(inout) :: g_ru_tendf(ims:ime,kms:kme,jms:jme)
77 real, intent(inout) :: g_rv_tendf(ims:ime,kms:kme,jms:jme)
78 real, intent(inout) :: g_rw_tendf(ims:ime,kms:kme,jms:jme)
79 real, intent(inout) :: g_t_tendf(ims:ime,kms:kme,jms:jme)
80 integer, intent(in) :: ite
81 integer, intent(in) :: its
82 integer, intent(in) :: jte
83 integer, intent(in) :: jts
84 integer, intent(in) :: kte
85 integer, intent(in) :: kts
86 real, intent(inout) :: moist_tendf(ims:ime,kms:kme,jms:jme,n_moist)
87 real, intent(inout) :: chem_tendf(ims:ime,kms:kme,jms:jme,n_chem)
88 real, intent(inout) :: scalar_tendf(ims:ime,kms:kme,jms:jme,n_scalar)
89 real, intent(inout) :: ph_tendf(ims:ime,kms:kme,jms:jme)
90 real, intent(inout) :: ru_tendf(ims:ime,kms:kme,jms:jme)
91 real, intent(inout) :: rv_tendf(ims:ime,kms:kme,jms:jme)
92 real, intent(inout) :: rw_tendf(ims:ime,kms:kme,jms:jme)
93 real, intent(inout) :: t_tendf(ims:ime,kms:kme,jms:jme)
94
95 !==============================================
96 ! declare local variables
97 !==============================================
98 integer im
99
100 !----------------------------------------------
101 ! TANGENT LINEAR AND FUNCTION STATEMENTS
102 !----------------------------------------------
103 call g_zero_tend( ru_tendf,g_ru_tendf,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
104 call g_zero_tend( rv_tendf,g_rv_tendf,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
105 call g_zero_tend( rw_tendf,g_rw_tendf,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
106 call g_zero_tend( ph_tendf,g_ph_tendf,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
107 call g_zero_tend( t_tendf,g_t_tendf,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
108 do im = 1, n_moist
109 call g_zero_tend( moist_tendf(ims,kms,jms,im),g_moist_tendf(ims,kms,jms,im),ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
110 end do
111
112 end subroutine g_init_zero_tendency
113
114
115 subroutine g_rk_addtend_dry( ru_tend, g_ru_tend, rv_tend, g_rv_tend, rw_tend, g_rw_tend, ph_tend, g_ph_tend, t_tend, g_t_tend, &
116 &ru_tendf, g_ru_tendf, rv_tendf, g_rv_tendf, rw_tendf, g_rw_tendf, ph_tendf, g_ph_tendf, t_tendf, g_t_tendf, u_save, g_u_save, &
117 &v_save, g_v_save, w_save, g_w_save, ph_save, g_ph_save, t_save, g_t_save, rk_step, h_diabatic, mut, g_mut, msft, msfu, msfv, ide, &
118 &jde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
119 !******************************************************************
120 !******************************************************************
121 !** This routine was generated by Automatic differentiation. **
122 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
123 !******************************************************************
124 !******************************************************************
125 !==============================================
126 ! all entries are defined explicitly
127 !==============================================
128 implicit none
129
130 !==============================================
131 ! declare arguments
132 !==============================================
133 integer, intent(in) :: ime
134 integer, intent(in) :: ims
135 integer, intent(in) :: jme
136 integer, intent(in) :: jms
137 real, intent(in) :: g_mut(ims:ime,jms:jme)
138 integer, intent(in) :: kme
139 integer, intent(in) :: kms
140 real, intent(in) :: g_ph_save(ims:ime,kms:kme,jms:jme)
141 real, intent(inout) :: g_ph_tend(ims:ime,kms:kme,jms:jme)
142 real, intent(inout) :: g_ph_tendf(ims:ime,kms:kme,jms:jme)
143 real, intent(inout) :: g_ru_tend(ims:ime,kms:kme,jms:jme)
144 real, intent(inout) :: g_ru_tendf(ims:ime,kms:kme,jms:jme)
145 real, intent(inout) :: g_rv_tend(ims:ime,kms:kme,jms:jme)
146 real, intent(inout) :: g_rv_tendf(ims:ime,kms:kme,jms:jme)
147 real, intent(inout) :: g_rw_tend(ims:ime,kms:kme,jms:jme)
148 real, intent(inout) :: g_rw_tendf(ims:ime,kms:kme,jms:jme)
149 real, intent(in) :: g_t_save(ims:ime,kms:kme,jms:jme)
150 real, intent(inout) :: g_t_tend(ims:ime,kms:kme,jms:jme)
151 real, intent(inout) :: g_t_tendf(ims:ime,kms:kme,jms:jme)
152 real, intent(in) :: g_u_save(ims:ime,kms:kme,jms:jme)
153 real, intent(in) :: g_v_save(ims:ime,kms:kme,jms:jme)
154 real, intent(in) :: g_w_save(ims:ime,kms:kme,jms:jme)
155 real, intent(in) :: h_diabatic(ims:ime,kms:kme,jms:jme)
156 integer, intent(in) :: ide
157 integer, intent(in) :: ite
158 integer, intent(in) :: its
159 integer, intent(in) :: jde
160 integer, intent(in) :: jte
161 integer, intent(in) :: jts
162 integer, intent(in) :: kte
163 integer, intent(in) :: kts
164 real, intent(in) :: msft(ims:ime,jms:jme)
165 real, intent(in) :: msfu(ims:ime,jms:jme)
166 real, intent(in) :: msfv(ims:ime,jms:jme)
167 real, intent(in) :: mut(ims:ime,jms:jme)
168 real, intent(in) :: ph_save(ims:ime,kms:kme,jms:jme)
169 real, intent(inout) :: ph_tend(ims:ime,kms:kme,jms:jme)
170 real, intent(inout) :: ph_tendf(ims:ime,kms:kme,jms:jme)
171 integer, intent(in) :: rk_step
172 real, intent(inout) :: ru_tend(ims:ime,kms:kme,jms:jme)
173 real, intent(inout) :: ru_tendf(ims:ime,kms:kme,jms:jme)
174 real, intent(inout) :: rv_tend(ims:ime,kms:kme,jms:jme)
175 real, intent(inout) :: rv_tendf(ims:ime,kms:kme,jms:jme)
176 real, intent(inout) :: rw_tend(ims:ime,kms:kme,jms:jme)
177 real, intent(inout) :: rw_tendf(ims:ime,kms:kme,jms:jme)
178 real, intent(in) :: t_save(ims:ime,kms:kme,jms:jme)
179 real, intent(inout) :: t_tend(ims:ime,kms:kme,jms:jme)
180 real, intent(inout) :: t_tendf(ims:ime,kms:kme,jms:jme)
181 real, intent(in) :: u_save(ims:ime,kms:kme,jms:jme)
182 real, intent(in) :: v_save(ims:ime,kms:kme,jms:jme)
183 real, intent(in) :: w_save(ims:ime,kms:kme,jms:jme)
184
185 !==============================================
186 ! declare local variables
187 !==============================================
188 integer i
189 integer j
190 integer k
191
192 !----------------------------------------------
193 ! TANGENT LINEAR AND FUNCTION STATEMENTS
194 !----------------------------------------------
195 do j = jts, min(jte,jde-1)
196 do k = kts, kte-1
197 do i = its, ite
198 if (rk_step .eq. 1) then
199 g_ru_tendf(i,k,j) = g_ru_tendf(i,k,j)+g_u_save(i,k,j)*msfu(i,j)
200 ru_tendf(i,k,j) = ru_tendf(i,k,j)+u_save(i,k,j)*msfu(i,j)
201 endif
202 g_ru_tend(i,k,j) = g_ru_tend(i,k,j)+g_ru_tendf(i,k,j)/msfu(i,j)
203 ru_tend(i,k,j) = ru_tend(i,k,j)+ru_tendf(i,k,j)/msfu(i,j)
204 end do
205 end do
206 end do
207 do j = jts, jte
208 do k = kts, kte-1
209 do i = its, min(ite,ide-1)
210 if (rk_step .eq. 1) then
211 g_rv_tendf(i,k,j) = g_rv_tendf(i,k,j)+g_v_save(i,k,j)*msfv(i,j)
212 rv_tendf(i,k,j) = rv_tendf(i,k,j)+v_save(i,k,j)*msfv(i,j)
213 endif
214 g_rv_tend(i,k,j) = g_rv_tend(i,k,j)+g_rv_tendf(i,k,j)/msfv(i,j)
215 rv_tend(i,k,j) = rv_tend(i,k,j)+rv_tendf(i,k,j)/msfv(i,j)
216 end do
217 end do
218 end do
219 do j = jts, min(jte,jde-1)
220 do k = kts, kte
221 do i = its, min(ite,ide-1)
222 if (rk_step .eq. 1) then
223 g_rw_tendf(i,k,j) = g_rw_tendf(i,k,j)+g_w_save(i,k,j)*msft(i,j)
224 rw_tendf(i,k,j) = rw_tendf(i,k,j)+w_save(i,k,j)*msft(i,j)
225 endif
226 g_rw_tend(i,k,j) = g_rw_tend(i,k,j)+g_rw_tendf(i,k,j)/msft(i,j)
227 rw_tend(i,k,j) = rw_tend(i,k,j)+rw_tendf(i,k,j)/msft(i,j)
228 if (rk_step .eq. 1) then
229 g_ph_tendf(i,k,j) = g_ph_save(i,k,j)+g_ph_tendf(i,k,j)
230 ph_tendf(i,k,j) = ph_tendf(i,k,j)+ph_save(i,k,j)
231 endif
232 g_ph_tend(i,k,j) = g_ph_tend(i,k,j)+g_ph_tendf(i,k,j)/msft(i,j)
233 ph_tend(i,k,j) = ph_tend(i,k,j)+ph_tendf(i,k,j)/msft(i,j)
234 end do
235 end do
236 end do
237 do j = jts, min(jte,jde-1)
238 do k = kts, kte-1
239 do i = its, min(ite,ide-1)
240 if (rk_step .eq. 1) then
241 g_t_tendf(i,k,j) = g_t_save(i,k,j)+g_t_tendf(i,k,j)
242 t_tendf(i,k,j) = t_tendf(i,k,j)+t_save(i,k,j)
243 endif
244 g_t_tend(i,k,j) = g_mut(i,j)*(h_diabatic(i,k,j)/msft(i,j))+g_t_tend(i,k,j)+g_t_tendf(i,k,j)/msft(i,j)
245 t_tend(i,k,j) = t_tend(i,k,j)+t_tendf(i,k,j)/msft(i,j)+mut(i,j)*h_diabatic(i,k,j)/msft(i,j)
246 end do
247 end do
248 end do
249
250 end subroutine g_rk_addtend_dry
251
252
253 subroutine g_rk_scalar_tend( scs, sce, config_flags, rk_step, ru, g_ru, rv, g_rv, ww, g_ww, mut, g_mut, alt, g_alt, &
254 scalar, g_scalar, scalar_tends, g_scalar_tends, advect_tend, g_advect_tend, base, moist_step, fnm, fnp, msfu, msfv, &
255 &msft, rdx, rdy, rdn, rdnw, kvdif, xkmhd, g_xkmhd, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, &
256 &jte, kts, kte )
257 !******************************************************************
258 !******************************************************************
259 !** This routine was generated by Automatic differentiation. **
260 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
261 !******************************************************************
262 !******************************************************************
263 !==============================================
264 ! all entries are defined explicitly
265 !==============================================
266 implicit none
267
268 !==============================================
269 ! declare arguments
270 !==============================================
271 integer, intent(in) :: ime
272 integer, intent(in) :: ims
273 integer, intent(in) :: jme
274 integer, intent(in) :: jms
275 integer, intent(in) :: kme
276 integer, intent(in) :: kms
277 real advect_tend(ims:ime,kms:kme,jms:jme)
278 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
279 real, intent(in) :: base(kms:kme)
280 type (grid_config_rec_type), intent(in) :: config_flags
281 real, intent(in) :: fnm(kms:kme)
282 real, intent(in) :: fnp(kms:kme)
283 real g_advect_tend(ims:ime,kms:kme,jms:jme)
284 real, intent(in) :: g_alt(ims:ime,kms:kme,jms:jme)
285 real, intent(in) :: g_mut(ims:ime,jms:jme)
286 real, intent(in) :: g_ru(ims:ime,kms:kme,jms:jme)
287 real, intent(in) :: g_rv(ims:ime,kms:kme,jms:jme)
288 integer, intent(in) :: sce
289 integer, intent(in) :: scs
290 real, intent(inout) :: g_scalar(ims:ime,kms:kme,jms:jme,scs:sce)
291 real, intent(out) :: g_scalar_tends(ims:ime,kms:kme,jms:jme,scs:sce)
292 real, intent(in) :: g_ww(ims:ime,kms:kme,jms:jme)
293 real, intent(in) :: g_xkmhd(ims:ime,kms:kme,jms:jme)
294 integer, intent(in) :: ide
295 integer, intent(in) :: ids
296 integer, intent(in) :: ite
297 integer, intent(in) :: its
298 integer, intent(in) :: jde
299 integer, intent(in) :: jds
300 integer, intent(in) :: jte
301 integer, intent(in) :: jts
302 integer, intent(in) :: kde
303 integer, intent(in) :: kte
304 integer, intent(in) :: kts
305 real, intent(in) :: kvdif
306 logical, intent(in) :: moist_step
307 real, intent(in) :: msft(ims:ime,jms:jme)
308 real, intent(in) :: msfu(ims:ime,jms:jme)
309 real, intent(in) :: msfv(ims:ime,jms:jme)
310 real, intent(in) :: mut(ims:ime,jms:jme)
311 real, intent(in) :: rdn(kms:kme)
312 real, intent(in) :: rdnw(kms:kme)
313 real, intent(in) :: rdx
314 real, intent(in) :: rdy
315 integer, intent(in) :: rk_step
316 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
317 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
318 real, intent(inout) :: scalar(ims:ime,kms:kme,jms:jme,scs:sce)
319 real, intent(out) :: scalar_tends(ims:ime,kms:kme,jms:jme,scs:sce)
320 real, intent(in) :: ww(ims:ime,kms:kme,jms:jme)
321 real, intent(in) :: xkmhd(ims:ime,kms:kme,jms:jme)
322
323 !==============================================
324 ! declare local variables
325 !==============================================
326 integer im
327 real kvdq
328
329 !----------------------------------------------
330 ! TANGENT LINEAR AND FUNCTION STATEMENTS
331 !----------------------------------------------
332 kvdq = kvdif/prandtl
333 scalar_loop: do im = scs, sce
334 call g_zero_tend( advect_tend(ims,kms,jms),g_advect_tend(ims,kms,jms),ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
335 call g_advect_scalar( scalar(ims,kms,jms,im),g_scalar(ims,kms,jms,im),scalar(ims,kms,jms,im),g_scalar(ims,kms,jms,im),&
336 &advect_tend(ims,kms,jms),g_advect_tend(ims,kms,jms),ru,g_ru,rv,g_rv,ww,g_ww,config_flags,msft,fnm,fnp,rdx,rdy,rdnw,ids,ide,&
337 &jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
338
339 diff_opt2: if (config_flags%diff_opt .eq. 1) then
340 rk_step_2: if (rk_step .eq. 1) then
341 call g_horizontal_diffusion( 'm',scalar(ims,kms,jms,im),g_scalar(ims,kms,jms,im),scalar_tends(ims,kms,jms,im),&
342 &g_scalar_tends(ims,kms,jms,im),mut,g_mut,config_flags,msfu,msfv,msft,xkmhd,g_xkmhd,rdx,rdy,ids,ide,jds,jde,kde,ims,ime,&
343 &jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
344 pbl_tesu: if (config_flags%bl_pbl_physics .eq. 0) then
345 if (moist_step .and. im .eq. p_qv) then
346 call g_vertical_diffusion_mp( scalar(ims,kms,jms,im),g_scalar(ims,kms,jms,im),scalar_tends(ims,kms,jms,im),&
347 &g_scalar_tends(ims,kms,jms,im),base,alt,g_alt,mut,g_mut,rdn,rdnw,kvdq,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
348 else
349 call g_vertical_diffusion( 'm',scalar(ims,kms,jms,im),g_scalar(ims,kms,jms,im),scalar_tends(ims,kms,jms,im),&
350 &g_scalar_tends(ims,kms,jms,im),alt,g_alt,mut,g_mut,rdn,rdnw,kvdq,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
351 endif
352 endif pbl_tesu
353
354 endif rk_step_2
355 endif diff_opt2
356 end do scalar_loop
357
358 end subroutine g_rk_scalar_tend
359
360
361 subroutine g_rk_step_prep( config_flags, u, g_u, v, g_v, w, g_w, ph, g_ph, mu, g_mu, moist, g_moist, ru, g_ru, rv, g_rv, rw, g_rw, &
362 &ww, g_ww, php, g_php, alt, g_alt, muu, g_muu, muv, g_muv, mub, mut, g_mut, phb, al, g_al, alb, cqu, g_cqu, cqv, g_cqv, cqw, g_cqw,&
363 & msfu, msfv, msft, dnw, rdx, rdy, n_moist, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
364 !******************************************************************
365 !******************************************************************
366 !** This routine was generated by Automatic differentiation. **
367 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
368 !******************************************************************
369 !******************************************************************
370 !==============================================
371 ! all entries are defined explicitly
372 !==============================================
373 implicit none
374
375 !==============================================
376 ! declare arguments
377 !==============================================
378 integer, intent(in) :: ime
379 integer, intent(in) :: ims
380 integer, intent(in) :: jme
381 integer, intent(in) :: jms
382 integer, intent(in) :: kme
383 integer, intent(in) :: kms
384 real, intent(in) :: al(ims:ime,kms:kme,jms:jme)
385 real, intent(in) :: alb(ims:ime,kms:kme,jms:jme)
386 real, intent(out) :: alt(ims:ime,kms:kme,jms:jme)
387 type (grid_config_rec_type), intent(in) :: config_flags
388 real, intent(out) :: cqu(ims:ime,kms:kme,jms:jme)
389 real, intent(out) :: cqv(ims:ime,kms:kme,jms:jme)
390 real, intent(out) :: cqw(ims:ime,kms:kme,jms:jme)
391 real, intent(in) :: dnw(kms:kme)
392 real, intent(in) :: g_al(ims:ime,kms:kme,jms:jme)
393 real, intent(out) :: g_alt(ims:ime,kms:kme,jms:jme)
394 real, intent(out) :: g_cqu(ims:ime,kms:kme,jms:jme)
395 real, intent(out) :: g_cqv(ims:ime,kms:kme,jms:jme)
396 real, intent(out) :: g_cqw(ims:ime,kms:kme,jms:jme)
397 integer, intent(in) :: n_moist
398 real, intent(in) :: g_moist(ims:ime,kms:kme,jms:jme,n_moist)
399 real, intent(in) :: g_mu(ims:ime,jms:jme)
400 real, intent(out) :: g_mut(ims:ime,jms:jme)
401 real, intent(out) :: g_muu(ims:ime,jms:jme)
402 real, intent(out) :: g_muv(ims:ime,jms:jme)
403 real, intent(in) :: g_ph(ims:ime,kms:kme,jms:jme)
404 real, intent(out) :: g_php(ims:ime,kms:kme,jms:jme)
405 real, intent(out) :: g_ru(ims:ime,kms:kme,jms:jme)
406 real, intent(out) :: g_rv(ims:ime,kms:kme,jms:jme)
407 real, intent(out) :: g_rw(ims:ime,kms:kme,jms:jme)
408 real, intent(in) :: g_u(ims:ime,kms:kme,jms:jme)
409 real, intent(in) :: g_v(ims:ime,kms:kme,jms:jme)
410 real, intent(in) :: g_w(ims:ime,kms:kme,jms:jme)
411 real, intent(out) :: g_ww(ims:ime,kms:kme,jms:jme)
412 integer, intent(in) :: ide
413 integer, intent(in) :: ids
414 integer, intent(in) :: ite
415 integer, intent(in) :: its
416 integer, intent(in) :: jde
417 integer, intent(in) :: jds
418 integer, intent(in) :: jte
419 integer, intent(in) :: jts
420 integer, intent(in) :: kde
421 integer, intent(in) :: kte
422 integer, intent(in) :: kts
423 real, intent(in) :: moist(ims:ime,kms:kme,jms:jme,n_moist)
424 real, intent(in) :: msft(ims:ime,jms:jme)
425 real, intent(in) :: msfu(ims:ime,jms:jme)
426 real, intent(in) :: msfv(ims:ime,jms:jme)
427 real, intent(in) :: mu(ims:ime,jms:jme)
428 real, intent(in) :: mub(ims:ime,jms:jme)
429 real, intent(out) :: mut(ims:ime,jms:jme)
430 real, intent(out) :: muu(ims:ime,jms:jme)
431 real, intent(out) :: muv(ims:ime,jms:jme)
432 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
433 real, intent(in) :: phb(ims:ime,kms:kme,jms:jme)
434 real, intent(out) :: php(ims:ime,kms:kme,jms:jme)
435 real, intent(in) :: rdx
436 real, intent(in) :: rdy
437 real, intent(out) :: ru(ims:ime,kms:kme,jms:jme)
438 real, intent(out) :: rv(ims:ime,kms:kme,jms:jme)
439 real, intent(out) :: rw(ims:ime,kms:kme,jms:jme)
440 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
441 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
442 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
443 real, intent(out) :: ww(ims:ime,kms:kme,jms:jme)
444
445 !----------------------------------------------
446 ! TANGENT LINEAR AND FUNCTION STATEMENTS
447 !----------------------------------------------
448 call g_calculate_full( mut,g_mut,mub,mu,g_mu,ide,jde,2,ims,ime,jms,jme,1,1,its,ite,jts,jte,1,1 )
449 call g_calc_mu_uv( config_flags,mu,g_mu,mub,muu,g_muu,muv,g_muv,ids,ide,jds,jde,ims,ime,jms,jme,its,ite,jts,jte )
450 call g_couple_momentum( muu,g_muu,ru,g_ru,u,g_u,msfu,muv,g_muv,rv,g_rv,v,g_v,msfv,mut,g_mut,rw,g_rw,w,g_w,msft,ide,jde,kde,ims,ime,&
451 &jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
452 call g_calc_ww_cp( u,g_u,v,g_v,mu,g_mu,mub,ww,g_ww,rdx,rdy,msft,msfu,msfv,dnw,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,&
453 &kts,kte )
454 call g_calc_cq( moist,g_moist,cqu,g_cqu,cqv,g_cqv,cqw,g_cqw,n_moist,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
455 call g_calc_alt( alt,g_alt,al,g_al,alb,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
456 call g_calc_php( php,g_php,ph,g_ph,phb,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
457
458 end subroutine g_rk_step_prep
459
460
461 subroutine g_rk_tendency( config_flags, rk_step, ru_tend, g_ru_tend, rv_tend, g_rv_tend, rw_tend, g_rw_tend, ph_tend, g_ph_tend, &
462 &t_tend, g_t_tend, ru_tendf, g_ru_tendf, rv_tendf, g_rv_tendf, rw_tendf, g_rw_tendf, t_tendf, g_t_tendf, mu_tend, g_mu_tend, &
463 &u_save, g_u_save, v_save, g_v_save, w_save, g_w_save, ph_save, g_ph_save, t_save, g_t_save, ru, g_ru, rv, g_rv, rw, g_rw, ww, &
464 &g_ww, u, g_u, v, g_v, w, g_w, t, g_t, ph, g_ph, u_old, g_u_old, v_old, g_v_old, w_old, g_w_old, t_old, g_t_old, ph_old, g_ph_old, &
465 &phb, t_init, mu, g_mu, mut, g_mut, muu, g_muu, muv, g_muv, mub, al, g_al, alt, g_alt, p, g_p, pb, php, g_php, cqu, g_cqu, cqv, &
466 &g_cqv, cqw, g_cqw, u_base, v_base, z_base, msfu, msfv, msft, f, e, sina, cosa, fnm, fnp, rdn, rdnw, dt, rdx, rdy, kvdif, xkmhd, &
467 &g_xkmhd, &
468 dampcoef,zdamp,damp_opt, &
469 cf1, cf2, cf3, cfn, cfn1, non_hydrostatic, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, &
470 &jts, jte, kts, kte )
471 !******************************************************************
472 !******************************************************************
473 !** This routine was generated by Automatic differentiation. **
474 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
475 !******************************************************************
476 !******************************************************************
477 !==============================================
478 ! all entries are defined explicitly
479 !==============================================
480 implicit none
481
482 !==============================================
483 ! declare arguments
484 !==============================================
485 integer, intent(in) :: ime
486 integer, intent(in) :: ims
487 integer, intent(in) :: jme
488 integer, intent(in) :: jms
489 integer, intent(in) :: kme
490 integer, intent(in) :: kms
491 real, intent(in) :: al(ims:ime,kms:kme,jms:jme)
492 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
493
494 INTEGER, INTENT( IN ) :: damp_opt
495
496 REAL, INTENT( IN ) :: zdamp, dampcoef
497
498 real cf1
499 real cf2
500 real cf3
501 real cfn
502 real cfn1
503 type (grid_config_rec_type), intent(in) :: config_flags
504 real, intent(in) :: cosa(ims:ime,jms:jme)
505 real, intent(in) :: cqu(ims:ime,kms:kme,jms:jme)
506 real, intent(in) :: cqv(ims:ime,kms:kme,jms:jme)
507 real, intent(inout) :: cqw(ims:ime,kms:kme,jms:jme)
508 real, intent(in) :: dt
509 real, intent(in) :: e(ims:ime,jms:jme)
510 real, intent(in) :: f(ims:ime,jms:jme)
511 real, intent(in) :: fnm(kms:kme)
512 real, intent(in) :: fnp(kms:kme)
513 real, intent(in) :: g_al(ims:ime,kms:kme,jms:jme)
514 real, intent(in) :: g_alt(ims:ime,kms:kme,jms:jme)
515 real, intent(in) :: g_cqu(ims:ime,kms:kme,jms:jme)
516 real, intent(in) :: g_cqv(ims:ime,kms:kme,jms:jme)
517 real, intent(inout) :: g_cqw(ims:ime,kms:kme,jms:jme)
518 real, intent(in) :: g_mu(ims:ime,jms:jme)
519 real, intent(out) :: g_mu_tend(ims:ime,jms:jme)
520 real, intent(in) :: g_mut(ims:ime,jms:jme)
521 real, intent(in) :: g_muu(ims:ime,jms:jme)
522 real, intent(in) :: g_muv(ims:ime,jms:jme)
523 real, intent(in) :: g_p(ims:ime,kms:kme,jms:jme)
524 real, intent(in) :: g_ph(ims:ime,kms:kme,jms:jme)
525 real, intent(in) :: g_ph_old(ims:ime,kms:kme,jms:jme)
526 real, intent(out) :: g_ph_save(ims:ime,kms:kme,jms:jme)
527 real, intent(out) :: g_ph_tend(ims:ime,kms:kme,jms:jme)
528 real, intent(in) :: g_php(ims:ime,kms:kme,jms:jme)
529 real, intent(in) :: g_ru(ims:ime,kms:kme,jms:jme)
530 real, intent(out) :: g_ru_tend(ims:ime,kms:kme,jms:jme)
531 real, intent(inout) :: g_ru_tendf(ims:ime,kms:kme,jms:jme)
532 real, intent(in) :: g_rv(ims:ime,kms:kme,jms:jme)
533 real, intent(out) :: g_rv_tend(ims:ime,kms:kme,jms:jme)
534 real, intent(inout) :: g_rv_tendf(ims:ime,kms:kme,jms:jme)
535 real, intent(in) :: g_rw(ims:ime,kms:kme,jms:jme)
536 real, intent(out) :: g_rw_tend(ims:ime,kms:kme,jms:jme)
537 real, intent(inout) :: g_rw_tendf(ims:ime,kms:kme,jms:jme)
538 real, intent(in) :: g_t(ims:ime,kms:kme,jms:jme)
539 real, intent(in) :: g_t_old(ims:ime,kms:kme,jms:jme)
540 real, intent(out) :: g_t_save(ims:ime,kms:kme,jms:jme)
541 real, intent(out) :: g_t_tend(ims:ime,kms:kme,jms:jme)
542 real, intent(inout) :: g_t_tendf(ims:ime,kms:kme,jms:jme)
543 real, intent(in) :: g_u(ims:ime,kms:kme,jms:jme)
544 real, intent(in) :: g_u_old(ims:ime,kms:kme,jms:jme)
545 real, intent(out) :: g_u_save(ims:ime,kms:kme,jms:jme)
546 real, intent(in) :: g_v(ims:ime,kms:kme,jms:jme)
547 real, intent(in) :: g_v_old(ims:ime,kms:kme,jms:jme)
548 real, intent(out) :: g_v_save(ims:ime,kms:kme,jms:jme)
549 real, intent(in) :: g_w(ims:ime,kms:kme,jms:jme)
550 real, intent(in) :: g_w_old(ims:ime,kms:kme,jms:jme)
551 real, intent(out) :: g_w_save(ims:ime,kms:kme,jms:jme)
552 real, intent(in) :: g_ww(ims:ime,kms:kme,jms:jme)
553 real, intent(in) :: g_xkmhd(ims:ime,kms:kme,jms:jme)
554 integer, intent(in) :: ide
555 integer, intent(in) :: ids
556 integer, intent(in) :: ite
557 integer, intent(in) :: its
558 integer, intent(in) :: jde
559 integer, intent(in) :: jds
560 integer, intent(in) :: jte
561 integer, intent(in) :: jts
562 integer, intent(in) :: kde
563 integer, intent(in) :: kte
564 integer, intent(in) :: kts
565 real, intent(in) :: kvdif
566 real, intent(in) :: msft(ims:ime,jms:jme)
567 real, intent(in) :: msfu(ims:ime,jms:jme)
568 real, intent(in) :: msfv(ims:ime,jms:jme)
569 real, intent(in) :: mu(ims:ime,jms:jme)
570 real, intent(out) :: mu_tend(ims:ime,jms:jme)
571 real, intent(in) :: mub(ims:ime,jms:jme)
572 real, intent(in) :: mut(ims:ime,jms:jme)
573 real, intent(in) :: muu(ims:ime,jms:jme)
574 real, intent(in) :: muv(ims:ime,jms:jme)
575 logical, intent(in) :: non_hydrostatic
576 real, intent(in) :: p(ims:ime,kms:kme,jms:jme)
577 real, intent(in) :: pb(ims:ime,kms:kme,jms:jme)
578 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
579 real, intent(in) :: ph_old(ims:ime,kms:kme,jms:jme)
580 real, intent(out) :: ph_save(ims:ime,kms:kme,jms:jme)
581 real, intent(out) :: ph_tend(ims:ime,kms:kme,jms:jme)
582 real, intent(in) :: phb(ims:ime,kms:kme,jms:jme)
583 real, intent(in) :: php(ims:ime,kms:kme,jms:jme)
584 real, intent(in) :: rdn(kms:kme)
585 real, intent(in) :: rdnw(kms:kme)
586 real, intent(in) :: rdx
587 real, intent(in) :: rdy
588 integer, intent(in) :: rk_step
589 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
590 real, intent(out) :: ru_tend(ims:ime,kms:kme,jms:jme)
591 real, intent(inout) :: ru_tendf(ims:ime,kms:kme,jms:jme)
592 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
593 real, intent(out) :: rv_tend(ims:ime,kms:kme,jms:jme)
594 real, intent(inout) :: rv_tendf(ims:ime,kms:kme,jms:jme)
595 real, intent(in) :: rw(ims:ime,kms:kme,jms:jme)
596 real, intent(out) :: rw_tend(ims:ime,kms:kme,jms:jme)
597 real, intent(inout) :: rw_tendf(ims:ime,kms:kme,jms:jme)
598 real, intent(in) :: sina(ims:ime,jms:jme)
599 real, intent(in) :: t(ims:ime,kms:kme,jms:jme)
600 real, intent(in) :: t_init(ims:ime,kms:kme,jms:jme)
601 real, intent(in) :: t_old(ims:ime,kms:kme,jms:jme)
602 real, intent(out) :: t_save(ims:ime,kms:kme,jms:jme)
603 real, intent(out) :: t_tend(ims:ime,kms:kme,jms:jme)
604 real, intent(inout) :: t_tendf(ims:ime,kms:kme,jms:jme)
605 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
606 real, intent(in) :: u_base(kms:kme)
607 real, intent(in) :: u_old(ims:ime,kms:kme,jms:jme)
608 real, intent(out) :: u_save(ims:ime,kms:kme,jms:jme)
609 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
610 real, intent(in) :: v_base(kms:kme)
611 real, intent(in) :: v_old(ims:ime,kms:kme,jms:jme)
612 real, intent(out) :: v_save(ims:ime,kms:kme,jms:jme)
613 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
614 real, intent(in) :: w_old(ims:ime,kms:kme,jms:jme)
615 real, intent(out) :: w_save(ims:ime,kms:kme,jms:jme)
616 real, intent(in) :: ww(ims:ime,kms:kme,jms:jme)
617 real, intent(in) :: xkmhd(ims:ime,kms:kme,jms:jme)
618 real, intent(in) :: z_base(kms:kme)
619
620 !==============================================
621 ! declare local variables
622 !==============================================
623 real kvdq
624
625 !----------------------------------------------
626 ! TANGENT LINEAR AND FUNCTION STATEMENTS
627 !----------------------------------------------
628 call g_zero_tend( ru_tend,g_ru_tend,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
629 call g_zero_tend( rv_tend,g_rv_tend,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
630 call g_zero_tend( rw_tend,g_rw_tend,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
631 call g_zero_tend( t_tend,g_t_tend,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
632 call g_zero_tend( ph_tend,g_ph_tend,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
633 call g_zero_tend( u_save,g_u_save,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
634 call g_zero_tend( v_save,g_v_save,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
635 call g_zero_tend( w_save,g_w_save,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
636 call g_zero_tend( ph_save,g_ph_save,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
637 call g_zero_tend( t_save,g_t_save,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
638 call g_zero_tend( mu_tend,g_mu_tend,ims,ime,jms,jme,1,1,its,ite,jts,jte,1,1 )
639 call g_advect_u( u,g_u,u,g_u,ru_tend,g_ru_tend,ru,g_ru,rv,g_rv,ww,g_ww,mut,g_mut,config_flags,msfu,fnm,fnp,rdx,rdy,rdnw,ids,ide,&
640 &jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
641 call g_advect_v( v,g_v,v,g_v,rv_tend,g_rv_tend,ru,g_ru,rv,g_rv,ww,g_ww,mut,g_mut,config_flags,msfv,fnm,fnp,rdx,rdy,rdnw,ids,ide,&
642 &jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
643 if (non_hydrostatic) then
644 call g_advect_w( w,g_w,w,g_w,rw_tend,g_rw_tend,ru,g_ru,rv,g_rv,ww,g_ww,config_flags,msft,fnm,fnp,rdx,rdy,rdn,ids,ide,jds,jde,&
645 &kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
646 endif
647 call g_advect_scalar( t,g_t,t,g_t,t_tend,g_t_tend,ru,g_ru,rv,g_rv,ww,g_ww,config_flags,msft,fnm,fnp,rdx,rdy,rdnw,ids,ide,jds,jde,&
648 &kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
649 call g_rhs_ph( ph_tend,g_ph_tend,u,g_u,v,g_v,ww,g_ww,ph,g_ph,ph,g_ph,phb,w,g_w,mut,g_mut,muu,g_muu,muv,g_muv,fnm,fnp,rdnw,cfn,&
650 &cfn1,rdx,rdy,msft,non_hydrostatic,config_flags,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
651 call g_horizontal_pressure_gradient( ru_tend,g_ru_tend,rv_tend,g_rv_tend,ph,g_ph,alt,g_alt,p,g_p,pb,al,g_al,php,g_php,cqu,g_cqu,&
652 &cqv,g_cqv,muu,g_muu,muv,g_muv,mu,g_mu,fnm,fnp,rdnw,cf1,cf2,cf3,rdx,rdy,config_flags,non_hydrostatic,ids,ide,jds,jde,kde,ims,ime,&
653 &jms,jme,kms,kme,its,ite,jts,jte,kte )
654 if (non_hydrostatic) then
655 call g_pg_buoy_w( rw_tend,g_rw_tend,p,g_p,cqw,g_cqw,mu,g_mu,mub,rdnw,rdn,g,msft,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,&
656 &jte )
657 endif
658 if (config_flags%w_damping .eq. 1) then
659 call g_w_damp( rw_tend,g_rw_tend,ww,g_ww,w,g_w,mut,g_mut,rdnw,dt,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte )
660 endif
661 if (config_flags%pert_coriolis) then
662 call g_perturbation_coriolis( ru,g_ru,rv,g_rv,rw,g_rw,ru_tend,g_ru_tend,rv_tend,g_rv_tend,rw_tend,g_rw_tend,config_flags,u_base,&
663 &v_base,z_base,muu,g_muu,muv,g_muv,phb,ph,g_ph,f,e,sina,cosa,fnm,fnp,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,&
664 &kts,kte )
665 else
666 call g_coriolis( ru,g_ru,rv,g_rv,rw,g_rw,ru_tend,g_ru_tend,rv_tend,g_rv_tend,rw_tend,g_rw_tend,config_flags,f,e,sina,cosa,fnm,&
667 &fnp,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
668 endif
669 call g_curvature( ru,g_ru,rv,g_rv,rw,g_rw,u,g_u,v,g_v,ru_tend,g_ru_tend,rv_tend,g_rv_tend,rw_tend,g_rw_tend,config_flags,msfu,msfv,&
670 &fnm,fnp,rdx,rdy,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
671 forward_steq: if (rk_step .eq. 1) then
672 diff_opt2: if (config_flags%diff_opt .eq. 1) then
673 call g_horizontal_diffusion( 'u',u,g_u,ru_tendf,g_ru_tendf,mut,g_mut,config_flags,msfu,msfv,msft,xkmhd,g_xkmhd,rdx,rdy,ids,&
674 &ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
675 call g_horizontal_diffusion( 'v',v,g_v,rv_tendf,g_rv_tendf,mut,g_mut,config_flags,msfu,msfv,msft,xkmhd,g_xkmhd,rdx,rdy,ids,&
676 &ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
677 call g_horizontal_diffusion( 'w',w,g_w,rw_tendf,g_rw_tendf,mut,g_mut,config_flags,msfu,msfv,msft,xkmhd,g_xkmhd,rdx,rdy,ids,&
678 &ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
679 call g_horizontal_diffusion_3dmp( t,g_t,t_tendf,g_t_tendf,mut,g_mut,config_flags,t_init,msfu,msfv,msft,xkmhd,g_xkmhd,rdx,rdy,&
680 &ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
681 pbl_tesu: if (config_flags%bl_pbl_physics .eq. 0) then
682 call g_vertical_diffusion_u( u,g_u,ru_tendf,g_ru_tendf,config_flags,u_base,alt,g_alt,muu,g_muu,rdn,rdnw,kvdif,ids,ide,jde,&
683 &kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
684 call g_vertical_diffusion_v( v,g_v,rv_tendf,g_rv_tendf,config_flags,v_base,alt,g_alt,muv,g_muv,rdn,rdnw,kvdif,ide,jds,jde,&
685 &kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
686 if (non_hydrostatic) then
687 call g_vertical_diffusion( 'w',w,g_w,rw_tendf,g_rw_tendf,alt,g_alt,mut,g_mut,rdn,rdnw,kvdif,ide,jde,kde,ims,ime,jms,jme,&
688 &kms,kme,its,ite,jts,jte,kts,kte )
689 endif
690 kvdq = 3.*kvdif
691 call g_vertical_diffusion_3dmp( t,g_t,t_tendf,g_t_tendf,t_init,alt,g_alt,mut,g_mut,rdn,rdnw,kvdq,ide,jde,kde,ims,ime,jms,&
692 &jme,kms,kme,its,ite,jts,jte,kts,kte )
693 endif pbl_tesu
694
695 endif diff_opt2
696 endif forward_steq
697
698 end subroutine g_rk_tendency
699
700
701 subroutine g_rk_update_scalar( scs, sce, scalar_1, g_scalar_1, scalar_2, g_scalar_2, sc_tend, g_sc_tend, advect_tend, &
702 &g_advect_tend, msft, mu_old, g_mu_old, mu_new, g_mu_new, mu_base, rk_step, dt, spec_zone, config_flags, ids, ide,&
703 & jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
704 !******************************************************************
705 !******************************************************************
706 !** This routine was generated by Automatic differentiation. **
707 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
708 !******************************************************************
709 !******************************************************************
710 !==============================================
711 ! all entries are defined explicitly
712 !==============================================
713 implicit none
714
715 !==============================================
716 ! declare arguments
717 !==============================================
718 integer, intent(in) :: ime
719 integer, intent(in) :: ims
720 integer, intent(in) :: jme
721 integer, intent(in) :: jms
722 integer, intent(in) :: kme
723 integer, intent(in) :: kms
724 real, intent(in) :: advect_tend(ims:ime,kms:kme,jms:jme)
725 type (grid_config_rec_type), intent(in) :: config_flags
726 real, intent(in) :: dt
727 real, intent(in) :: g_advect_tend(ims:ime,kms:kme,jms:jme)
728 real, intent(in) :: g_mu_new(ims:ime,jms:jme)
729 real, intent(in) :: g_mu_old(ims:ime,jms:jme)
730 integer, intent(in) :: sce
731 integer, intent(in) :: scs
732 real, intent(inout) :: g_sc_tend(ims:ime,kms:kme,jms:jme,scs:sce)
733 real, intent(inout) :: g_scalar_1(ims:ime,kms:kme,jms:jme,scs:sce)
734 real, intent(inout) :: g_scalar_2(ims:ime,kms:kme,jms:jme,scs:sce)
735 integer, intent(in) :: ide
736 integer, intent(in) :: ids
737 integer, intent(in) :: ite
738 integer, intent(in) :: its
739 integer, intent(in) :: jde
740 integer, intent(in) :: jds
741 integer, intent(in) :: jte
742 integer, intent(in) :: jts
743 integer, intent(in) :: kde
744 integer, intent(in) :: kte
745 integer, intent(in) :: kts
746 real, intent(in) :: msft(ims:ime,jms:jme)
747 real, intent(in) :: mu_base(ims:ime,jms:jme)
748 real, intent(in) :: mu_new(ims:ime,jms:jme)
749 real, intent(in) :: mu_old(ims:ime,jms:jme)
750 integer, intent(in) :: rk_step
751 real, intent(inout) :: sc_tend(ims:ime,kms:kme,jms:jme,scs:sce)
752 real, intent(inout) :: scalar_1(ims:ime,kms:kme,jms:jme,scs:sce)
753 real, intent(inout) :: scalar_2(ims:ime,kms:kme,jms:jme,scs:sce)
754 integer, intent(in) :: spec_zone
755
756 !==============================================
757 ! declare local variables
758 !==============================================
759 real g_muold(its:ite)
760 real g_r_munew(its:ite)
761 real g_sc_middle
762 real g_tendency(its:ite,kts:kte,jts:jte)
763 integer i
764 integer i_end
765 integer i_end_spc
766 integer i_start
767 integer i_start_spc
768 integer im
769 integer j
770 integer j_end
771 integer j_end_spc
772 integer j_start
773 integer j_start_spc
774 integer k
775 integer k_end
776 integer k_end_spc
777 integer k_start
778 integer k_start_spc
779 real muold(its:ite)
780 real r_munew(its:ite)
781 real sc_middle
782 real tendency(its:ite,kts:kte,jts:jte)
783
784 !----------------------------------------------
785 ! TANGENT LINEAR AND FUNCTION STATEMENTS
786 !----------------------------------------------
787 i_start = its
788 i_end = ite
789 j_start = jts
790 j_end = jte
791 k_start = kts
792 k_end = kte-1
793 if (j_end .eq. jde) then
794 j_end = j_end-1
795 endif
796 if (i_end .eq. ide) then
797 i_end = i_end-1
798 endif
799 i_start_spc = i_start
800 i_end_spc = i_end
801 j_start_spc = j_start
802 j_end_spc = j_end
803 k_start_spc = k_start
804 k_end_spc = k_end
805 if (config_flags%nested .or. config_flags%specified) then
806 i_start = max(its,ids+spec_zone)
807 i_end = min(ite,ide-spec_zone-1)
808 j_start = max(jts,jds+spec_zone)
809 j_end = min(jte,jde-spec_zone-1)
810 k_start = kts
811 k_end = min(kte,kde-1)
812 endif
813 if (rk_step .eq. 1) then
814 do im = scs, sce
815 do j = jts, min(jte,jde-1)
816 do k = kts, min(kte,kde-1)
817 do i = its, min(ite,ide-1)
818 g_tendency(i,k,j) = 0.
819 tendency(i,k,j) = 0.
820 end do
821 end do
822 end do
823 do j = j_start, j_end
824 do k = k_start, k_end
825 do i = i_start, i_end
826 g_tendency(i,k,j) = g_advect_tend(i,k,j)*msft(i,j)
827 tendency(i,k,j) = advect_tend(i,k,j)*msft(i,j)
828 end do
829 end do
830 end do
831 do j = j_start_spc, j_end_spc
832 do k = k_start_spc, k_end_spc
833 do i = i_start_spc, i_end_spc
834 g_tendency(i,k,j) = g_sc_tend(i,k,j,im)+g_tendency(i,k,j)
835 tendency(i,k,j) = tendency(i,k,j)+sc_tend(i,k,j,im)
836 end do
837 end do
838 end do
839 do j = jts, min(jte,jde-1)
840 do i = its, min(ite,ide-1)
841 g_muold(i) = g_mu_old(i,j)
842 muold(i) = mu_old(i,j)+mu_base(i,j)
843 g_r_munew(i) = -(g_mu_new(i,j)/((mu_new(i,j)+mu_base(i,j))*(mu_new(i,j)+mu_base(i,j))))
844 r_munew(i) = 1./(mu_new(i,j)+mu_base(i,j))
845 end do
846 do k = kts, min(kte,kde-1)
847 do i = its, min(ite,ide-1)
848 g_scalar_1(i,k,j,im) = g_scalar_2(i,k,j,im)
849 scalar_1(i,k,j,im) = scalar_2(i,k,j,im)
850 g_scalar_2(i,k,j,im) = g_muold(i)*scalar_1(i,k,j,im)*r_munew(i)+g_r_munew(i)*(muold(i)*scalar_1(i,k,j,im)+dt*&
851 &tendency(i,k,j))+g_scalar_1(i,k,j,im)*muold(i)*r_munew(i)+g_tendency(i,k,j)*dt*r_munew(i)
852 scalar_2(i,k,j,im) = (muold(i)*scalar_1(i,k,j,im)+dt*tendency(i,k,j))*r_munew(i)
853 end do
854 end do
855 end do
856 end do
857 else
858 do im = scs, sce
859 do j = jts, min(jte,jde-1)
860 do k = kts, min(kte,kde-1)
861 do i = its, min(ite,ide-1)
862 g_tendency(i,k,j) = 0.
863 tendency(i,k,j) = 0.
864 end do
865 end do
866 end do
867 do j = j_start, j_end
868 do k = k_start, k_end
869 do i = i_start, i_end
870 g_tendency(i,k,j) = g_advect_tend(i,k,j)*msft(i,j)
871 tendency(i,k,j) = advect_tend(i,k,j)*msft(i,j)
872 end do
873 end do
874 end do
875 do j = j_start_spc, j_end_spc
876 do k = k_start_spc, k_end_spc
877 do i = i_start_spc, i_end_spc
878 g_tendency(i,k,j) = g_sc_tend(i,k,j,im)+g_tendency(i,k,j)
879 tendency(i,k,j) = tendency(i,k,j)+sc_tend(i,k,j,im)
880 end do
881 end do
882 end do
883 do j = jts, min(jte,jde-1)
884 do i = its, min(ite,ide-1)
885 g_muold(i) = g_mu_old(i,j)
886 muold(i) = mu_old(i,j)+mu_base(i,j)
887 g_r_munew(i) = -(g_mu_new(i,j)/((mu_new(i,j)+mu_base(i,j))*(mu_new(i,j)+mu_base(i,j))))
888 r_munew(i) = 1./(mu_new(i,j)+mu_base(i,j))
889 end do
890 do k = kts, min(kte,kde-1)
891 do i = its, min(ite,ide-1)
892 g_scalar_2(i,k,j,im) = g_muold(i)*scalar_1(i,k,j,im)*r_munew(i)+g_r_munew(i)*(muold(i)*scalar_1(i,k,j,im)+dt*&
893 &tendency(i,k,j))+g_scalar_1(i,k,j,im)*muold(i)*r_munew(i)+g_tendency(i,k,j)*dt*r_munew(i)
894 scalar_2(i,k,j,im) = (muold(i)*scalar_1(i,k,j,im)+dt*tendency(i,k,j))*r_munew(i)
895 end do
896 end do
897 end do
898 end do
899 endif
900
901
902 end subroutine g_rk_update_scalar
903
904 end module g_module_em
905