module_small_step_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_small_step_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_configure
34 use module_model_constants
35 use module_small_step_em
36
37 !==============================================
38 ! all entries are defined explicitly
39 !==============================================
40 implicit none
41
42 contains
43 subroutine g_advance_mu_t( ww, g_ww, ww_1, g_ww_1, u, g_u, u_1, g_u_1, v, g_v, v_1, g_v_1, mu, g_mu, mut, g_mut, muave, g_muave, &
44 &muts, g_muts, muu, g_muu, muv, g_muv, mudf, g_mudf, t, g_t, t_1, g_t_1, t_ave, g_t_ave, ft, g_ft, mu_tend, g_mu_tend, rdx, rdy, &
45 &dts, epssm, dnw, fnm, fnp, rdnw, msfu, msfv, msft, config_flags, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, &
46 &jts, jte, kts, kte )
47 !******************************************************************
48 !******************************************************************
49 !** This routine was generated by Automatic differentiation. **
50 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
51 !******************************************************************
52 !******************************************************************
53 !==============================================
54 ! all entries are defined explicitly
55 !==============================================
56 implicit none
57
58 !==============================================
59 ! declare arguments
60 !==============================================
61 type (grid_config_rec_type), intent(in) :: config_flags
62 integer, intent(in) :: kme
63 integer, intent(in) :: kms
64 real, intent(in) :: dnw(kms:kme)
65 real, intent(in) :: dts
66 real, intent(in) :: epssm
67 real, intent(in) :: fnm(kms:kme)
68 real, intent(in) :: fnp(kms:kme)
69 integer, intent(in) :: ime
70 integer, intent(in) :: ims
71 integer, intent(in) :: jme
72 integer, intent(in) :: jms
73 real, intent(in) :: ft(ims:ime,kms:kme,jms:jme)
74 real, intent(in) :: g_ft(ims:ime,kms:kme,jms:jme)
75 real, intent(inout) :: g_mu(ims:ime,jms:jme)
76 real, intent(in) :: g_mu_tend(ims:ime,jms:jme)
77 real, intent(out) :: g_muave(ims:ime,jms:jme)
78 real, intent(out) :: g_mudf(ims:ime,jms:jme)
79 real, intent(in) :: g_mut(ims:ime,jms:jme)
80 real, intent(out) :: g_muts(ims:ime,jms:jme)
81 real, intent(in) :: g_muu(ims:ime,jms:jme)
82 real, intent(in) :: g_muv(ims:ime,jms:jme)
83 real, intent(inout) :: g_t(ims:ime,kms:kme,jms:jme)
84 real, intent(in) :: g_t_1(ims:ime,kms:kme,jms:jme)
85 real, intent(inout) :: g_t_ave(ims:ime,kms:kme,jms:jme)
86 real, intent(in) :: g_u(ims:ime,kms:kme,jms:jme)
87 real, intent(in) :: g_u_1(ims:ime,kms:kme,jms:jme)
88 real, intent(in) :: g_v(ims:ime,kms:kme,jms:jme)
89 real, intent(in) :: g_v_1(ims:ime,kms:kme,jms:jme)
90 real, intent(inout) :: g_ww(ims:ime,kms:kme,jms:jme)
91 real, intent(inout) :: g_ww_1(ims:ime,kms:kme,jms:jme)
92 integer, intent(in) :: ide
93 integer, intent(in) :: ids
94 integer, intent(in) :: ite
95 integer, intent(in) :: its
96 integer, intent(in) :: jde
97 integer, intent(in) :: jds
98 integer, intent(in) :: jte
99 integer, intent(in) :: jts
100 integer, intent(in) :: kde
101 integer, intent(in) :: kte
102 integer, intent(in) :: kts
103 real, intent(in) :: msft(ims:ime,jms:jme)
104 real, intent(in) :: msfu(ims:ime,jms:jme)
105 real, intent(in) :: msfv(ims:ime,jms:jme)
106 real, intent(inout) :: mu(ims:ime,jms:jme)
107 real, intent(in) :: mu_tend(ims:ime,jms:jme)
108 real, intent(out) :: muave(ims:ime,jms:jme)
109 real, intent(out) :: mudf(ims:ime,jms:jme)
110 real, intent(in) :: mut(ims:ime,jms:jme)
111 real, intent(out) :: muts(ims:ime,jms:jme)
112 real, intent(in) :: muu(ims:ime,jms:jme)
113 real, intent(in) :: muv(ims:ime,jms:jme)
114 real, intent(in) :: rdnw(kms:kme)
115 real, intent(in) :: rdx
116 real, intent(in) :: rdy
117 real, intent(inout) :: t(ims:ime,kms:kme,jms:jme)
118 real, intent(in) :: t_1(ims:ime,kms:kme,jms:jme)
119 real, intent(inout) :: t_ave(ims:ime,kms:kme,jms:jme)
120 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
121 real, intent(in) :: u_1(ims:ime,kms:kme,jms:jme)
122 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
123 real, intent(in) :: v_1(ims:ime,kms:kme,jms:jme)
124 real, intent(inout) :: ww(ims:ime,kms:kme,jms:jme)
125 real, intent(inout) :: ww_1(ims:ime,kms:kme,jms:jme)
126
127 !==============================================
128 ! declare local variables
129 !==============================================
130 real dmdt(its:ite)
131 real dvdxi(its:ite,kts:kte)
132 real g_dmdt(its:ite)
133 real g_dvdxi(its:ite,kts:kte)
134 real g_wdtn(its:ite,kts:kte)
135 integer i
136 integer i_end
137 integer i_start
138 integer j
139 integer j_end
140 integer j_start
141 integer k
142 integer k_end
143 integer k_start
144 real wdtn(its:ite,kts:kte)
145
146 !----------------------------------------------
147 ! TANGENT LINEAR AND FUNCTION STATEMENTS
148 !----------------------------------------------
149 i_start = its
150 i_end = ite
151 j_start = jts
152 j_end = jte
153 k_start = kts
154 k_end = kte-1
155 if (j_end .eq. jde) then
156 j_end = j_end-1
157 endif
158 if (i_end .eq. ide) then
159 i_end = i_end-1
160 endif
161 if ((config_flags%specified .or. config_flags%nested) .and. its .eq. ids) then
162 i_start = i_start+1
163 endif
164 if ((config_flags%specified .or. config_flags%nested) .and. ite .eq. ide) then
165 i_end = i_end-1
166 endif
167 if ((config_flags%specified .or. config_flags%nested) .and. jts .eq. jds) then
168 j_start = j_start+1
169 endif
170 if ((config_flags%specified .or. config_flags%nested) .and. jte .eq. jde) then
171 j_end = j_end-1
172 endif
173 do j = j_start, j_end
174 do i = i_start, i_end
175 g_dmdt(i) = 0.
176 dmdt(i) = 0.
177 end do
178 do k = k_start, k_end
179 do i = i_start, i_end
180 g_dvdxi(i,k) = g_muu(i+1,j)*msft(i,j)*msft(i,j)*rdx*(u_1(i+1,k,j)/msfu(i+1,j))-g_muu(i,j)*msft(i,j)*msft(i,j)*rdx*(u_1(i,k,j)&
181 &/msfu(i,j))+g_muv(i,j+1)*msft(i,j)*msft(i,j)*rdy*(v_1(i,k,j+1)/msfv(i,j+1))-g_muv(i,j)*msft(i,j)*msft(i,j)*rdy*(v_1(i,k,j)/&
182 &msfv(i,j))+g_u(i+1,k,j)*msft(i,j)*msft(i,j)*rdx-g_u(i,k,j)*msft(i,j)*msft(i,j)*rdx+g_u_1(i+1,k,j)*msft(i,j)*msft(i,j)*rdx*&
183 &(muu(i+1,j)/msfu(i+1,j))-g_u_1(i,k,j)*msft(i,j)*msft(i,j)*rdx*(muu(i,j)/msfu(i,j))+g_v(i,k,j+1)*msft(i,j)*msft(i,j)*rdy-&
184 &g_v(i,k,j)*msft(i,j)*msft(i,j)*rdy+g_v_1(i,k,j+1)*msft(i,j)*msft(i,j)*rdy*(muv(i,j+1)/msfv(i,j+1))-g_v_1(i,k,j)*msft(i,j)*&
185 &msft(i,j)*rdy*(muv(i,j)/msfv(i,j))
186 dvdxi(i,k) = msft(i,j)*msft(i,j)*(rdy*(v(i,k,j+1)+muv(i,j+1)*v_1(i,k,j+1)/msfv(i,j+1)-(v(i,k,j)+muv(i,j)*v_1(i,k,j)/msfv(i,j)&
187 &))+rdx*(u(i+1,k,j)+muu(i+1,j)*u_1(i+1,k,j)/msfu(i+1,j)-(u(i,k,j)+muu(i,j)*u_1(i,k,j)/msfu(i,j))))
188 g_dmdt(i) = g_dmdt(i)+g_dvdxi(i,k)*dnw(k)
189 dmdt(i) = dmdt(i)+dnw(k)*dvdxi(i,k)
190 end do
191 end do
192 do i = i_start, i_end
193 g_muave(i,j) = g_mu(i,j)
194 muave(i,j) = mu(i,j)
195 g_mu(i,j) = g_dmdt(i)*dts+g_mu(i,j)+g_mu_tend(i,j)*dts
196 mu(i,j) = mu(i,j)+dts*(dmdt(i)+mu_tend(i,j))
197 g_mudf(i,j) = g_dmdt(i)+g_mu_tend(i,j)
198 mudf(i,j) = dmdt(i)+mu_tend(i,j)
199 g_muts(i,j) = g_mu(i,j)+g_mut(i,j)
200 muts(i,j) = mut(i,j)+mu(i,j)
201 g_muave(i,j) = 0.5*g_mu(i,j)*(1+epssm)+0.5*g_muave(i,j)*(1.-epssm)
202 muave(i,j) = 0.5*((1.+epssm)*mu(i,j)+(1.-epssm)*muave(i,j))
203 end do
204 do k = 2, k_end
205 do i = i_start, i_end
206 g_ww(i,k,j) = (-(g_dmdt(i)*(dnw(k-1)/msft(i,j))))-g_dvdxi(i,k-1)*(dnw(k-1)/msft(i,j))-g_mu_tend(i,j)*(dnw(k-1)/msft(i,j))+&
207 &g_ww(i,k-1,j)
208 ww(i,k,j) = ww(i,k-1,j)-dnw(k-1)*(dmdt(i)+dvdxi(i,k-1)+mu_tend(i,j))/msft(i,j)
209 end do
210 end do
211 do k = 1, k_end
212 do i = i_start, i_end
213 g_ww(i,k,j) = g_ww(i,k,j)-g_ww_1(i,k,j)
214 ww(i,k,j) = ww(i,k,j)-ww_1(i,k,j)
215 end do
216 end do
217 end do
218 do j = j_start, j_end
219 do k = 1, k_end
220 do i = i_start, i_end
221 g_t_ave(i,k,j) = g_t(i,k,j)
222 t_ave(i,k,j) = t(i,k,j)
223 g_t(i,k,j) = g_ft(i,k,j)*msft(i,j)*dts+g_t(i,k,j)
224 t(i,k,j) = t(i,k,j)+msft(i,j)*dts*ft(i,k,j)
225 end do
226 end do
227 end do
228 do j = j_start, j_end
229 do i = i_start, i_end
230 g_wdtn(i,1) = 0.
231 wdtn(i,1) = 0.
232 g_wdtn(i,kde) = 0.
233 wdtn(i,kde) = 0.
234 end do
235 do k = 2, k_end
236 do i = i_start, i_end
237 g_wdtn(i,k) = g_t_1(i,k-1,j)*ww(i,k,j)*fnp(k)+g_t_1(i,k,j)*ww(i,k,j)*fnm(k)+g_ww(i,k,j)*(fnm(k)*t_1(i,k,j)+fnp(k)*t_1(i,k-1,&
238 &j))
239 wdtn(i,k) = ww(i,k,j)*(fnm(k)*t_1(i,k,j)+fnp(k)*t_1(i,k-1,j))
240 end do
241 end do
242 do k = 1, k_end
243 do i = i_start, i_end
244 g_t(i,k,j) = g_t(i,k,j)+0.5*g_t_1(i,k,j-1)*dts*msft(i,j)*msft(i,j)*rdy*v(i,k,j)-0.5*g_t_1(i,k,j+1)*dts*msft(i,j)*msft(i,j)*&
245 &rdy*v(i,k,j+1)+0.5*g_t_1(i-1,k,j)*dts*msft(i,j)*msft(i,j)*rdx*u(i,k,j)-0.5*g_t_1(i+1,k,j)*dts*msft(i,j)*msft(i,j)*rdx*u(i+1,&
246 &k,j)-g_t_1(i,k,j)*dts*msft(i,j)*msft(i,j)*(0.5*rdy*(v(i,k,j+1)-v(i,k,j))+0.5*rdx*(u(i+1,k,j)-u(i,k,j)))-0.5*g_u(i+1,k,j)*&
247 &dts*msft(i,j)*msft(i,j)*rdx*(t_1(i+1,k,j)+t_1(i,k,j))+0.5*g_u(i,k,j)*dts*msft(i,j)*msft(i,j)*rdx*(t_1(i,k,j)+t_1(i-1,k,j))-&
248 &0.5*g_v(i,k,j+1)*dts*msft(i,j)*msft(i,j)*rdy*(t_1(i,k,j+1)+t_1(i,k,j))+0.5*g_v(i,k,j)*dts*msft(i,j)*msft(i,j)*rdy*(t_1(i,k,&
249 &j)+t_1(i,k,j-1))-g_wdtn(i,k+1)*dts*msft(i,j)*rdnw(k)+g_wdtn(i,k)*dts*msft(i,j)*rdnw(k)
250 t(i,k,j) = t(i,k,j)-dts*msft(i,j)*(msft(i,j)*(0.5*rdy*(v(i,k,j+1)*(t_1(i,k,j+1)+t_1(i,k,j))-v(i,k,j)*(t_1(i,k,j)+t_1(i,k,j-1)&
251 &))+0.5*rdx*(u(i+1,k,j)*(t_1(i+1,k,j)+t_1(i,k,j))-u(i,k,j)*(t_1(i,k,j)+t_1(i-1,k,j))))+rdnw(k)*(wdtn(i,k+1)-wdtn(i,k)))
252 end do
253 end do
254 end do
255
256 end subroutine g_advance_mu_t
257
258
259 subroutine g_advance_uv( u, g_u, ru_tend, g_ru_tend, v, g_v, rv_tend, g_rv_tend, p, g_p, pb, ph, g_ph, php, g_php, alt, g_alt, al, &
260 &g_al, mu, g_mu, muu, g_muu, cqu, g_cqu, muv, g_muv, cqv, g_cqv, mudf, g_mudf, rdx, rdy, dts, cf1, cf2, cf3, fnm, fnp, emdiv, rdnw,&
261 & config_flags, spec_zone, non_hydrostatic, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
262 !******************************************************************
263 !******************************************************************
264 !** This routine was generated by Automatic differentiation. **
265 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
266 !******************************************************************
267 !******************************************************************
268 !==============================================
269 ! all entries are defined explicitly
270 !==============================================
271 implicit none
272
273 !==============================================
274 ! declare arguments
275 !==============================================
276 integer, intent(in) :: ime
277 integer, intent(in) :: ims
278 integer, intent(in) :: jme
279 integer, intent(in) :: jms
280 integer, intent(in) :: kme
281 integer, intent(in) :: kms
282 real, intent(in) :: al(ims:ime,kms:kme,jms:jme)
283 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
284 real, intent(in) :: cf1
285 real, intent(in) :: cf2
286 real, intent(in) :: cf3
287 type (grid_config_rec_type), intent(in) :: config_flags
288 real, intent(in) :: cqu(ims:ime,kms:kme,jms:jme)
289 real, intent(in) :: cqv(ims:ime,kms:kme,jms:jme)
290 real, intent(in) :: dts
291 real, intent(in) :: emdiv
292 real, intent(in) :: fnm(kms:kme)
293 real, intent(in) :: fnp(kms:kme)
294 real, intent(in) :: g_al(ims:ime,kms:kme,jms:jme)
295 real, intent(in) :: g_alt(ims:ime,kms:kme,jms:jme)
296 real, intent(in) :: g_cqu(ims:ime,kms:kme,jms:jme)
297 real, intent(in) :: g_cqv(ims:ime,kms:kme,jms:jme)
298 real, intent(in) :: g_mu(ims:ime,jms:jme)
299 real, intent(in) :: g_mudf(ims:ime,jms:jme)
300 real, intent(in) :: g_muu(ims:ime,jms:jme)
301 real, intent(in) :: g_muv(ims:ime,jms:jme)
302 real, intent(in) :: g_p(ims:ime,kms:kme,jms:jme)
303 real, intent(in) :: g_ph(ims:ime,kms:kme,jms:jme)
304 real, intent(in) :: g_php(ims:ime,kms:kme,jms:jme)
305 real, intent(in) :: g_ru_tend(ims:ime,kms:kme,jms:jme)
306 real, intent(in) :: g_rv_tend(ims:ime,kms:kme,jms:jme)
307 real, intent(inout) :: g_u(ims:ime,kms:kme,jms:jme)
308 real, intent(inout) :: g_v(ims:ime,kms:kme,jms:jme)
309 integer, intent(in) :: ide
310 integer, intent(in) :: ids
311 integer, intent(in) :: ite
312 integer, intent(in) :: its
313 integer, intent(in) :: jde
314 integer, intent(in) :: jds
315 integer, intent(in) :: jte
316 integer, intent(in) :: jts
317 integer, intent(in) :: kde
318 integer, intent(in) :: kte
319 integer, intent(in) :: kts
320 real, intent(in) :: mu(ims:ime,jms:jme)
321 real, intent(in) :: mudf(ims:ime,jms:jme)
322 real, intent(in) :: muu(ims:ime,jms:jme)
323 real, intent(in) :: muv(ims:ime,jms:jme)
324 logical, intent(in) :: non_hydrostatic
325 real, intent(in) :: p(ims:ime,kms:kme,jms:jme)
326 real, intent(in) :: pb(ims:ime,kms:kme,jms:jme)
327 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
328 real, intent(in) :: php(ims:ime,kms:kme,jms:jme)
329 real, intent(in) :: rdnw(kms:kme)
330 real, intent(in) :: rdx
331 real, intent(in) :: rdy
332 real, intent(in) :: ru_tend(ims:ime,kms:kme,jms:jme)
333 real, intent(in) :: rv_tend(ims:ime,kms:kme,jms:jme)
334 integer, intent(in) :: spec_zone
335 real, intent(inout) :: u(ims:ime,kms:kme,jms:jme)
336 real, intent(inout) :: v(ims:ime,kms:kme,jms:jme)
337
338 !==============================================
339 ! declare local variables
340 !==============================================
341 real dpn(its:ite,kts:kte)
342 real dpxy(its:ite,kts:kte)
343 real dx
344 real dy
345 real g_dpn(its:ite,kts:kte)
346 real g_dpxy(its:ite,kts:kte)
347 real g_mudf_xy(its:ite)
348 integer i
349 integer i_end
350 integer i_end_up
351 integer i_endu
352 integer i_start
353 integer i_start_up
354 integer j
355 integer j_end
356 integer j_end_vp
357 integer j_endv
358 integer j_start
359 integer j_start_vp
360 integer k
361 integer k_end
362 integer k_start
363 real mudf_xy(its:ite)
364
365 !----------------------------------------------
366 ! TANGENT LINEAR AND FUNCTION STATEMENTS
367 !----------------------------------------------
368 if (config_flags%nested .or. config_flags%specified) then
369 i_start = max(its,ids+spec_zone)
370 i_end = min(ite,ide-spec_zone-1)
371 j_start = max(jts,jds+spec_zone)
372 j_end = min(jte,jde-spec_zone-1)
373 k_start = kts
374 k_end = min(kte,kde-1)
375 i_endu = min(ite,ide-spec_zone)
376 j_endv = min(jte,jde-spec_zone)
377 else
378 i_start = its
379 i_end = ite
380 j_start = jts
381 j_end = jte
382 k_start = kts
383 k_end = kte-1
384 i_endu = i_end
385 j_endv = j_end
386 if (j_end .eq. jde) then
387 j_end = j_end-1
388 endif
389 if (i_end .eq. ide) then
390 i_end = i_end-1
391 endif
392 endif
393 i_start_up = i_start
394 i_end_up = i_endu
395 j_start_vp = j_start
396 j_end_vp = j_endv
397 if ((config_flags%open_xs .or. config_flags%symmetric_xs) .and. its .eq. ids) then
398 i_start_up = i_start_up+1
399 endif
400 if ((config_flags%open_xe .or. config_flags%symmetric_xe) .and. ite .eq. ide) then
401 i_end_up = i_end_up-1
402 endif
403 if ((config_flags%open_ys .or. config_flags%symmetric_ys) .and. jts .eq. jds) then
404 j_start_vp = j_start_vp+1
405 endif
406 if ((config_flags%open_ye .or. config_flags%symmetric_ye) .and. jte .eq. jde) then
407 j_end_vp = j_end_vp-1
408 endif
409 dx = 1./rdx
410 dy = 1./rdy
411 u_outer_j_loop: do j = j_start, j_end
412 do k = k_start, k_end
413 do i = i_start, i_endu
414 g_u(i,k,j) = g_ru_tend(i,k,j)*dts+g_u(i,k,j)
415 u(i,k,j) = u(i,k,j)+dts*ru_tend(i,k,j)
416 end do
417 end do
418 do i = i_start_up, i_end_up
419 g_mudf_xy(i) = g_mudf(i-1,j)*emdiv*dx-g_mudf(i,j)*emdiv*dx
420 mudf_xy(i) = -(emdiv*dx*(mudf(i,j)-mudf(i-1,j)))
421 end do
422 do k = k_start, k_end
423 do i = i_start_up, i_end_up
424 g_dpxy(i,k) = 0.5*g_al(i-1,k,j)*rdx*muu(i,j)*(pb(i,k,j)-pb(i-1,k,j))+0.5*g_al(i,k,j)*rdx*muu(i,j)*(pb(i,k,j)-pb(i-1,k,j))+&
425 &0.5*g_alt(i-1,k,j)*rdx*muu(i,j)*(p(i,k,j)-p(i-1,k,j))+0.5*g_alt(i,k,j)*rdx*muu(i,j)*(p(i,k,j)-p(i-1,k,j))+0.5*g_muu(i,j)*&
426 &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)-p(i-1,k,j))+(al(i,k,j)+al(i-1,k,j))&
427 &*(pb(i,k,j)-pb(i-1,k,j)))-0.5*g_p(i-1,k,j)*rdx*muu(i,j)*(alt(i,k,j)+alt(i-1,k,j))+0.5*g_p(i,k,j)*rdx*muu(i,j)*(alt(i,k,j)+&
428 &alt(i-1,k,j))-0.5*g_ph(i-1,k+1,j)*rdx*muu(i,j)+0.5*g_ph(i,k+1,j)*rdx*muu(i,j)-0.5*g_ph(i-1,k,j)*rdx*muu(i,j)+0.5*g_ph(i,k,j)&
429 &*rdx*muu(i,j)
430 dpxy(i,k) = 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))&
431 &+(al(i,k,j)+al(i-1,k,j))*(pb(i,k,j)-pb(i-1,k,j)))
432 end do
433 end do
434 if (non_hydrostatic) then
435 do i = i_start_up, i_end_up
436 g_dpn(i,1) = 0.5*g_p(i-1,3,j)*cf3+0.5*g_p(i,3,j)*cf3+0.5*g_p(i-1,2,j)*cf2+0.5*g_p(i,2,j)*cf2+0.5*g_p(i-1,1,j)*cf1+0.5*g_p(i,&
437 &1,j)*cf1
438 dpn(i,1) = 0.5*(cf1*(p(i,1,j)+p(i-1,1,j))+cf2*(p(i,2,j)+p(i-1,2,j))+cf3*(p(i,3,j)+p(i-1,3,j)))
439 g_dpn(i,kde) = 0.
440 dpn(i,kde) = 0.
441 end do
442 do k = k_start+1, k_end
443 do i = i_start_up, i_end_up
444 g_dpn(i,k) = 0.5*g_p(i-1,k-1,j)*fnp(k)+0.5*g_p(i,k-1,j)*fnp(k)+0.5*g_p(i-1,k,j)*fnm(k)+0.5*g_p(i,k,j)*fnm(k)
445 dpn(i,k) = 0.5*(fnm(k)*(p(i,k,j)+p(i-1,k,j))+fnp(k)*(p(i,k-1,j)+p(i-1,k-1,j)))
446 end do
447 end do
448 do k = k_start, k_end
449 do i = i_start_up, i_end_up
450 g_dpxy(i,k) = g_dpn(i,k+1)*rdx*(php(i,k,j)-php(i-1,k,j))*rdnw(k)-g_dpn(i,k)*rdx*(php(i,k,j)-php(i-1,k,j))*rdnw(k)+g_dpxy(i,&
451 &k)-0.5*g_mu(i-1,j)*rdx*(php(i,k,j)-php(i-1,k,j))-0.5*g_mu(i,j)*rdx*(php(i,k,j)-php(i-1,k,j))-g_php(i-1,k,j)*rdx*(rdnw(k)*&
452 &(dpn(i,k+1)-dpn(i,k))-0.5*(mu(i-1,j)+mu(i,j)))+g_php(i,k,j)*rdx*(rdnw(k)*(dpn(i,k+1)-dpn(i,k))-0.5*(mu(i-1,j)+mu(i,j)))
453 dpxy(i,k) = dpxy(i,k)+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)))
454 end do
455 end do
456 endif
457 do k = k_start, k_end
458 do i = i_start_up, i_end_up
459 g_u(i,k,j) = (-(g_cqu(i,k,j)*dts*dpxy(i,k)))-g_dpxy(i,k)*dts*cqu(i,k,j)+g_mudf_xy(i)+g_u(i,k,j)
460 u(i,k,j) = u(i,k,j)-dts*cqu(i,k,j)*dpxy(i,k)+mudf_xy(i)
461 end do
462 end do
463 end do u_outer_j_loop
464 v_outer_j_loop: do j = j_start, j_endv
465 do k = k_start, k_end
466 do i = i_start, i_end
467 g_v(i,k,j) = g_rv_tend(i,k,j)*dts+g_v(i,k,j)
468 v(i,k,j) = v(i,k,j)+dts*rv_tend(i,k,j)
469 end do
470 end do
471 do i = i_start, i_end
472 g_mudf_xy(i) = g_mudf(i,j-1)*emdiv*dy-g_mudf(i,j)*emdiv*dy
473 mudf_xy(i) = -(emdiv*dy*(mudf(i,j)-mudf(i,j-1)))
474 end do
475 if (j .ge. j_start_vp .and. j .le. j_end_vp) then
476 do k = k_start, k_end
477 do i = i_start, i_end
478 g_dpxy(i,k) = 0.5*g_al(i,k,j-1)*rdy*muv(i,j)*(pb(i,k,j)-pb(i,k,j-1))+0.5*g_al(i,k,j)*rdy*muv(i,j)*(pb(i,k,j)-pb(i,k,j-1))+&
479 &0.5*g_alt(i,k,j-1)*rdy*muv(i,j)*(p(i,k,j)-p(i,k,j-1))+0.5*g_alt(i,k,j)*rdy*muv(i,j)*(p(i,k,j)-p(i,k,j-1))+0.5*g_muv(i,j)*&
480 &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)-p(i,k,j-1))+(al(i,k,j)+al(i,k,j-&
481 &1))*(pb(i,k,j)-pb(i,k,j-1)))-0.5*g_p(i,k,j-1)*rdy*muv(i,j)*(alt(i,k,j)+alt(i,k,j-1))+0.5*g_p(i,k,j)*rdy*muv(i,j)*(alt(i,k,&
482 &j)+alt(i,k,j-1))-0.5*g_ph(i,k+1,j-1)*rdy*muv(i,j)+0.5*g_ph(i,k+1,j)*rdy*muv(i,j)-0.5*g_ph(i,k,j-1)*rdy*muv(i,j)+0.5*&
483 &g_ph(i,k,j)*rdy*muv(i,j)
484 dpxy(i,k) = 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-&
485 &1))+(al(i,k,j)+al(i,k,j-1))*(pb(i,k,j)-pb(i,k,j-1)))
486 end do
487 end do
488 if (non_hydrostatic) then
489 do i = i_start, i_end
490 g_dpn(i,1) = 0.5*g_p(i,3,j-1)*cf3+0.5*g_p(i,3,j)*cf3+0.5*g_p(i,2,j-1)*cf2+0.5*g_p(i,2,j)*cf2+0.5*g_p(i,1,j-1)*cf1+0.5*&
491 &g_p(i,1,j)*cf1
492 dpn(i,1) = 0.5*(cf1*(p(i,1,j)+p(i,1,j-1))+cf2*(p(i,2,j)+p(i,2,j-1))+cf3*(p(i,3,j)+p(i,3,j-1)))
493 g_dpn(i,kde) = 0.
494 dpn(i,kde) = 0.
495 end do
496 do k = k_start+1, k_end
497 do i = i_start, i_end
498 g_dpn(i,k) = 0.5*g_p(i,k-1,j-1)*fnp(k)+0.5*g_p(i,k-1,j)*fnp(k)+0.5*g_p(i,k,j-1)*fnm(k)+0.5*g_p(i,k,j)*fnm(k)
499 dpn(i,k) = 0.5*(fnm(k)*(p(i,k,j)+p(i,k,j-1))+fnp(k)*(p(i,k-1,j)+p(i,k-1,j-1)))
500 end do
501 end do
502 do k = k_start, k_end
503 do i = i_start, i_end
504 g_dpxy(i,k) = g_dpn(i,k+1)*rdy*(php(i,k,j)-php(i,k,j-1))*rdnw(k)-g_dpn(i,k)*rdy*(php(i,k,j)-php(i,k,j-1))*rdnw(k)+&
505 &g_dpxy(i,k)-0.5*g_mu(i,j-1)*rdy*(php(i,k,j)-php(i,k,j-1))-0.5*g_mu(i,j)*rdy*(php(i,k,j)-php(i,k,j-1))-g_php(i,k,j-1)*&
506 &rdy*(rdnw(k)*(dpn(i,k+1)-dpn(i,k))-0.5*(mu(i,j-1)+mu(i,j)))+g_php(i,k,j)*rdy*(rdnw(k)*(dpn(i,k+1)-dpn(i,k))-0.5*(mu(i,j-&
507 &1)+mu(i,j)))
508 dpxy(i,k) = dpxy(i,k)+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)))
509 end do
510 end do
511 endif
512 do k = k_start, k_end
513 do i = i_start, i_end
514 g_v(i,k,j) = (-(g_cqv(i,k,j)*dts*dpxy(i,k)))-g_dpxy(i,k)*dts*cqv(i,k,j)+g_mudf_xy(i)+g_v(i,k,j)
515 v(i,k,j) = v(i,k,j)-dts*cqv(i,k,j)*dpxy(i,k)+mudf_xy(i)
516 end do
517 end do
518 endif
519 end do v_outer_j_loop
520
521 end subroutine g_advance_uv
522
523
524 subroutine g_advance_w( w, g_w, rw_tend, g_rw_tend, ww, g_ww, u, g_u, v, g_v, mu1, g_mu1, mut, g_mut, muave, g_muave, muts, g_muts,&
525 & t_2ave, g_t_2ave, t_2, g_t_2, t_1, g_t_1, ph, g_ph, ph_1, g_ph_1, phb, ph_tend, g_ph_tend, ht, c2a, g_c2a, cqw, g_cqw, alt, &
526 &g_alt, alb, a, g_a, alpha, g_alpha, gamma, g_gamma, rdx, rdy, dts, t0, epssm, fnm, fnp, rdnw, rdn, cf1, cf2, cf3, msft, &
527 &config_flags, ids, ide, jds, jde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
528 !******************************************************************
529 !******************************************************************
530 !** This routine was generated by Automatic differentiation. **
531 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
532 !******************************************************************
533 !******************************************************************
534 !==============================================
535 ! all entries are defined explicitly
536 !==============================================
537 implicit none
538
539 !==============================================
540 ! declare arguments
541 !==============================================
542 integer, intent(in) :: ime
543 integer, intent(in) :: ims
544 integer, intent(in) :: jme
545 integer, intent(in) :: jms
546 integer, intent(in) :: kme
547 integer, intent(in) :: kms
548 real, intent(in) :: a(ims:ime,kms:kme,jms:jme)
549 real, intent(in) :: alb(ims:ime,kms:kme,jms:jme)
550 real, intent(in) :: alpha(ims:ime,kms:kme,jms:jme)
551 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
552 real, intent(in) :: c2a(ims:ime,kms:kme,jms:jme)
553 real, intent(in) :: cf1
554 real, intent(in) :: cf2
555 real, intent(in) :: cf3
556 type (grid_config_rec_type), intent(in) :: config_flags
557 real, intent(in) :: cqw(ims:ime,kms:kme,jms:jme)
558 real, intent(in) :: dts
559 real, intent(in) :: epssm
560 real, intent(in) :: fnm(kms:kme)
561 real, intent(in) :: fnp(kms:kme)
562 real, intent(in) :: g_a(ims:ime,kms:kme,jms:jme)
563 real, intent(in) :: g_alpha(ims:ime,kms:kme,jms:jme)
564 real, intent(in) :: g_alt(ims:ime,kms:kme,jms:jme)
565 real, intent(in) :: g_c2a(ims:ime,kms:kme,jms:jme)
566 real, intent(in) :: g_cqw(ims:ime,kms:kme,jms:jme)
567 real, intent(in) :: g_gamma(ims:ime,kms:kme,jms:jme)
568 real, intent(in) :: g_mu1(ims:ime,jms:jme)
569 real, intent(in) :: g_muave(ims:ime,jms:jme)
570 real, intent(in) :: g_mut(ims:ime,jms:jme)
571 real, intent(in) :: g_muts(ims:ime,jms:jme)
572 real, intent(inout) :: g_ph(ims:ime,kms:kme,jms:jme)
573 real, intent(in) :: g_ph_1(ims:ime,kms:kme,jms:jme)
574 real, intent(in) :: g_ph_tend(ims:ime,kms:kme,jms:jme)
575 real, intent(in) :: g_rw_tend(ims:ime,kms:kme,jms:jme)
576 real, intent(in) :: g_t_1(ims:ime,kms:kme,jms:jme)
577 real, intent(in) :: g_t_2(ims:ime,kms:kme,jms:jme)
578 real, intent(inout) :: g_t_2ave(ims:ime,kms:kme,jms:jme)
579 real, intent(in) :: g_u(ims:ime,kms:kme,jms:jme)
580 real, intent(in) :: g_v(ims:ime,kms:kme,jms:jme)
581 real, intent(inout) :: g_w(ims:ime,kms:kme,jms:jme)
582 real, intent(in) :: g_ww(ims:ime,kms:kme,jms:jme)
583 real, intent(in) :: gamma(ims:ime,kms:kme,jms:jme)
584 real, intent(in) :: ht(ims:ime,jms:jme)
585 integer, intent(in) :: ide
586 integer, intent(in) :: ids
587 integer, intent(in) :: ite
588 integer, intent(in) :: its
589 integer, intent(in) :: jde
590 integer, intent(in) :: jds
591 integer, intent(in) :: jte
592 integer, intent(in) :: jts
593 integer, intent(in) :: kte
594 integer, intent(in) :: kts
595 real, intent(in) :: msft(ims:ime,jms:jme)
596 real, intent(in) :: mu1(ims:ime,jms:jme)
597 real, intent(in) :: muave(ims:ime,jms:jme)
598 real, intent(in) :: mut(ims:ime,jms:jme)
599 real, intent(in) :: muts(ims:ime,jms:jme)
600 real, intent(inout) :: ph(ims:ime,kms:kme,jms:jme)
601 real, intent(in) :: ph_1(ims:ime,kms:kme,jms:jme)
602 real, intent(in) :: ph_tend(ims:ime,kms:kme,jms:jme)
603 real, intent(in) :: phb(ims:ime,kms:kme,jms:jme)
604 real, intent(in) :: rdn(kms:kme)
605 real, intent(in) :: rdnw(kms:kme)
606 real, intent(in) :: rdx
607 real, intent(in) :: rdy
608 real, intent(in) :: rw_tend(ims:ime,kms:kme,jms:jme)
609 real, intent(in) :: t0
610 real, intent(in) :: t_1(ims:ime,kms:kme,jms:jme)
611 real, intent(in) :: t_2(ims:ime,kms:kme,jms:jme)
612 real, intent(inout) :: t_2ave(ims:ime,kms:kme,jms:jme)
613 real, intent(in) :: u(ims:ime,kms:kme,jms:jme)
614 real, intent(in) :: v(ims:ime,kms:kme,jms:jme)
615 real, intent(inout) :: w(ims:ime,kms:kme,jms:jme)
616 real, intent(in) :: ww(ims:ime,kms:kme,jms:jme)
617
618 !==============================================
619 ! declare local variables
620 !==============================================
621 real g_mut_inv(its:ite)
622 real g_rhs(its:ite,kts:kte)
623 real g_wdwn(its:ite,kts:kte)
624 integer i
625 integer i_end
626 integer i_start
627 integer j
628 integer j_end
629 integer j_start
630 integer k
631 integer k_end
632 real msft_inv(its:ite)
633 real mut_inv(its:ite)
634 real rhs(its:ite,kts:kte)
635 real wdwn(its:ite,kts:kte)
636
637 !----------------------------------------------
638 ! TANGENT LINEAR AND FUNCTION STATEMENTS
639 !----------------------------------------------
640 i_start = its
641 i_end = ite
642 j_start = jts
643 j_end = jte
644 k_end = kte-1
645 if (j_end .eq. jde) then
646 j_end = j_end-1
647 endif
648 if (i_end .eq. ide) then
649 i_end = i_end-1
650 endif
651 if ((config_flags%specified .or. config_flags%nested) .and. its .eq. ids) then
652 i_start = i_start+1
653 endif
654 if ((config_flags%specified .or. config_flags%nested) .and. ite .eq. ide) then
655 i_end = i_end-1
656 endif
657 if ((config_flags%specified .or. config_flags%nested) .and. jts .eq. jds) then
658 j_start = j_start+1
659 endif
660 if ((config_flags%specified .or. config_flags%nested) .and. jte .eq. jde) then
661 j_end = j_end-1
662 endif
663 do i = i_start, i_end
664 g_rhs(i,1) = 0.
665 rhs(i,1) = 0.
666 end do
667 j_loop_w: do j = j_start, j_end
668 do i = i_start, i_end
669 g_mut_inv(i) = -(g_mut(i,j)/(mut(i,j)*mut(i,j)))
670 mut_inv(i) = 1./mut(i,j)
671 msft_inv(i) = 1./msft(i,j)
672 end do
673 do k = 1, k_end
674 do i = i_start, i_end
675 g_t_2ave(i,k,j) = 0.5*g_t_2(i,k,j)*(1+epssm)+0.5*g_t_2ave(i,k,j)*(1.-epssm)
676 t_2ave(i,k,j) = 0.5*((1.+epssm)*t_2(i,k,j)+(1.-epssm)*t_2ave(i,k,j))
677 g_t_2ave(i,k,j) = (-(g_mu1(i,j)*(t_1(i,k,j)/(muts(i,j)*(t0+t_1(i,k,j))))))-g_muts(i,j)*((t_2ave(i,k,j)-mu1(i,j)*t_1(i,k,j))*&
678 &(t0+t_1(i,k,j))/(muts(i,j)*(t0+t_1(i,k,j))*muts(i,j)*(t0+t_1(i,k,j))))-g_t_1(i,k,j)*(mu1(i,j)/(muts(i,j)*(t0+t_1(i,k,j)))+&
679 &(t_2ave(i,k,j)-mu1(i,j)*t_1(i,k,j))*muts(i,j)/(muts(i,j)*(t0+t_1(i,k,j))*muts(i,j)*(t0+t_1(i,k,j))))+g_t_2ave(i,k,j)/&
680 &(muts(i,j)*(t0+t_1(i,k,j)))
681 t_2ave(i,k,j) = (t_2ave(i,k,j)-mu1(i,j)*t_1(i,k,j))/(muts(i,j)*(t0+t_1(i,k,j)))
682 end do
683 end do
684 do k = 2, k_end+1
685 do i = i_start, i_end
686 g_wdwn(i,k) = (-0.5)*g_ph_1(i,k-1,j)*(ww(i,k,j)+ww(i,k-1,j))*rdnw(k-1)+0.5*g_ph_1(i,k,j)*(ww(i,k,j)+ww(i,k-1,j))*rdnw(k-1)+&
687 &0.5*g_ww(i,k-1,j)*rdnw(k-1)*(ph_1(i,k,j)-ph_1(i,k-1,j)+phb(i,k,j)-phb(i,k-1,j))+0.5*g_ww(i,k,j)*rdnw(k-1)*(ph_1(i,k,j)-&
688 &ph_1(i,k-1,j)+phb(i,k,j)-phb(i,k-1,j))
689 wdwn(i,k) = 0.5*(ww(i,k,j)+ww(i,k-1,j))*rdnw(k-1)*(ph_1(i,k,j)-ph_1(i,k-1,j)+phb(i,k,j)-phb(i,k-1,j))
690 g_rhs(i,k) = g_ph_tend(i,k,j)*dts+0.5*g_w(i,k,j)*dts*g*(1.-epssm)
691 rhs(i,k) = dts*(ph_tend(i,k,j)+0.5*g*(1.-epssm)*w(i,k,j))
692 end do
693 end do
694 do k = 2, k_end
695 do i = i_start, i_end
696 g_rhs(i,k) = g_rhs(i,k)-g_wdwn(i,k+1)*dts*fnm(k)-g_wdwn(i,k)*dts*fnp(k)
697 rhs(i,k) = rhs(i,k)-dts*(fnm(k)*wdwn(i,k+1)+fnp(k)*wdwn(i,k))
698 end do
699 end do
700 do k = 2, k_end+1
701 do i = i_start, i_end
702 g_rhs(i,k) = g_mut_inv(i)*msft(i,j)*rhs(i,k)+g_ph(i,k,j)+g_rhs(i,k)*msft(i,j)*mut_inv(i)
703 rhs(i,k) = ph(i,k,j)+msft(i,j)*rhs(i,k)*mut_inv(i)
704 end do
705 end do
706 do i = i_start, i_end
707 g_w(i,1,j) = 0.5*g_u(i+1,3,j)*rdx*(ht(i+1,j)-ht(i,j))*cf3+0.5*g_u(i,3,j)*rdx*(ht(i,j)-ht(i-1,j))*cf3+0.5*g_u(i+1,2,j)*rdx*&
708 &(ht(i+1,j)-ht(i,j))*cf2+0.5*g_u(i,2,j)*rdx*(ht(i,j)-ht(i-1,j))*cf2+0.5*g_u(i+1,1,j)*rdx*(ht(i+1,j)-ht(i,j))*cf1+0.5*g_u(i,1,j)&
709 &*rdx*(ht(i,j)-ht(i-1,j))*cf1+0.5*g_v(i,3,j+1)*rdy*(ht(i,j+1)-ht(i,j))*cf3+0.5*g_v(i,3,j)*rdy*(ht(i,j)-ht(i,j-1))*cf3+0.5*&
710 &g_v(i,2,j+1)*rdy*(ht(i,j+1)-ht(i,j))*cf2+0.5*g_v(i,2,j)*rdy*(ht(i,j)-ht(i,j-1))*cf2+0.5*g_v(i,1,j+1)*rdy*(ht(i,j+1)-ht(i,j))*&
711 &cf1+0.5*g_v(i,1,j)*rdy*(ht(i,j)-ht(i,j-1))*cf1
712 w(i,1,j) = 0.5*rdy*((ht(i,j+1)-ht(i,j))*(cf1*v(i,1,j+1)+cf2*v(i,2,j+1)+cf3*v(i,3,j+1))+(ht(i,j)-ht(i,j-1))*(cf1*v(i,1,j)+cf2*&
713 &v(i,2,j)+cf3*v(i,3,j)))+0.5*rdx*((ht(i+1,j)-ht(i,j))*(cf1*u(i+1,1,j)+cf2*u(i+1,2,j)+cf3*u(i+1,3,j))+(ht(i,j)-ht(i-1,j))*(cf1*&
714 &u(i,1,j)+cf2*u(i,2,j)+cf3*u(i,3,j)))
715 end do
716 do k = 2, k_end
717 do i = i_start, i_end
718 g_w(i,k,j) = (-(g_alt(i,k-1,j)*dts*g*msft_inv(i)*rdn(k)*c2a(i,k-1,j)*t_2ave(i,k-1,j)))+g_alt(i,k,j)*dts*g*msft_inv(i)*rdn(k)*&
719 &c2a(i,k,j)*t_2ave(i,k,j)+g_c2a(i,k-1,j)*((-(0.5*msft_inv(i)*cqw(i,k,j)*dts*g*mut_inv(i)*rdn(k)*rdnw(k-1)*((1.+epssm)*(rhs(i,&
720 &k)-rhs(i,k-1))+(1.-epssm)*(ph(i,k,j)-ph(i,k-1,j)))))+dts*g*msft_inv(i)*((-(rdn(k)*alt(i,k-1,j)*t_2ave(i,k-1,j)))-rdn(k)*&
721 &alb(i,k-1,j)*mut_inv(i)*muave(i,j)))+g_c2a(i,k,j)*(0.5*msft_inv(i)*cqw(i,k,j)*dts*g*mut_inv(i)*rdn(k)*rdnw(k)*((1.+epssm)*&
722 &(rhs(i,k+1)-rhs(i,k))+(1.-epssm)*(ph(i,k+1,j)-ph(i,k,j)))+dts*g*msft_inv(i)*rdn(k)*(alt(i,k,j)*t_2ave(i,k,j)+alb(i,k,j)*&
723 &mut_inv(i)*muave(i,j)))+0.5*g_cqw(i,k,j)*msft_inv(i)*dts*g*mut_inv(i)*rdn(k)*(c2a(i,k,j)*rdnw(k)*((1.+epssm)*(rhs(i,k+1)-&
724 &rhs(i,k))+(1.-epssm)*(ph(i,k+1,j)-ph(i,k,j)))-c2a(i,k-1,j)*rdnw(k-1)*((1.+epssm)*(rhs(i,k)-rhs(i,k-1))+(1.-epssm)*(ph(i,k,j)&
725 &-ph(i,k-1,j))))+g_muave(i,j)*dts*g*msft_inv(i)*((-1)+rdn(k)*(c2a(i,k,j)*alb(i,k,j)-c2a(i,k-1,j)*alb(i,k-1,j))*mut_inv(i))+&
726 &g_mut_inv(i)*(0.5*msft_inv(i)*cqw(i,k,j)*dts*g*rdn(k)*(c2a(i,k,j)*rdnw(k)*((1.+epssm)*(rhs(i,k+1)-rhs(i,k))+(1.-epssm)*&
727 &(ph(i,k+1,j)-ph(i,k,j)))-c2a(i,k-1,j)*rdnw(k-1)*((1.+epssm)*(rhs(i,k)-rhs(i,k-1))+(1.-epssm)*(ph(i,k,j)-ph(i,k-1,j))))+dts*&
728 &g*msft_inv(i)*rdn(k)*(c2a(i,k,j)*alb(i,k,j)-c2a(i,k-1,j)*alb(i,k-1,j))*muave(i,j))+0.5*g_ph(i,k-1,j)*msft_inv(i)*cqw(i,k,j)*&
729 &dts*g*mut_inv(i)*rdn(k)*c2a(i,k-1,j)*rdnw(k-1)*(1.-epssm)+0.5*g_ph(i,k+1,j)*msft_inv(i)*cqw(i,k,j)*dts*g*mut_inv(i)*rdn(k)*&
730 &c2a(i,k,j)*rdnw(k)*(1.-epssm)-0.5*g_ph(i,k,j)*msft_inv(i)*cqw(i,k,j)*dts*g*mut_inv(i)*rdn(k)*(c2a(i,k,j)*rdnw(k)*(1.-epssm)+&
731 &c2a(i,k-1,j)*rdnw(k-1)*(1.-epssm))+0.5*g_rhs(i,k-1)*msft_inv(i)*cqw(i,k,j)*dts*g*mut_inv(i)*rdn(k)*c2a(i,k-1,j)*rdnw(k-1)*&
732 &(1.+epssm)+0.5*g_rhs(i,k+1)*msft_inv(i)*cqw(i,k,j)*dts*g*mut_inv(i)*rdn(k)*c2a(i,k,j)*rdnw(k)*(1+epssm)-0.5*g_rhs(i,k)*&
733 &msft_inv(i)*cqw(i,k,j)*dts*g*mut_inv(i)*rdn(k)*(c2a(i,k,j)*rdnw(k)*(1.+epssm)+c2a(i,k-1,j)*rdnw(k-1)*(1+epssm))+g_rw_tend(i,&
734 &k,j)*dts-g_t_2ave(i,k-1,j)*dts*g*msft_inv(i)*rdn(k)*c2a(i,k-1,j)*alt(i,k-1,j)+g_t_2ave(i,k,j)*dts*g*msft_inv(i)*rdn(k)*&
735 &c2a(i,k,j)*alt(i,k,j)+g_w(i,k,j)
736 w(i,k,j) = w(i,k,j)+dts*rw_tend(i,k,j)+msft_inv(i)*cqw(i,k,j)*0.5*dts*g*mut_inv(i)*rdn(k)*(c2a(i,k,j)*rdnw(k)*((1.+epssm)*&
737 &(rhs(i,k+1)-rhs(i,k))+(1.-epssm)*(ph(i,k+1,j)-ph(i,k,j)))-c2a(i,k-1,j)*rdnw(k-1)*((1.+epssm)*(rhs(i,k)-rhs(i,k-1))+(1.-&
738 &epssm)*(ph(i,k,j)-ph(i,k-1,j))))+dts*g*msft_inv(i)*(rdn(k)*(c2a(i,k,j)*alt(i,k,j)*t_2ave(i,k,j)-c2a(i,k-1,j)*alt(i,k-1,j)*&
739 &t_2ave(i,k-1,j))+(rdn(k)*(c2a(i,k,j)*alb(i,k,j)-c2a(i,k-1,j)*alb(i,k-1,j))*mut_inv(i)-1.)*muave(i,j))
740 end do
741 end do
742 k = k_end+1
743 do i = i_start, i_end
744 g_w(i,k,j) = (-(2*g_alt(i,k-1,j)*msft_inv(i)*dts*g*rdnw(k-1)*c2a(i,k-1,j)*t_2ave(i,k-1,j)))-g_c2a(i,k-1,j)*msft_inv(i)*dts*g*&
745 &(mut_inv(i)*rdnw(k-1)**2*((1.+epssm)*(rhs(i,k)-rhs(i,k-1))+(1.-epssm)*(ph(i,k,j)-ph(i,k-1,j)))+2*rdnw(k-1)*alt(i,k-1,j)*&
746 &t_2ave(i,k-1,j)+2*rdnw(k-1)*alb(i,k-1,j)*mut_inv(i)*muave(i,j))-g_muave(i,j)*msft_inv(i)*dts*g*(1+2.*rdnw(k-1)*c2a(i,k-1,j)*&
747 &alb(i,k-1,j)*mut_inv(i))-g_mut_inv(i)*msft_inv(i)*(dts*g*rdnw(k-1)**2*c2a(i,k-1,j)*((1.+epssm)*(rhs(i,k)-rhs(i,k-1))+(1.-&
748 &epssm)*(ph(i,k,j)-ph(i,k-1,j)))+2*dts*g*rdnw(k-1)*c2a(i,k-1,j)*alb(i,k-1,j)*muave(i,j))+g_ph(i,k-1,j)*msft_inv(i)*dts*g*&
749 &mut_inv(i)*rdnw(k-1)**2*c2a(i,k-1,j)*(1.-epssm)-g_ph(i,k,j)*msft_inv(i)*dts*g*mut_inv(i)*rdnw(k-1)**2*c2a(i,k-1,j)*(1.-epssm)+&
750 &g_rhs(i,k-1)*msft_inv(i)*dts*g*mut_inv(i)*rdnw(k-1)**2*c2a(i,k-1,j)*(1.+epssm)-g_rhs(i,k)*msft_inv(i)*dts*g*mut_inv(i)*rdnw(k-&
751 &1)**2*c2a(i,k-1,j)*(1+epssm)+g_rw_tend(i,k,j)*dts-2*g_t_2ave(i,k-1,j)*msft_inv(i)*dts*g*rdnw(k-1)*c2a(i,k-1,j)*alt(i,k-1,j)+&
752 &g_w(i,k,j)
753 w(i,k,j) = w(i,k,j)+dts*rw_tend(i,k,j)+msft_inv(i)*((-(0.5*dts*g*mut_inv(i)*rdnw(k-1)**2*2.*c2a(i,k-1,j)*((1.+epssm)*(rhs(i,k)-&
754 &rhs(i,k-1))+(1.-epssm)*(ph(i,k,j)-ph(i,k-1,j)))))-dts*g*(2.*rdnw(k-1)*c2a(i,k-1,j)*alt(i,k-1,j)*t_2ave(i,k-1,j)+(1.+2.*rdnw(k-&
755 &1)*c2a(i,k-1,j)*alb(i,k-1,j)*mut_inv(i))*muave(i,j)))
756 end do
757 do k = 2, k_end+1
758 do i = i_start, i_end
759 g_w(i,k,j) = (-(g_a(i,k,j)*w(i,k-1,j)*alpha(i,k,j)))+g_alpha(i,k,j)*(w(i,k,j)-a(i,k,j)*w(i,k-1,j))-g_w(i,k-1,j)*a(i,k,j)*&
760 &alpha(i,k,j)+g_w(i,k,j)*alpha(i,k,j)
761 w(i,k,j) = (w(i,k,j)-a(i,k,j)*w(i,k-1,j))*alpha(i,k,j)
762 end do
763 end do
764 do k = k_end, 2, -1
765 do i = i_start, i_end
766 g_w(i,k,j) = (-(g_gamma(i,k,j)*w(i,k+1,j)))-g_w(i,k+1,j)*gamma(i,k,j)+g_w(i,k,j)
767 w(i,k,j) = w(i,k,j)-gamma(i,k,j)*w(i,k+1,j)
768 end do
769 end do
770 do k = 2, k_end+1
771 do i = i_start, i_end
772 g_ph(i,k,j) = (-(g_muts(i,j)*(0.5*msft(i,j)*dts*g*(1.+epssm)*w(i,k,j)/(muts(i,j)*muts(i,j)))))+g_rhs(i,k)+g_w(i,k,j)*(0.5*&
773 &msft(i,j)*dts*g*(1.+epssm)/muts(i,j))
774 ph(i,k,j) = rhs(i,k)+msft(i,j)*0.5*dts*g*(1.+epssm)*w(i,k,j)/muts(i,j)
775 end do
776 end do
777 end do j_loop_w
778
779 end subroutine g_advance_w
780
781
782 subroutine g_calc_coef_w( a, g_a, alpha, g_alpha, gamma, g_gamma, mut, g_mut, cqw, g_cqw, rdn, rdnw, c2a, g_c2a, dts, g, epssm, &
783 &ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte )
784 !******************************************************************
785 !******************************************************************
786 !** This routine was generated by Automatic differentiation. **
787 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
788 !******************************************************************
789 !******************************************************************
790 !==============================================
791 ! all entries are defined explicitly
792 !==============================================
793 implicit none
794
795 !==============================================
796 ! declare arguments
797 !==============================================
798 integer, intent(in) :: ime
799 integer, intent(in) :: ims
800 integer, intent(in) :: jme
801 integer, intent(in) :: jms
802 integer, intent(in) :: kme
803 integer, intent(in) :: kms
804 real, intent(inout) :: a(ims:ime,kms:kme,jms:jme)
805 real, intent(inout) :: alpha(ims:ime,kms:kme,jms:jme)
806 real, intent(in) :: c2a(ims:ime,kms:kme,jms:jme)
807 real, intent(in) :: cqw(ims:ime,kms:kme,jms:jme)
808 real, intent(in) :: dts
809 real, intent(in) :: epssm
810 real, intent(in) :: g
811 real, intent(inout) :: g_a(ims:ime,kms:kme,jms:jme)
812 real, intent(inout) :: g_alpha(ims:ime,kms:kme,jms:jme)
813 real, intent(in) :: g_c2a(ims:ime,kms:kme,jms:jme)
814 real, intent(in) :: g_cqw(ims:ime,kms:kme,jms:jme)
815 real, intent(inout) :: g_gamma(ims:ime,kms:kme,jms:jme)
816 real, intent(in) :: g_mut(ims:ime,jms:jme)
817 real, intent(inout) :: gamma(ims:ime,kms:kme,jms:jme)
818 integer, intent(in) :: ide
819 integer, intent(in) :: ite
820 integer, intent(in) :: its
821 integer, intent(in) :: jde
822 integer, intent(in) :: jte
823 integer, intent(in) :: jts
824 integer, intent(in) :: kde
825 real, intent(in) :: mut(ims:ime,jms:jme)
826 real, intent(in) :: rdn(kms:kme)
827 real, intent(in) :: rdnw(kms:kme)
828
829 !==============================================
830 ! declare local variables
831 !==============================================
832 real b
833 real c
834 real cof(ims:ime)
835 real g_b
836 real g_c
837 real g_cof(ims:ime)
838 integer i
839 integer i_end
840 integer i_start
841 integer j
842 integer j_end
843 integer j_start
844 integer k
845
846 !----------------------------------------------
847 ! TANGENT LINEAR AND FUNCTION STATEMENTS
848 !----------------------------------------------
849 i_start = its
850 i_end = ite
851 j_start = jts
852 j_end = jte
853 if (j_end .eq. jde) then
854 j_end = j_end-1
855 endif
856 if (i_end .eq. ide) then
857 i_end = i_end-1
858 endif
859 outer_j_loop: do j = j_start, j_end
860 do i = i_start, i_end
861 g_cof(i) = -(2*g_mut(i,j)*0.5*dts*g*(1.+epssm)/(mut(i,j)*mut(i,j))*(0.5*dts*g*(1.+epssm)/mut(i,j)))
862 cof(i) = (0.5*dts*g*(1.+epssm)/mut(i,j))**2
863 g_a(i,2,j) = 0.
864 a(i,2,j) = 0.
865 g_a(i,kde,j) = (-(2*g_c2a(i,kde-1,j)*cof(i)*rdnw(kde-1)**2))-2*g_cof(i)*rdnw(kde-1)**2*c2a(i,kde-1,j)
866 a(i,kde,j) = -(2.*cof(i)*rdnw(kde-1)**2*c2a(i,kde-1,j))
867 g_gamma(i,1,j) = 0.
868 gamma(i,1,j) = 0.
869 end do
870 do k = 3, kde-1
871 do i = i_start, i_end
872 g_a(i,k,j) = (-(g_c2a(i,k-1,j)*cqw(i,k,j)*cof(i)*rdn(k)*rdnw(k-1)))-g_cof(i)*cqw(i,k,j)*rdn(k)*rdnw(k-1)*c2a(i,k-1,j)-&
873 &g_cqw(i,k,j)*cof(i)*rdn(k)*rdnw(k-1)*c2a(i,k-1,j)
874 a(i,k,j) = -(cqw(i,k,j)*cof(i)*rdn(k)*rdnw(k-1)*c2a(i,k-1,j))
875 end do
876 end do
877 do k = 2, kde-1
878 do i = i_start, i_end
879 g_b = g_c2a(i,k-1,j)*cqw(i,k,j)*cof(i)*rdn(k)*rdnw(k-1)+g_c2a(i,k,j)*cqw(i,k,j)*cof(i)*rdn(k)*rdnw(k)+g_cof(i)*cqw(i,k,j)*&
880 &rdn(k)*(rdnw(k)*c2a(i,k,j)+rdnw(k-1)*c2a(i,k-1,j))+g_cqw(i,k,j)*cof(i)*rdn(k)*(rdnw(k)*c2a(i,k,j)+rdnw(k-1)*c2a(i,k-1,j))
881 b = 1.+cqw(i,k,j)*cof(i)*rdn(k)*(rdnw(k)*c2a(i,k,j)+rdnw(k-1)*c2a(i,k-1,j))
882 g_c = (-(g_c2a(i,k,j)*cqw(i,k,j)*cof(i)*rdn(k)*rdnw(k)))-g_cof(i)*cqw(i,k,j)*rdn(k)*rdnw(k)*c2a(i,k,j)-g_cqw(i,k,j)*cof(i)*&
883 &rdn(k)*rdnw(k)*c2a(i,k,j)
884 c = -(cqw(i,k,j)*cof(i)*rdn(k)*rdnw(k)*c2a(i,k,j))
885 g_alpha(i,k,j) = g_a(i,k,j)*(1.*gamma(i,k-1,j)/((b-a(i,k,j)*gamma(i,k-1,j))*(b-a(i,k,j)*gamma(i,k-1,j))))-g_b/((b-a(i,k,j)*&
886 &gamma(i,k-1,j))*(b-a(i,k,j)*gamma(i,k-1,j)))+g_gamma(i,k-1,j)*(1.*a(i,k,j)/((b-a(i,k,j)*gamma(i,k-1,j))*(b-a(i,k,j)*gamma(i,&
887 &k-1,j))))
888 alpha(i,k,j) = 1./(b-a(i,k,j)*gamma(i,k-1,j))
889 g_gamma(i,k,j) = g_alpha(i,k,j)*c+g_c*alpha(i,k,j)
890 gamma(i,k,j) = c*alpha(i,k,j)
891 end do
892 end do
893 do i = i_start, i_end
894 g_b = 2*g_c2a(i,kde-1,j)*cof(i)*rdnw(kde-1)**2+2*g_cof(i)*rdnw(kde-1)**2*c2a(i,kde-1,j)
895 b = 1.+2.*cof(i)*rdnw(kde-1)**2*c2a(i,kde-1,j)
896 g_c = 0.
897 c = 0.
898 g_alpha(i,kde,j) = g_a(i,kde,j)*(1.*gamma(i,kde-1,j)/((b-a(i,kde,j)*gamma(i,kde-1,j))*(b-a(i,kde,j)*gamma(i,kde-1,j))))-g_b/&
899 &((b-a(i,kde,j)*gamma(i,kde-1,j))*(b-a(i,kde,j)*gamma(i,kde-1,j)))+g_gamma(i,kde-1,j)*(1.*a(i,kde,j)/((b-a(i,kde,j)*gamma(i,&
900 &kde-1,j))*(b-a(i,kde,j)*gamma(i,kde-1,j))))
901 alpha(i,kde,j) = 1./(b-a(i,kde,j)*gamma(i,kde-1,j))
902 g_gamma(i,kde,j) = g_alpha(i,kde,j)*c+g_c*alpha(i,kde,j)
903 gamma(i,kde,j) = c*alpha(i,kde,j)
904 end do
905 end do outer_j_loop
906
907 end subroutine g_calc_coef_w
908
909
910 subroutine g_calc_p_rho( al, g_al, p, g_p, ph, g_ph, alt, g_alt, t_2, g_t_2, t_1, g_t_1, c2a, g_c2a, pm1, g_pm1, mu, g_mu, muts, &
911 &g_muts, znu, t0, rdnw, dnw, smdiv, non_hydrostatic, step, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, &
912 &kte )
913 !******************************************************************
914 !******************************************************************
915 !** This routine was generated by Automatic differentiation. **
916 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
917 !******************************************************************
918 !******************************************************************
919 !==============================================
920 ! all entries are defined explicitly
921 !==============================================
922 implicit none
923
924 !==============================================
925 ! declare arguments
926 !==============================================
927 integer, intent(in) :: ime
928 integer, intent(in) :: ims
929 integer, intent(in) :: jme
930 integer, intent(in) :: jms
931 integer, intent(in) :: kme
932 integer, intent(in) :: kms
933 real, intent(out) :: al(ims:ime,kms:kme,jms:jme)
934 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
935 real, intent(in) :: c2a(ims:ime,kms:kme,jms:jme)
936 real, intent(in) :: dnw(kms:kme)
937 real, intent(out) :: g_al(ims:ime,kms:kme,jms:jme)
938 real, intent(in) :: g_alt(ims:ime,kms:kme,jms:jme)
939 real, intent(in) :: g_c2a(ims:ime,kms:kme,jms:jme)
940 real, intent(in) :: g_mu(ims:ime,jms:jme)
941 real, intent(in) :: g_muts(ims:ime,jms:jme)
942 real, intent(out) :: g_p(ims:ime,kms:kme,jms:jme)
943 real, intent(inout) :: g_ph(ims:ime,kms:kme,jms:jme)
944 real, intent(inout) :: g_pm1(ims:ime,kms:kme,jms:jme)
945 real, intent(in) :: g_t_1(ims:ime,kms:kme,jms:jme)
946 real, intent(in) :: g_t_2(ims:ime,kms:kme,jms:jme)
947 integer, intent(in) :: ide
948 integer, intent(in) :: ite
949 integer, intent(in) :: its
950 integer, intent(in) :: jde
951 integer, intent(in) :: jte
952 integer, intent(in) :: jts
953 integer, intent(in) :: kde
954 integer, intent(in) :: kte
955 integer, intent(in) :: kts
956 real, intent(in) :: mu(ims:ime,jms:jme)
957 real, intent(in) :: muts(ims:ime,jms:jme)
958 logical, intent(in) :: non_hydrostatic
959 real, intent(out) :: p(ims:ime,kms:kme,jms:jme)
960 real, intent(inout) :: ph(ims:ime,kms:kme,jms:jme)
961 real, intent(inout) :: pm1(ims:ime,kms:kme,jms:jme)
962 real, intent(in) :: rdnw(kms:kme)
963 real, intent(in) :: smdiv
964 integer, intent(in) :: step
965 real, intent(in) :: t0
966 real, intent(in) :: t_1(ims:ime,kms:kme,jms:jme)
967 real, intent(in) :: t_2(ims:ime,kms:kme,jms:jme)
968 real, intent(in) :: znu(kms:kme)
969
970 !==============================================
971 ! declare local variables
972 !==============================================
973 real g_ptmp
974 integer i
975 integer i_end
976 integer i_start
977 integer j
978 integer j_end
979 integer j_start
980 integer k
981 integer k_end
982 integer k_start
983 real ptmp
984
985 !----------------------------------------------
986 ! TANGENT LINEAR AND FUNCTION STATEMENTS
987 !----------------------------------------------
988 i_start = its
989 i_end = ite
990 j_start = jts
991 j_end = jte
992 k_start = kts
993 k_end = min(kte,kde-1)
994 if (i_end .eq. ide) then
995 i_end = i_end-1
996 endif
997 if (j_end .eq. jde) then
998 j_end = j_end-1
999 endif
1000 if (non_hydrostatic) then
1001 do j = j_start, j_end
1002 do k = k_start, k_end
1003 do i = i_start, i_end
1004 g_al(i,k,j) = (-(g_alt(i,k,j)*1./muts(i,j)*mu(i,j)))-g_mu(i,j)*1./muts(i,j)*alt(i,k,j)+g_muts(i,j)/(muts(i,j)*muts(i,j))*&
1005 &(alt(i,k,j)*mu(i,j)+rdnw(k)*(ph(i,k+1,j)-ph(i,k,j)))-g_ph(i,k+1,j)*1./muts(i,j)*rdnw(k)+g_ph(i,k,j)*1./muts(i,j)*rdnw(k)
1006 al(i,k,j) = -(1./muts(i,j)*(alt(i,k,j)*mu(i,j)+rdnw(k)*(ph(i,k+1,j)-ph(i,k,j))))
1007 g_p(i,k,j) = (-(g_al(i,k,j)*c2a(i,k,j)))+g_alt(i,k,j)*c2a(i,k,j)*((t_2(i,k,j)-mu(i,j)*t_1(i,k,j))/(muts(i,j)*(t0+t_1(i,k,j)&
1008 &)))+g_c2a(i,k,j)*(alt(i,k,j)*(t_2(i,k,j)-mu(i,j)*t_1(i,k,j))/(muts(i,j)*(t0+t_1(i,k,j)))-al(i,k,j))-g_mu(i,j)*c2a(i,k,j)*&
1009 &(alt(i,k,j)*t_1(i,k,j)/(muts(i,j)*(t0+t_1(i,k,j))))-g_muts(i,j)*c2a(i,k,j)*(alt(i,k,j)*(t_2(i,k,j)-mu(i,j)*t_1(i,k,j))*&
1010 &(t0+t_1(i,k,j))/(muts(i,j)*(t0+t_1(i,k,j))*muts(i,j)*(t0+t_1(i,k,j))))-g_t_1(i,k,j)*c2a(i,k,j)*(alt(i,k,j)*mu(i,j)/&
1011 &(muts(i,j)*(t0+t_1(i,k,j)))+alt(i,k,j)*(t_2(i,k,j)-mu(i,j)*t_1(i,k,j))*muts(i,j)/(muts(i,j)*(t0+t_1(i,k,j))*muts(i,j)*(t0+&
1012 &t_1(i,k,j))))+g_t_2(i,k,j)*c2a(i,k,j)*(alt(i,k,j)/(muts(i,j)*(t0+t_1(i,k,j))))
1013 p(i,k,j) = c2a(i,k,j)*(alt(i,k,j)*(t_2(i,k,j)-mu(i,j)*t_1(i,k,j))/(muts(i,j)*(t0+t_1(i,k,j)))-al(i,k,j))
1014 end do
1015 end do
1016 end do
1017 else
1018 do j = j_start, j_end
1019 do k = k_start, k_end
1020 do i = i_start, i_end
1021 g_p(i,k,j) = g_mu(i,j)*znu(k)
1022 p(i,k,j) = mu(i,j)*znu(k)
1023 g_al(i,k,j) = g_alt(i,k,j)*((t_2(i,k,j)-mu(i,j)*t_1(i,k,j))/(muts(i,j)*(t0+t_1(i,k,j))))+g_c2a(i,k,j)*(p(i,k,j)/(c2a(i,k,j)&
1024 &*c2a(i,k,j)))-g_mu(i,j)*(alt(i,k,j)*t_1(i,k,j)/(muts(i,j)*(t0+t_1(i,k,j))))-g_muts(i,j)*(alt(i,k,j)*(t_2(i,k,j)-mu(i,j)*&
1025 &t_1(i,k,j))*(t0+t_1(i,k,j))/(muts(i,j)*(t0+t_1(i,k,j))*muts(i,j)*(t0+t_1(i,k,j))))-g_p(i,k,j)/c2a(i,k,j)-g_t_1(i,k,j)*&
1026 &(alt(i,k,j)*mu(i,j)/(muts(i,j)*(t0+t_1(i,k,j)))+alt(i,k,j)*(t_2(i,k,j)-mu(i,j)*t_1(i,k,j))*muts(i,j)/(muts(i,j)*(t0+t_1(i,&
1027 &k,j))*muts(i,j)*(t0+t_1(i,k,j))))+g_t_2(i,k,j)*(alt(i,k,j)/(muts(i,j)*(t0+t_1(i,k,j))))
1028 al(i,k,j) = alt(i,k,j)*(t_2(i,k,j)-mu(i,j)*t_1(i,k,j))/(muts(i,j)*(t0+t_1(i,k,j)))-p(i,k,j)/c2a(i,k,j)
1029 g_ph(i,k+1,j) = (-(g_al(i,k,j)*dnw(k)*muts(i,j)))-g_alt(i,k,j)*dnw(k)*mu(i,j)-g_mu(i,j)*dnw(k)*alt(i,k,j)-g_muts(i,j)*&
1030 &dnw(k)*al(i,k,j)+g_ph(i,k,j)
1031 ph(i,k+1,j) = ph(i,k,j)-dnw(k)*(muts(i,j)*al(i,k,j)+mu(i,j)*alt(i,k,j))
1032 end do
1033 end do
1034 end do
1035 endif
1036 if (step .eq. 0) then
1037 do j = j_start, j_end
1038 do k = k_start, k_end
1039 do i = i_start, i_end
1040 g_pm1(i,k,j) = g_p(i,k,j)
1041 pm1(i,k,j) = p(i,k,j)
1042 end do
1043 end do
1044 end do
1045 else
1046 do j = j_start, j_end
1047 do k = k_start, k_end
1048 do i = i_start, i_end
1049 g_ptmp = g_p(i,k,j)
1050 ptmp = p(i,k,j)
1051 g_p(i,k,j) = g_p(i,k,j)*(1+smdiv)-g_pm1(i,k,j)*smdiv
1052 p(i,k,j) = p(i,k,j)+smdiv*(p(i,k,j)-pm1(i,k,j))
1053 g_pm1(i,k,j) = g_ptmp
1054 pm1(i,k,j) = ptmp
1055 end do
1056 end do
1057 end do
1058 endif
1059
1060 end subroutine g_calc_p_rho
1061
1062 subroutine g_small_step_finish( u_2, g_u_2, v_2, g_v_2, w_2, g_w_2, t_2, g_t_2, ph_2, g_ph_2, ww, mu_2, g_mu_2, mut, g_mut, muts, &
1063 &g_muts, muu, g_muu, muus, g_muus, muv, g_muv, muvs, g_muvs, u_save, g_u_save, v_save, g_v_save, w_save, g_w_save, t_save, &
1064 &g_t_save, ph_save, g_ph_save, mu_save, g_mu_save, msfu, msfv, msft, ide, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, &
1065 &jts, jte )
1066
1067 !******************************************************************
1068 !******************************************************************
1069 !** This routine was generated by Automatic differentiation. **
1070 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1071 !******************************************************************
1072 !******************************************************************
1073 !==============================================
1074 ! all entries are defined explicitly
1075 !==============================================
1076 implicit none
1077
1078 !==============================================
1079 ! declare arguments
1080 !==============================================
1081 integer, intent(in) :: ime
1082 integer, intent(in) :: ims
1083 integer, intent(in) :: jme
1084 integer, intent(in) :: jms
1085 real, intent(inout) :: g_mu_2(ims:ime,jms:jme)
1086 real, intent(inout) :: g_mu_save(ims:ime,jms:jme)
1087 real, intent(inout) :: g_mut(ims:ime,jms:jme)
1088 real, intent(inout) :: g_muts(ims:ime,jms:jme)
1089 real, intent(inout) :: g_muu(ims:ime,jms:jme)
1090 real, intent(inout) :: g_muus(ims:ime,jms:jme)
1091 real, intent(inout) :: g_muv(ims:ime,jms:jme)
1092 real, intent(inout) :: g_muvs(ims:ime,jms:jme)
1093 integer, intent(in) :: kme
1094 integer, intent(in) :: kms
1095 real, intent(inout) :: g_ph_2(ims:ime,kms:kme,jms:jme)
1096 real, intent(in) :: g_ph_save(ims:ime,kms:kme,jms:jme)
1097 real, intent(inout) :: g_t_2(ims:ime,kms:kme,jms:jme)
1098 real, intent(in) :: g_t_save(ims:ime,kms:kme,jms:jme)
1099 real, intent(inout) :: g_u_2(ims:ime,kms:kme,jms:jme)
1100 real, intent(in) :: g_u_save(ims:ime,kms:kme,jms:jme)
1101 real, intent(inout) :: g_v_2(ims:ime,kms:kme,jms:jme)
1102 real, intent(in) :: g_v_save(ims:ime,kms:kme,jms:jme)
1103 real, intent(inout) :: g_w_2(ims:ime,kms:kme,jms:jme)
1104 real, intent(in) :: g_w_save(ims:ime,kms:kme,jms:jme)
1105 integer, intent(in) :: ide
1106 integer, intent(in) :: ite
1107 integer, intent(in) :: its
1108 integer, intent(in) :: jde
1109 integer, intent(in) :: jte
1110 integer, intent(in) :: jts
1111 integer, intent(in) :: kde
1112 integer, intent(in) :: kds
1113 real, intent(in) :: msft(ims:ime,jms:jme)
1114 real, intent(in) :: msfu(ims:ime,jms:jme)
1115 real, intent(in) :: msfv(ims:ime,jms:jme)
1116 real, intent(inout) :: mu_2(ims:ime,jms:jme)
1117 real, intent(inout) :: mu_save(ims:ime,jms:jme)
1118 real, intent(inout) :: mut(ims:ime,jms:jme)
1119 real, intent(inout) :: muts(ims:ime,jms:jme)
1120 real, intent(inout) :: muu(ims:ime,jms:jme)
1121 real, intent(inout) :: muus(ims:ime,jms:jme)
1122 real, intent(inout) :: muv(ims:ime,jms:jme)
1123 real, intent(inout) :: muvs(ims:ime,jms:jme)
1124 real, intent(inout) :: ph_2(ims:ime,kms:kme,jms:jme)
1125 real, intent(in) :: ph_save(ims:ime,kms:kme,jms:jme)
1126 real, intent(inout) :: t_2(ims:ime,kms:kme,jms:jme)
1127 real, intent(in) :: t_save(ims:ime,kms:kme,jms:jme)
1128 real, intent(inout) :: u_2(ims:ime,kms:kme,jms:jme)
1129 real, intent(in) :: u_save(ims:ime,kms:kme,jms:jme)
1130 real, intent(inout) :: v_2(ims:ime,kms:kme,jms:jme)
1131 real, intent(in) :: v_save(ims:ime,kms:kme,jms:jme)
1132 real, intent(inout) :: w_2(ims:ime,kms:kme,jms:jme)
1133 real, intent(in) :: w_save(ims:ime,kms:kme,jms:jme)
1134 real, intent(inout) :: ww(ims:ime,kms:kme,jms:jme)
1135
1136
1137 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) ::ww1,g_ww1,g_ww
1138 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: h_diabatic
1139 INTEGER :: number_of_small_timesteps
1140 REAL :: dts
1141
1142
1143
1144 !==============================================
1145 ! declare local variables
1146 !==============================================
1147 integer i
1148 integer i_end
1149 integer i_endu
1150 integer i_start
1151 integer j
1152 integer j_end
1153 integer j_endv
1154 integer j_start
1155 integer k
1156
1157 !----------------------------------------------
1158 ! TANGENT LINEAR AND FUNCTION STATEMENTS
1159 !----------------------------------------------
1160 i_start = its
1161 i_end = ite
1162 j_start = jts
1163 j_end = jte
1164 i_endu = i_end
1165 j_endv = j_end
1166 if (i_end .eq. ide) then
1167 i_end = i_end-1
1168 endif
1169 if (j_end .eq. jde) then
1170 j_end = j_end-1
1171 endif
1172 do j = j_start, j_endv
1173 do k = kds, kde-1
1174 do i = i_start, i_end
1175 g_v_2(i,k,j) = g_muv(i,j)*(v_save(i,k,j)/muvs(i,j))-g_muvs(i,j)*((msfv(i,j)*v_2(i,k,j)+v_save(i,k,j)*muv(i,j))/(muvs(i,j)*&
1176 &muvs(i,j)))+g_v_2(i,k,j)*(msfv(i,j)/muvs(i,j))+g_v_save(i,k,j)*(muv(i,j)/muvs(i,j))
1177 v_2(i,k,j) = (msfv(i,j)*v_2(i,k,j)+v_save(i,k,j)*muv(i,j))/muvs(i,j)
1178 end do
1179 end do
1180 end do
1181 do j = j_start, j_end
1182 do k = kds, kde-1
1183 do i = i_start, i_endu
1184 g_u_2(i,k,j) = g_muu(i,j)*(u_save(i,k,j)/muus(i,j))-g_muus(i,j)*((msfu(i,j)*u_2(i,k,j)+u_save(i,k,j)*muu(i,j))/(muus(i,j)*&
1185 &muus(i,j)))+g_u_2(i,k,j)*(msfu(i,j)/muus(i,j))+g_u_save(i,k,j)*(muu(i,j)/muus(i,j))
1186 u_2(i,k,j) = (msfu(i,j)*u_2(i,k,j)+u_save(i,k,j)*muu(i,j))/muus(i,j)
1187 end do
1188 end do
1189 end do
1190 do j = j_start, j_end
1191 do k = kds, kde
1192 do i = i_start, i_end
1193 g_w_2(i,k,j) = g_mut(i,j)*(w_save(i,k,j)/muts(i,j))-g_muts(i,j)*((msft(i,j)*w_2(i,k,j)+w_save(i,k,j)*mut(i,j))/(muts(i,j)*&
1194 &muts(i,j)))+g_w_2(i,k,j)*(msft(i,j)/muts(i,j))+g_w_save(i,k,j)*(mut(i,j)/muts(i,j))
1195 w_2(i,k,j) = (msft(i,j)*w_2(i,k,j)+w_save(i,k,j)*mut(i,j))/muts(i,j)
1196 g_ph_2(i,k,j) = g_ph_2(i,k,j)+g_ph_save(i,k,j)
1197 ph_2(i,k,j) = ph_2(i,k,j)+ph_save(i,k,j)
1198
1199 !------------------------- added in May 9 -----------------
1200 g_ww(i,k,j) = g_ww(i,k,j) + g_ww1(i,k,j)
1201 ww(i,k,j) = ww(i,k,j) + ww1(i,k,j)
1202 !------------------------- added in May 9 -----------------
1203
1204 end do
1205 end do
1206 end do
1207 do j = j_start, j_end
1208 do k = kds, kde-1
1209 do i = i_start, i_end
1210 !zzma g_t_2(i,k,j) = g_mut(i,j)*(t_save(i,k,j)/muts(i,j))-g_muts(i,j)*((t_2(i,k,j)+t_save(i,k,j)*mut(i,j))/(muts(i,j)*muts(i,j)))+&
1211 !zzma&g_t_2(i,k,j)/muts(i,j)+g_t_save(i,k,j)*(mut(i,j)/muts(i,j))
1212 !zzma t_2(i,k,j) = (t_2(i,k,j)+t_save(i,k,j)*mut(i,j))/muts(i,j)
1213
1214 !------------------------- rewrited in May 9 -----------------
1215 g_t_2(i,k,j) = (g_t_2(i,k,j) - dts*number_of_small_timesteps*g_mut(i,j)*h_diabatic(i,k,j) &
1216 + g_t_save(i,k,j)*mut(i,j) + t_save(i,k,j)*g_mut(i,j))/muts(i,j) &
1217 -(t_2(i,k,j) - dts*number_of_small_timesteps*mut(i,j)*h_diabatic(i,k,j)+ t_save(i,k,j)*mut(i,j))*g_muts(i,j) &
1218 /muts(i,j)**2
1219 t_2(i,k,j) = (t_2(i,k,j) - dts*number_of_small_timesteps*mut(i,j)*h_diabatic(i,k,j) &
1220 + t_save(i,k,j)*mut(i,j))/muts(i,j)
1221
1222 !------------------------- rewrited in May 9 -----------------
1223 end do
1224 end do
1225 end do
1226 do j = j_start, j_end
1227 do i = i_start, i_end
1228 g_mu_2(i,j) = g_mu_2(i,j)+g_mu_save(i,j)
1229 mu_2(i,j) = mu_2(i,j)+mu_save(i,j)
1230 end do
1231 end do
1232
1233 end subroutine g_small_step_finish
1234
1235
1236 subroutine g_small_step_prep( u_1, g_u_1, u_2, g_u_2, v_1, g_v_1, v_2, g_v_2, w_1, g_w_1, w_2, g_w_2, t_1, g_t_1, t_2, g_t_2, ph_1,&
1237 & g_ph_1, ph_2, g_ph_2, mub, mu_1, g_mu_1, mu_2, g_mu_2, muu, g_muu, muus, g_muus, muv, g_muv, muvs, g_muvs, mut, g_mut, muts, &
1238 &g_muts, mudf, g_mudf, u_save, g_u_save, v_save, g_v_save, w_save, g_w_save, t_save, g_t_save, ph_save, g_ph_save, mu_save, &
1239 &g_mu_save, ww, g_ww, ww_save, g_ww_save, c2a, g_c2a, pb, p, g_p, alt, g_alt, msfu, msfv, msft, rk_step, ide, jde, kde, &
1240 &ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1241 !******************************************************************
1242 !******************************************************************
1243 !** This routine was generated by Automatic differentiation. **
1244 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1245 !******************************************************************
1246 !******************************************************************
1247 !==============================================
1248 ! all entries are defined explicitly
1249 !==============================================
1250 implicit none
1251
1252 !==============================================
1253 ! declare arguments
1254 !==============================================
1255 integer, intent(in) :: ime
1256 integer, intent(in) :: ims
1257 integer, intent(in) :: jme
1258 integer, intent(in) :: jms
1259 integer, intent(in) :: kme
1260 integer, intent(in) :: kms
1261 real, intent(in) :: alt(ims:ime,kms:kme,jms:jme)
1262 real, intent(out) :: c2a(ims:ime,kms:kme,jms:jme)
1263 real, intent(in) :: g_alt(ims:ime,kms:kme,jms:jme)
1264 real, intent(out) :: g_c2a(ims:ime,kms:kme,jms:jme)
1265 real, intent(inout) :: g_mu_1(ims:ime,jms:jme)
1266 real, intent(inout) :: g_mu_2(ims:ime,jms:jme)
1267 real, intent(out) :: g_mu_save(ims:ime,jms:jme)
1268 real, intent(out) :: g_mudf(ims:ime,jms:jme)
1269 real, intent(inout) :: g_mut(ims:ime,jms:jme)
1270 real, intent(out) :: g_muts(ims:ime,jms:jme)
1271 real, intent(inout) :: g_muu(ims:ime,jms:jme)
1272 real, intent(out) :: g_muus(ims:ime,jms:jme)
1273 real, intent(inout) :: g_muv(ims:ime,jms:jme)
1274 real, intent(out) :: g_muvs(ims:ime,jms:jme)
1275 real, intent(in) :: g_p(ims:ime,kms:kme,jms:jme)
1276 real, intent(inout) :: g_ph_1(ims:ime,kms:kme,jms:jme)
1277 real, intent(inout) :: g_ph_2(ims:ime,kms:kme,jms:jme)
1278 real, intent(out) :: g_ph_save(ims:ime,kms:kme,jms:jme)
1279 real, intent(inout) :: g_t_1(ims:ime,kms:kme,jms:jme)
1280 real, intent(inout) :: g_t_2(ims:ime,kms:kme,jms:jme)
1281 real, intent(out) :: g_t_save(ims:ime,kms:kme,jms:jme)
1282 real, intent(inout) :: g_u_1(ims:ime,kms:kme,jms:jme)
1283 real, intent(inout) :: g_u_2(ims:ime,kms:kme,jms:jme)
1284 real, intent(out) :: g_u_save(ims:ime,kms:kme,jms:jme)
1285 real, intent(inout) :: g_v_1(ims:ime,kms:kme,jms:jme)
1286 real, intent(inout) :: g_v_2(ims:ime,kms:kme,jms:jme)
1287 real, intent(out) :: g_v_save(ims:ime,kms:kme,jms:jme)
1288 real, intent(inout) :: g_w_1(ims:ime,kms:kme,jms:jme)
1289 real, intent(inout) :: g_w_2(ims:ime,kms:kme,jms:jme)
1290 real, intent(out) :: g_w_save(ims:ime,kms:kme,jms:jme)
1291 real, intent(in) :: g_ww(ims:ime,kms:kme,jms:jme)
1292 real, intent(out) :: g_ww_save(ims:ime,kms:kme,jms:jme)
1293 integer, intent(in) :: ide
1294 integer, intent(in) :: ite
1295 integer, intent(in) :: its
1296 integer, intent(in) :: jde
1297 integer, intent(in) :: jte
1298 integer, intent(in) :: jts
1299 integer, intent(in) :: kde
1300 integer, intent(in) :: kte
1301 integer, intent(in) :: kts
1302 real, intent(inout) :: msft(ims:ime,jms:jme)
1303 real, intent(inout) :: msfu(ims:ime,jms:jme)
1304 real, intent(inout) :: msfv(ims:ime,jms:jme)
1305 real, intent(inout) :: mu_1(ims:ime,jms:jme)
1306 real, intent(inout) :: mu_2(ims:ime,jms:jme)
1307 real, intent(out) :: mu_save(ims:ime,jms:jme)
1308 real, intent(inout) :: mub(ims:ime,jms:jme)
1309 real, intent(out) :: mudf(ims:ime,jms:jme)
1310 real, intent(inout) :: mut(ims:ime,jms:jme)
1311 real, intent(out) :: muts(ims:ime,jms:jme)
1312 real, intent(inout) :: muu(ims:ime,jms:jme)
1313 real, intent(out) :: muus(ims:ime,jms:jme)
1314 real, intent(inout) :: muv(ims:ime,jms:jme)
1315 real, intent(out) :: muvs(ims:ime,jms:jme)
1316 real, intent(in) :: p(ims:ime,kms:kme,jms:jme)
1317 real, intent(in) :: pb(ims:ime,kms:kme,jms:jme)
1318 real, intent(inout) :: ph_1(ims:ime,kms:kme,jms:jme)
1319 real, intent(inout) :: ph_2(ims:ime,kms:kme,jms:jme)
1320 real, intent(out) :: ph_save(ims:ime,kms:kme,jms:jme)
1321 integer, intent(in) :: rk_step
1322 real, intent(inout) :: t_1(ims:ime,kms:kme,jms:jme)
1323 real, intent(inout) :: t_2(ims:ime,kms:kme,jms:jme)
1324 real, intent(out) :: t_save(ims:ime,kms:kme,jms:jme)
1325 real, intent(inout) :: u_1(ims:ime,kms:kme,jms:jme)
1326 real, intent(inout) :: u_2(ims:ime,kms:kme,jms:jme)
1327 real, intent(out) :: u_save(ims:ime,kms:kme,jms:jme)
1328 real, intent(inout) :: v_1(ims:ime,kms:kme,jms:jme)
1329 real, intent(inout) :: v_2(ims:ime,kms:kme,jms:jme)
1330 real, intent(out) :: v_save(ims:ime,kms:kme,jms:jme)
1331 real, intent(inout) :: w_1(ims:ime,kms:kme,jms:jme)
1332 real, intent(inout) :: w_2(ims:ime,kms:kme,jms:jme)
1333 real, intent(out) :: w_save(ims:ime,kms:kme,jms:jme)
1334 real, intent(in) :: ww(ims:ime,kms:kme,jms:jme)
1335 real, intent(out) :: ww_save(ims:ime,kms:kme,jms:jme)
1336
1337 !==============================================
1338 ! declare local variables
1339 !==============================================
1340 integer i
1341 integer i_end
1342 integer i_endu
1343 integer i_start
1344 integer j
1345 integer j_end
1346 integer j_endv
1347 integer j_start
1348 integer k
1349 integer k_end
1350 integer k_start
1351
1352 !----------------------------------------------
1353 ! TANGENT LINEAR AND FUNCTION STATEMENTS
1354 !----------------------------------------------
1355 i_start = its
1356 i_end = ite
1357 j_start = jts
1358 j_end = jte
1359 k_start = kts
1360 k_end = min(kte,kde-1)
1361 i_endu = i_end
1362 j_endv = j_end
1363 if (i_end .eq. ide) then
1364 i_end = i_end-1
1365 endif
1366 if (j_end .eq. jde) then
1367 j_end = j_end-1
1368 endif
1369
1370
1371 if (rk_step .eq. 1) then
1372 do j = j_start, j_end
1373 do i = i_start, i_end
1374 g_mu_1(i,j) = g_mu_2(i,j)
1375 mu_1(i,j) = mu_2(i,j)
1376 g_ww_save(i,kde,j) = 0.
1377 ww_save(i,kde,j) = 0.
1378 g_ww_save(i,1,j) = 0.
1379 ww_save(i,1,j) = 0.
1380 g_mudf(i,j) = 0.
1381 mudf(i,j) = 0.
1382 end do
1383 end do
1384 do j = j_start, j_end
1385 do k = k_start, k_end
1386 do i = i_start, i_endu
1387 g_u_1(i,k,j) = g_u_2(i,k,j)
1388 u_1(i,k,j) = u_2(i,k,j)
1389 end do
1390 end do
1391 end do
1392 do j = j_start, j_endv
1393 do k = k_start, k_end
1394 do i = i_start, i_end
1395 g_v_1(i,k,j) = g_v_2(i,k,j)
1396 v_1(i,k,j) = v_2(i,k,j)
1397 end do
1398 end do
1399 end do
1400 do j = j_start, j_end
1401 do k = k_start, k_end
1402 do i = i_start, i_end
1403 g_t_1(i,k,j) = g_t_2(i,k,j)
1404 t_1(i,k,j) = t_2(i,k,j)
1405 end do
1406 end do
1407 end do
1408 do j = j_start, j_end
1409 do k = k_start, min(kde,kte)
1410 do i = i_start, i_end
1411 g_w_1(i,k,j) = g_w_2(i,k,j)
1412 w_1(i,k,j) = w_2(i,k,j)
1413 g_ph_1(i,k,j) = g_ph_2(i,k,j)
1414 ph_1(i,k,j) = ph_2(i,k,j)
1415 end do
1416 end do
1417 end do
1418 do j = j_start, j_end
1419 do i = i_start, i_end
1420 g_muts(i,j) = g_mu_2(i,j)
1421 muts(i,j) = mub(i,j)+mu_2(i,j)
1422 end do
1423 do i = i_start, i_endu
1424 g_muus(i,j) = g_muu(i,j)
1425 muus(i,j) = muu(i,j)
1426 end do
1427 end do
1428 do j = j_start, j_endv
1429 do i = i_start, i_end
1430 g_muvs(i,j) = g_muv(i,j)
1431 muvs(i,j) = muv(i,j)
1432 end do
1433 end do
1434 do j = j_start, j_end
1435 do i = i_start, i_end
1436 g_mu_save(i,j) = g_mu_2(i,j)
1437 mu_save(i,j) = mu_2(i,j)
1438 g_mu_2(i,j) = 0.
1439 mu_2(i,j) = mu_2(i,j)-mu_2(i,j)
1440 end do
1441 end do
1442 else
1443 do j = j_start, j_end
1444 do i = i_start, i_end
1445 g_muts(i,j) = g_mu_1(i,j)
1446 muts(i,j) = mub(i,j)+mu_1(i,j)
1447 end do
1448 do i = i_start, i_endu
1449 g_muus(i,j) = 0.5*g_mu_1(i-1,j)+0.5*g_mu_1(i,j)
1450 muus(i,j) = 0.5*(mub(i,j)+mu_1(i,j)+mub(i-1,j)+mu_1(i-1,j))
1451 end do
1452 end do
1453 do j = j_start, j_endv
1454 do i = i_start, i_end
1455 g_muvs(i,j) = 0.5*g_mu_1(i,j-1)+0.5*g_mu_1(i,j)
1456 muvs(i,j) = 0.5*(mub(i,j)+mu_1(i,j)+mub(i,j-1)+mu_1(i,j-1))
1457 end do
1458 end do
1459 do j = j_start, j_end
1460 do i = i_start, i_end
1461 g_mu_save(i,j) = g_mu_2(i,j)
1462 mu_save(i,j) = mu_2(i,j)
1463 g_mu_2(i,j) = g_mu_1(i,j)-g_mu_2(i,j)
1464 mu_2(i,j) = mu_1(i,j)-mu_2(i,j)
1465 end do
1466 end do
1467 endif
1468 do j = j_start, j_end
1469 do i = i_start, i_end
1470 g_ww_save(i,kde,j) = 0.
1471 ww_save(i,kde,j) = 0.
1472 g_ww_save(i,1,j) = 0.
1473 ww_save(i,1,j) = 0.
1474 end do
1475 end do
1476 do j = j_start, j_end
1477 do k = k_start, k_end
1478 do i = i_start, i_end
1479 g_c2a(i,k,j) = (-(g_alt(i,k,j)*(cpovcv*(pb(i,k,j)+p(i,k,j))/(alt(i,k,j)*alt(i,k,j)))))+g_p(i,k,j)*(cpovcv/alt(i,k,j))
1480 c2a(i,k,j) = cpovcv*(pb(i,k,j)+p(i,k,j))/alt(i,k,j)
1481 end do
1482 end do
1483 end do
1484 do j = j_start, j_end
1485 do k = k_start, k_end
1486 do i = i_start, i_endu
1487 g_u_save(i,k,j) = g_u_2(i,k,j)
1488 u_save(i,k,j) = u_2(i,k,j)
1489 g_u_2(i,k,j) = (-(g_muu(i,j)*(u_2(i,k,j)/msfu(i,j))))+g_muus(i,j)*(u_1(i,k,j)/msfu(i,j))+g_u_1(i,k,j)*(muus(i,j)/msfu(i,j))-&
1490 &g_u_2(i,k,j)*(muu(i,j)/msfu(i,j))
1491 u_2(i,k,j) = (muus(i,j)*u_1(i,k,j)-muu(i,j)*u_2(i,k,j))/msfu(i,j)
1492 end do
1493 end do
1494 end do
1495 do j = j_start, j_endv
1496 do k = k_start, k_end
1497 do i = i_start, i_end
1498 g_v_save(i,k,j) = g_v_2(i,k,j)
1499 v_save(i,k,j) = v_2(i,k,j)
1500 g_v_2(i,k,j) = (-(g_muv(i,j)*(v_2(i,k,j)/msfv(i,j))))+g_muvs(i,j)*(v_1(i,k,j)/msfv(i,j))+g_v_1(i,k,j)*(muvs(i,j)/msfv(i,j))-&
1501 &g_v_2(i,k,j)*(muv(i,j)/msfv(i,j))
1502 v_2(i,k,j) = (muvs(i,j)*v_1(i,k,j)-muv(i,j)*v_2(i,k,j))/msfv(i,j)
1503 end do
1504 end do
1505 end do
1506 do j = j_start, j_end
1507 do k = k_start, k_end
1508 do i = i_start, i_end
1509 g_t_save(i,k,j) = g_t_2(i,k,j)
1510 t_save(i,k,j) = t_2(i,k,j)
1511 g_t_2(i,k,j) = (-(g_mut(i,j)*t_2(i,k,j)))+g_muts(i,j)*t_1(i,k,j)+g_t_1(i,k,j)*muts(i,j)-g_t_2(i,k,j)*mut(i,j)
1512 t_2(i,k,j) = muts(i,j)*t_1(i,k,j)-mut(i,j)*t_2(i,k,j)
1513 end do
1514 end do
1515 end do
1516 do j = j_start, j_end
1517 do k = k_start, kde
1518 do i = i_start, i_end
1519 g_w_save(i,k,j) = g_w_2(i,k,j)
1520 w_save(i,k,j) = w_2(i,k,j)
1521 g_w_2(i,k,j) = (-(g_mut(i,j)*(w_2(i,k,j)/msft(i,j))))+g_muts(i,j)*(w_1(i,k,j)/msft(i,j))+g_w_1(i,k,j)*(muts(i,j)/msft(i,j))-&
1522 &g_w_2(i,k,j)*(mut(i,j)/msft(i,j))
1523 w_2(i,k,j) = (muts(i,j)*w_1(i,k,j)-mut(i,j)*w_2(i,k,j))/msft(i,j)
1524 g_ph_save(i,k,j) = g_ph_2(i,k,j)
1525 ph_save(i,k,j) = ph_2(i,k,j)
1526 g_ph_2(i,k,j) = g_ph_1(i,k,j)-g_ph_2(i,k,j)
1527 ph_2(i,k,j) = ph_1(i,k,j)-ph_2(i,k,j)
1528 end do
1529 end do
1530 end do
1531 do j = j_start, j_end
1532 do k = k_start, kde
1533 do i = i_start, i_end
1534 g_ww_save(i,k,j) = g_ww(i,k,j)
1535 ww_save(i,k,j) = ww(i,k,j)
1536 end do
1537 end do
1538 end do
1539
1540 end subroutine g_small_step_prep
1541
1542
1543 subroutine g_sumflux( ru, g_ru, rv, g_rv, ww, g_ww, u_lin, g_u_lin, v_lin, g_v_lin, ww_lin, g_ww_lin, muu, g_muu, muv, g_muv, ru_m,&
1544 & g_ru_m, rv_m, g_rv_m, ww_m, g_ww_m, msfu, msfv, iteration, number_of_small_timesteps, ide, jde, kde, ims, ime, jms, jme, kms, &
1545 &kme, its, ite, jts, jte, kts, kte )
1546 !******************************************************************
1547 !******************************************************************
1548 !** This routine was generated by Automatic differentiation. **
1549 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
1550 !******************************************************************
1551 !******************************************************************
1552 !==============================================
1553 ! all entries are defined explicitly
1554 !==============================================
1555 implicit none
1556
1557 !==============================================
1558 ! declare arguments
1559 !==============================================
1560 integer, intent(in) :: ime
1561 integer, intent(in) :: ims
1562 integer, intent(in) :: jme
1563 integer, intent(in) :: jms
1564 real, intent(in) :: g_muu(ims:ime,jms:jme)
1565 real, intent(in) :: g_muv(ims:ime,jms:jme)
1566 integer, intent(in) :: kme
1567 integer, intent(in) :: kms
1568 real, intent(in) :: g_ru(ims:ime,kms:kme,jms:jme)
1569 real, intent(inout) :: g_ru_m(ims:ime,kms:kme,jms:jme)
1570 real, intent(in) :: g_rv(ims:ime,kms:kme,jms:jme)
1571 real, intent(inout) :: g_rv_m(ims:ime,kms:kme,jms:jme)
1572 real, intent(in) :: g_u_lin(ims:ime,kms:kme,jms:jme)
1573 real, intent(in) :: g_v_lin(ims:ime,kms:kme,jms:jme)
1574 real, intent(in) :: g_ww(ims:ime,kms:kme,jms:jme)
1575 real, intent(in) :: g_ww_lin(ims:ime,kms:kme,jms:jme)
1576 real, intent(inout) :: g_ww_m(ims:ime,kms:kme,jms:jme)
1577 integer, intent(in) :: ide
1578 integer, intent(in) :: ite
1579 integer, intent(in) :: iteration
1580 integer, intent(in) :: its
1581 integer, intent(in) :: jde
1582 integer, intent(in) :: jte
1583 integer, intent(in) :: jts
1584 integer, intent(in) :: kde
1585 integer, intent(in) :: kte
1586 integer, intent(in) :: kts
1587 real, intent(in) :: msfu(ims:ime,jms:jme)
1588 real, intent(in) :: msfv(ims:ime,jms:jme)
1589 real, intent(in) :: muu(ims:ime,jms:jme)
1590 real, intent(in) :: muv(ims:ime,jms:jme)
1591 integer, intent(in) :: number_of_small_timesteps
1592 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
1593 real, intent(inout) :: ru_m(ims:ime,kms:kme,jms:jme)
1594 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
1595 real, intent(inout) :: rv_m(ims:ime,kms:kme,jms:jme)
1596 real, intent(in) :: u_lin(ims:ime,kms:kme,jms:jme)
1597 real, intent(in) :: v_lin(ims:ime,kms:kme,jms:jme)
1598 real, intent(in) :: ww(ims:ime,kms:kme,jms:jme)
1599 real, intent(in) :: ww_lin(ims:ime,kms:kme,jms:jme)
1600 real, intent(inout) :: ww_m(ims:ime,kms:kme,jms:jme)
1601
1602 !==============================================
1603 ! declare local variables
1604 !==============================================
1605 integer i
1606 integer j
1607 integer k
1608
1609 !----------------------------------------------
1610 ! TANGENT LINEAR AND FUNCTION STATEMENTS
1611 !----------------------------------------------
1612 if (iteration .eq. 1) then
1613 do j = jts, jte
1614 do k = kts, kte
1615 do i = its, ite
1616 g_ru_m(i,k,j) = 0.
1617 ru_m(i,k,j) = 0.
1618 g_rv_m(i,k,j) = 0.
1619 rv_m(i,k,j) = 0.
1620 g_ww_m(i,k,j) = 0.
1621 ww_m(i,k,j) = 0.
1622 end do
1623 end do
1624 end do
1625 endif
1626 do j = jts, min(jde-1,jte)
1627 do k = kts, min(kde-1,kte)
1628 do i = its, ite
1629 g_ru_m(i,k,j) = g_ru(i,k,j)+g_ru_m(i,k,j)
1630 ru_m(i,k,j) = ru_m(i,k,j)+ru(i,k,j)
1631 end do
1632 end do
1633 end do
1634 do j = jts, jte
1635 do k = kts, min(kde-1,kte)
1636 do i = its, min(ide-1,ite)
1637 g_rv_m(i,k,j) = g_rv(i,k,j)+g_rv_m(i,k,j)
1638 rv_m(i,k,j) = rv_m(i,k,j)+rv(i,k,j)
1639 end do
1640 end do
1641 end do
1642 do j = jts, min(jde-1,jte)
1643 do k = kts, kte
1644 do i = its, min(ide-1,ite)
1645 g_ww_m(i,k,j) = g_ww(i,k,j)+g_ww_m(i,k,j)
1646 ww_m(i,k,j) = ww_m(i,k,j)+ww(i,k,j)
1647 end do
1648 end do
1649 end do
1650 if (iteration .eq. number_of_small_timesteps) then
1651 do j = jts, min(jde-1,jte)
1652 do k = kts, min(kde-1,kte)
1653 do i = its, ite
1654 g_ru_m(i,k,j) = g_muu(i,j)*(u_lin(i,k,j)/msfu(i,j))+g_ru_m(i,k,j)/float(number_of_small_timesteps)+g_u_lin(i,k,j)*(muu(i,j)&
1655 &/msfu(i,j))
1656 ru_m(i,k,j) = ru_m(i,k,j)/number_of_small_timesteps+muu(i,j)*u_lin(i,k,j)/msfu(i,j)
1657 end do
1658 end do
1659 end do
1660 do j = jts, jte
1661 do k = kts, min(kde-1,kte)
1662 do i = its, min(ide-1,ite)
1663 g_rv_m(i,k,j) = g_muv(i,j)*(v_lin(i,k,j)/msfv(i,j))+g_rv_m(i,k,j)/float(number_of_small_timesteps)+g_v_lin(i,k,j)*(muv(i,j)&
1664 &/msfv(i,j))
1665 rv_m(i,k,j) = rv_m(i,k,j)/number_of_small_timesteps+muv(i,j)*v_lin(i,k,j)/msfv(i,j)
1666 end do
1667 end do
1668 end do
1669 do j = jts, min(jde-1,jte)
1670 do k = kts, kte
1671 do i = its, min(ide-1,ite)
1672 g_ww_m(i,k,j) = g_ww_lin(i,k,j)+g_ww_m(i,k,j)/float(number_of_small_timesteps)
1673 ww_m(i,k,j) = ww_m(i,k,j)/number_of_small_timesteps+ww_lin(i,k,j)
1674 end do
1675 end do
1676 end do
1677 endif
1678
1679 end subroutine g_sumflux
1680
1681
1682 end module g_module_small_step_em
1683
1684