module_bc_em_ad.F
References to this file elsewhere.
1 ! DISCLAIMER
2 !
3 ! This file was generated by TAF version 1.7.18
4 !
5 ! FASTOPT DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED,
6 ! INCLUDING (WITHOUT LIMITATION) ALL IMPLIED WARRANTIES OF
7 ! MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, WITH
8 ! RESPECT TO THE SOFTWARE AND USER PROGRAMS. IN NO EVENT
9 ! SHALL FASTOPT BE LIABLE FOR ANY LOST OR ANTICIPATED PROF-
10 ! ITS, OR ANY INDIRECT, INCIDENTAL, EXEMPLARY, SPECIAL, OR
11 ! CONSEQUENTIAL DAMAGES, WHETHER OR NOT FASTOPT WAS ADVISED
12 ! OF THE POSSIBILITY OF SUCH DAMAGES.
13 !
14 ! Haftungsbeschraenkung
15 ! FastOpt gibt ausdruecklich keine Gewaehr, explizit oder indirekt,
16 ! bezueglich der Brauchbarkeit der Software fuer einen bestimmten
17 ! Zweck. Unter keinen Umstaenden ist FastOpt haftbar fuer
18 ! irgendeinen Verlust oder nicht eintretenden erwarteten Gewinn und
19 ! allen indirekten, zufaelligen, exemplarischen oder speziellen
20 ! Schaeden oder Folgeschaeden unabhaengig von einer eventuellen
21 ! Mitteilung darueber an FastOpt.
22 !
23 module a_module_bc_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_bc
34 use a_module_bc
35 use module_configure
36 use module_wrf_error
37 use module_bc_em
38
39 !==============================================
40 ! all entries are defined explicitly
41 !==============================================
42 implicit none
43
44 contains
45 subroutine a_relax_bdy_dry( config_flags, a_ru_tendf, a_rv_tendf, a_ph_tendf, a_t_tendf, a_rw_tendf, a_mu_tend, a_ru, a_rv, ph, &
46 &a_ph, t, a_t, w, a_w, a_mu, mut, a_mut, a_u_b, a_v_b, a_ph_b, a_t_b, a_w_b, a_mu_b, a_u_bt, a_v_bt, a_ph_bt, a_t_bt, a_w_bt, &
47 &a_mu_bt, spec_bdy_width, spec_zone, relax_zone, dtbc, fcx, gcx, ijds, ijde, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,&
48 & kme, its, ite, jts, jte, kts, kte )
49 !******************************************************************
50 !******************************************************************
51 !** This routine was generated by Automatic differentiation. **
52 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
53 !******************************************************************
54 !******************************************************************
55 !==============================================
56 ! all entries are defined explicitly
57 !==============================================
58 implicit none
59
60 !==============================================
61 ! declare arguments
62 !==============================================
63 integer, intent(in) :: ime
64 integer, intent(in) :: ims
65 integer, intent(in) :: jme
66 integer, intent(in) :: jms
67 real, intent(inout) :: a_mu(ims:ime,jms:jme)
68 integer, intent(in) :: ijde
69 integer, intent(in) :: ijds
70 integer, intent(in) :: spec_bdy_width
71 real, intent(inout) :: a_mu_b(ijds:ijde,1:1,spec_bdy_width,4)
72 real, intent(inout) :: a_mu_bt(ijds:ijde,1:1,spec_bdy_width,4)
73 real, intent(inout) :: a_mu_tend(ims:ime,jms:jme)
74 real, intent(inout) :: a_mut(ims:ime,jms:jme)
75 integer, intent(in) :: kme
76 integer, intent(in) :: kms
77 real, intent(inout) :: a_ph(ims:ime,kms:kme,jms:jme)
78 integer, intent(in) :: kde
79 integer, intent(in) :: kds
80 real, intent(inout) :: a_ph_b(ijds:ijde,kds:kde,spec_bdy_width,4)
81 real, intent(inout) :: a_ph_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
82 real, intent(inout) :: a_ph_tendf(ims:ime,kms:kme,jms:jme)
83 real, intent(inout) :: a_ru(ims:ime,kms:kme,jms:jme)
84 real, intent(inout) :: a_ru_tendf(ims:ime,kms:kme,jms:jme)
85 real, intent(inout) :: a_rv(ims:ime,kms:kme,jms:jme)
86 real, intent(inout) :: a_rv_tendf(ims:ime,kms:kme,jms:jme)
87 real, intent(inout) :: a_rw_tendf(ims:ime,kms:kme,jms:jme)
88 real, intent(inout) :: a_t(ims:ime,kms:kme,jms:jme)
89 real, intent(inout) :: a_t_b(ijds:ijde,kds:kde,spec_bdy_width,4)
90 real, intent(inout) :: a_t_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
91 real, intent(inout) :: a_t_tendf(ims:ime,kms:kme,jms:jme)
92 real, intent(inout) :: a_u_b(ijds:ijde,kds:kde,spec_bdy_width,4)
93 real, intent(inout) :: a_u_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
94 real, intent(inout) :: a_v_b(ijds:ijde,kds:kde,spec_bdy_width,4)
95 real, intent(inout) :: a_v_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
96 real, intent(inout) :: a_w(ims:ime,kms:kme,jms:jme)
97 real, intent(inout) :: a_w_b(ijds:ijde,kds:kde,spec_bdy_width,4)
98 real, intent(inout) :: a_w_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
99 type (grid_config_rec_type) config_flags
100 real, intent(in) :: dtbc
101 real, intent(in) :: fcx(spec_bdy_width)
102 real, intent(in) :: gcx(spec_bdy_width)
103 integer, intent(in) :: ide
104 integer, intent(in) :: ids
105 integer, intent(in) :: ite
106 integer, intent(in) :: its
107 integer, intent(in) :: jde
108 integer, intent(in) :: jds
109 integer, intent(in) :: jte
110 integer, intent(in) :: jts
111 integer, intent(in) :: kte
112 integer, intent(in) :: kts
113 real, intent(in) :: mut(ims:ime,jms:jme)
114 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
115 integer, intent(in) :: relax_zone
116 integer, intent(in) :: spec_zone
117 real, intent(in) :: t(ims:ime,kms:kme,jms:jme)
118 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
119
120 !==============================================
121 ! declare local variables
122 !==============================================
123 real a_rfield(ims:ime,kms:kme,jms:jme)
124 integer i
125 integer i_end
126 integer i_start
127 integer j
128 integer j_end
129 integer j_start
130 integer k
131
132 !----------------------------------------------
133 ! RESET LOCAL ADJOINT VARIABLES
134 !----------------------------------------------
135 a_rfield(:,:,:) = 0.
136
137 !----------------------------------------------
138 ! ROUTINE BODY
139 !----------------------------------------------
140 if (config_flags%nested) then
141 i_start = max(its-1,ids)
142 ! recompute : i_start
143 i_end = min(ite+1,ide-1)
144 ! recompute : i_end
145 j_start = max(jts-1,jds)
146 ! recompute : j_start
147 j_end = min(jte+1,jde-1)
148 ! recompute : j_end
149 call a_relax_bdytend( a_rfield,a_rw_tendf,a_w_b,a_w_bt,'h',spec_bdy_width,spec_zone,relax_zone,dtbc,fcx,gcx,ijds,ijde,ids,ide,&
150 &jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
151 do j = j_start, j_end
152 do k = kts, kte
153 do i = i_start, i_end
154 a_mut(i,j) = a_mut(i,j)+a_rfield(i,k,j)*w(i,k,j)
155 a_w(i,k,j) = a_w(i,k,j)+a_rfield(i,k,j)*mut(i,j)
156 a_rfield(i,k,j) = 0.
157 end do
158 end do
159 end do
160 endif
161 call a_relax_bdytend( a_mu,a_mu_tend,a_mu_b,a_mu_bt,'m',spec_bdy_width,spec_zone,relax_zone,dtbc,fcx,gcx,ijds,ijde,ids,ide,jds,jde,&
162 &1,1,ims,ime,jms,jme,1,1,its,ite,jts,jte,1,1 )
163 call a_relax_bdytend( a_rfield,a_t_tendf,a_t_b,a_t_bt,'t',spec_bdy_width,spec_zone,relax_zone,dtbc,fcx,gcx,ijds,ijde,ids,ide,jds,&
164 &jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
165 ! recdepend vars : ids,its
166 ! recompute pos : ASSIGN_STMT module_bc_em.f90:231
167 ! recompute vars : i_start
168 i_start = max(its-1,ids)
169 ! recompute vars : i_start
170 ! recdepend vars : i_start,ide,ite
171 ! recompute pos : ASSIGN_STMT module_bc_em.f90:232
172 ! recompute vars : i_end
173 i_end = min(ite+1,ide-1)
174 ! recompute vars : i_end
175 ! recdepend vars : i_end,i_start,jds,jts
176 ! recompute pos : ASSIGN_STMT module_bc_em.f90:233
177 ! recompute vars : j_start
178 j_start = max(jts-1,jds)
179 ! recompute vars : j_start
180 ! recdepend vars : i_end,i_start,j_start,jde,jte
181 ! recompute pos : ASSIGN_STMT module_bc_em.f90:234
182 ! recompute vars : j_end
183 j_end = min(jte+1,jde-1)
184 ! recompute vars : j_end
185 do j = j_start, j_end
186 do k = kts, kte-1
187 do i = i_start, i_end
188 a_mut(i,j) = a_mut(i,j)+a_rfield(i,k,j)*t(i,k,j)
189 a_t(i,k,j) = a_t(i,k,j)+a_rfield(i,k,j)*mut(i,j)
190 a_rfield(i,k,j) = 0.
191 end do
192 end do
193 end do
194 call a_relax_bdytend( a_rfield,a_ph_tendf,a_ph_b,a_ph_bt,'h',spec_bdy_width,spec_zone,relax_zone,dtbc,fcx,gcx,ijds,ijde,ids,ide,&
195 &jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
196 ! recdepend vars : ids,its
197 ! recompute pos : ASSIGN_STMT module_bc_em.f90:231
198 ! recompute vars : i_start
199 i_start = max(its-1,ids)
200 ! recompute vars : i_start
201 ! recdepend vars : i_start,ide,ite
202 ! recompute pos : ASSIGN_STMT module_bc_em.f90:232
203 ! recompute vars : i_end
204 i_end = min(ite+1,ide-1)
205 ! recompute vars : i_end
206 ! recdepend vars : i_end,i_start,jds,jts
207 ! recompute pos : ASSIGN_STMT module_bc_em.f90:233
208 ! recompute vars : j_start
209 j_start = max(jts-1,jds)
210 ! recompute vars : j_start
211 ! recdepend vars : i_end,i_start,j_start,jde,jte
212 ! recompute pos : ASSIGN_STMT module_bc_em.f90:234
213 ! recompute vars : j_end
214 j_end = min(jte+1,jde-1)
215 ! recompute vars : j_end
216 do j = j_start, j_end
217 do k = kts, kte
218 do i = i_start, i_end
219 a_mut(i,j) = a_mut(i,j)+a_rfield(i,k,j)*ph(i,k,j)
220 a_ph(i,k,j) = a_ph(i,k,j)+a_rfield(i,k,j)*mut(i,j)
221 a_rfield(i,k,j) = 0.
222 end do
223 end do
224 end do
225 call a_relax_bdytend( a_rv,a_rv_tendf,a_v_b,a_v_bt,'v',spec_bdy_width,spec_zone,relax_zone,dtbc,fcx,gcx,ijds,ijde,ids,ide,jds,jde,&
226 &kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
227 call a_relax_bdytend( a_ru,a_ru_tendf,a_u_b,a_u_bt,'u',spec_bdy_width,spec_zone,relax_zone,dtbc,fcx,gcx,ijds,ijde,ids,ide,jds,jde,&
228 &kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
229
230 end subroutine a_relax_bdy_dry
231
232
233 subroutine a_spec_bdy_dry( config_flags, a_ru_tend, a_rv_tend, a_ph_tend, a_t_tend, a_rw_tend, a_mu_tend, a_u_bt, a_v_bt, a_ph_bt, &
234 &a_t_bt, a_w_bt, a_mu_bt, spec_bdy_width, spec_zone, ijds, ijde, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, &
235 &ite, jts, jte, kts, kte )
236 !******************************************************************
237 !******************************************************************
238 !** This routine was generated by Automatic differentiation. **
239 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
240 !******************************************************************
241 !******************************************************************
242 !==============================================
243 ! all entries are defined explicitly
244 !==============================================
245 implicit none
246
247 !==============================================
248 ! declare arguments
249 !==============================================
250 integer, intent(in) :: ijde
251 integer, intent(in) :: ijds
252 integer, intent(in) :: spec_bdy_width
253 real, intent(inout) :: a_mu_bt(ijds:ijde,1:1,spec_bdy_width,4)
254 integer, intent(in) :: ime
255 integer, intent(in) :: ims
256 integer, intent(in) :: jme
257 integer, intent(in) :: jms
258 real, intent(inout) :: a_mu_tend(ims:ime,jms:jme)
259 integer, intent(in) :: kde
260 integer, intent(in) :: kds
261 real, intent(inout) :: a_ph_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
262 integer, intent(in) :: kme
263 integer, intent(in) :: kms
264 real, intent(inout) :: a_ph_tend(ims:ime,kms:kme,jms:jme)
265 real, intent(inout) :: a_ru_tend(ims:ime,kms:kme,jms:jme)
266 real, intent(inout) :: a_rv_tend(ims:ime,kms:kme,jms:jme)
267 real, intent(inout) :: a_rw_tend(ims:ime,kms:kme,jms:jme)
268 real, intent(inout) :: a_t_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
269 real, intent(inout) :: a_t_tend(ims:ime,kms:kme,jms:jme)
270 real, intent(inout) :: a_u_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
271 real, intent(inout) :: a_v_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
272 real, intent(inout) :: a_w_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
273 type (grid_config_rec_type) config_flags
274 integer, intent(in) :: ide
275 integer, intent(in) :: ids
276 integer, intent(in) :: ite
277 integer, intent(in) :: its
278 integer, intent(in) :: jde
279 integer, intent(in) :: jds
280 integer, intent(in) :: jte
281 integer, intent(in) :: jts
282 integer, intent(in) :: kte
283 integer, intent(in) :: kts
284 integer, intent(in) :: spec_zone
285
286 !----------------------------------------------
287 ! ROUTINE BODY
288 !----------------------------------------------
289 if (config_flags%nested) then
290 call a_spec_bdytend( a_rw_tend,a_w_bt,'h',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,&
291 &ite,jts,jte,kts,kte )
292 endif
293 call a_spec_bdytend( a_mu_tend,a_mu_bt,'m',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,1,1,ims,ime,jms,jme,1,1,its,ite,jts,&
294 &jte,1,1 )
295 call a_spec_bdytend( a_t_tend,a_t_bt,'t',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,&
296 &ite,jts,jte,kts,kte )
297 call a_spec_bdytend( a_ph_tend,a_ph_bt,'h',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,&
298 &ite,jts,jte,kts,kte )
299 call a_spec_bdytend( a_rv_tend,a_v_bt,'v',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,&
300 &ite,jts,jte,kts,kte )
301 call a_spec_bdytend( a_ru_tend,a_u_bt,'u',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,&
302 &ite,jts,jte,kts,kte )
303
304 end subroutine a_spec_bdy_dry
305
306
307 subroutine a_spec_bdy_scalar( a_scalar_tend, a_scalar_bt, spec_bdy_width, spec_zone, ijds, ijde, ids, ide, jds, jde, kds, kde, ims,&
308 & ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
309 !******************************************************************
310 !******************************************************************
311 !** This routine was generated by Automatic differentiation. **
312 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
313 !******************************************************************
314 !******************************************************************
315 !==============================================
316 ! all entries are defined explicitly
317 !==============================================
318 implicit none
319
320 !==============================================
321 ! declare arguments
322 !==============================================
323 integer, intent(in) :: ijde
324 integer, intent(in) :: ijds
325 integer, intent(in) :: kde
326 integer, intent(in) :: kds
327 integer, intent(in) :: spec_bdy_width
328 real, intent(inout) :: a_scalar_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
329 integer, intent(in) :: ime
330 integer, intent(in) :: ims
331 integer, intent(in) :: jme
332 integer, intent(in) :: jms
333 integer, intent(in) :: kme
334 integer, intent(in) :: kms
335 real, intent(inout) :: a_scalar_tend(ims:ime,kms:kme,jms:jme)
336 integer, intent(in) :: ide
337 integer, intent(in) :: ids
338 integer, intent(in) :: ite
339 integer, intent(in) :: its
340 integer, intent(in) :: jde
341 integer, intent(in) :: jds
342 integer, intent(in) :: jte
343 integer, intent(in) :: jts
344 integer, intent(in) :: kte
345 integer, intent(in) :: kts
346 integer, intent(in) :: spec_zone
347
348 !----------------------------------------------
349 ! ROUTINE BODY
350 !----------------------------------------------
351 call a_spec_bdytend( a_scalar_tend,a_scalar_bt,'q',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,&
352 &kme,its,ite,jts,jte,kts,kte )
353
354 end subroutine a_spec_bdy_scalar
355
356
357 subroutine a_spec_bdyupdate_ph( ph_save, a_ph_save, field, a_field, field_tend, a_field_tend, mu_tend, a_mu_tend, muts, a_muts, dt,&
358 & variable_in, spec_zone, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
359 !******************************************************************
360 !******************************************************************
361 !** This routine was generated by Automatic differentiation. **
362 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
363 !******************************************************************
364 !******************************************************************
365 !==============================================
366 ! all entries are defined explicitly
367 !==============================================
368 implicit none
369
370 !==============================================
371 ! declare arguments
372 !==============================================
373 integer, intent(in) :: ime
374 integer, intent(in) :: ims
375 integer, intent(in) :: jme
376 integer, intent(in) :: jms
377 integer, intent(in) :: kme
378 integer, intent(in) :: kms
379 real, intent(inout) :: a_field(ims:ime,kms:kme,jms:jme)
380 real, intent(inout) :: a_field_tend(ims:ime,kms:kme,jms:jme)
381 real, intent(inout) :: a_mu_tend(ims:ime,jms:jme)
382 real, intent(inout) :: a_muts(ims:ime,jms:jme)
383 real, intent(inout) :: a_ph_save(ims:ime,kms:kme,jms:jme)
384 real, intent(in) :: dt
385 real, intent(inout) :: field(ims:ime,kms:kme,jms:jme)
386 real, intent(in) :: field_tend(ims:ime,kms:kme,jms:jme)
387 integer, intent(in) :: ide
388 integer, intent(in) :: ids
389 integer, intent(in) :: ite
390 integer, intent(in) :: its
391 integer, intent(in) :: jde
392 integer, intent(in) :: jds
393 integer, intent(in) :: jte
394 integer, intent(in) :: jts
395 integer, intent(in) :: kde
396 integer, intent(in) :: kte
397 integer, intent(in) :: kts
398 real, intent(in) :: mu_tend(ims:ime,jms:jme)
399 real, intent(in) :: muts(ims:ime,jms:jme)
400 real, intent(in) :: ph_save(ims:ime,kms:kme,jms:jme)
401 integer, intent(in) :: spec_zone
402 character, intent(in) :: variable_in
403
404 !==============================================
405 ! declare local variables
406 !==============================================
407 real a_mu_old(its:ite,jts:jte)
408 integer b_dist
409 real fieldh(ims:ime,kms:kme,jms:jme)
410 integer i
411 integer ibe
412 integer ibs
413 integer itf
414 integer j
415 integer jbe
416 integer jbs
417 integer jtf
418 integer k
419 integer ktf
420 real mu_old(its:ite,jts:jte)
421 character variable
422
423 !----------------------------------------------
424 ! SAVE REQUIRED INPUT VARIABLES
425 !----------------------------------------------
426 fieldh(:,:,:) = field(:,:,:)
427
428 !----------------------------------------------
429 ! RESET LOCAL ADJOINT VARIABLES
430 !----------------------------------------------
431 a_mu_old(:,:) = 0.
432
433 !----------------------------------------------
434 ! ROUTINE BODY
435 !----------------------------------------------
436 variable = variable_in
437 ! recompute : variable
438 if (variable .eq. 'U') then
439 variable = 'u'
440 endif
441 ! recompute : variable
442 if (variable .eq. 'V') then
443 variable = 'v'
444 endif
445 ! recompute : variable
446 if (variable .eq. 'M') then
447 variable = 'm'
448 endif
449 ! recompute : variable
450 if (variable .eq. 'H') then
451 variable = 'h'
452 endif
453 ! recompute : variable
454 ibs = ids
455 ! recompute : ibs
456 ibe = ide-1
457 ! recompute : ibe
458 itf = min(ite,ide-1)
459 ! recompute : itf
460 jbs = jds
461 ! recompute : jbs
462 jbe = jde-1
463 ! recompute : jbe
464 jtf = min(jte,jde-1)
465 ! recompute : jtf
466 ktf = kde-1
467 ! recompute : ktf
468 if (variable .eq. 'u') then
469 ibe = ide
470 endif
471 ! recompute : ibe
472 if (variable .eq. 'u') then
473 itf = min(ite,ide)
474 endif
475 ! recompute : itf
476 if (variable .eq. 'v') then
477 jbe = jde
478 endif
479 ! recompute : jbe
480 if (variable .eq. 'v') then
481 jtf = min(jte,jde)
482 endif
483 ! recompute : jtf
484 if (variable .eq. 'm') then
485 ktf = kte
486 endif
487 ! recompute : ktf
488 if (variable .eq. 'h') then
489 ktf = kte
490 endif
491 ! recompute : ktf
492 if (jts-jbs .lt. spec_zone) then
493 do j = jts, min(jtf,jbs+spec_zone-1)
494 b_dist = j-jbs
495 do k = kts, ktf
496 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
497 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
498 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j)+dt*field_tend(i,k,j)/muts(i,j)+ph_save(i,k,j)*(mu_old(i,j)/muts(i,j)-1.)
499 end do
500 end do
501 end do
502 endif
503 ! recompute : field
504 if (jbe-jtf .lt. spec_zone) then
505 do j = max(jts,jbe-spec_zone+1), jtf
506 b_dist = jbe-j
507 do k = kts, ktf
508 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
509 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
510 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j)+dt*field_tend(i,k,j)/muts(i,j)+ph_save(i,k,j)*(mu_old(i,j)/muts(i,j)-1.)
511 end do
512 end do
513 end do
514 endif
515 ! recompute : field
516 if (its-ibs .lt. spec_zone) then
517 do i = its, min(itf,ibs+spec_zone-1)
518 b_dist = i-ibs
519 do k = kts, ktf
520 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
521 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
522 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j)+dt*field_tend(i,k,j)/muts(i,j)+ph_save(i,k,j)*(mu_old(i,j)/muts(i,j)-1.)
523 end do
524 end do
525 end do
526 endif
527 ! recompute : field
528 if (ibe-itf .lt. spec_zone) then
529 do i = max(its,ibe-spec_zone+1), itf
530 b_dist = ibe-i
531 ! recompute : b_dist
532 do k = kts, ktf
533 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
534 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
535 ! recompute : mu_old
536 a_field_tend(i,k,j) = a_field_tend(i,k,j)+a_field(i,k,j)*(dt/muts(i,j))
537 a_mu_old(i,j) = a_mu_old(i,j)+a_field(i,k,j)*(field(i,k,j)/muts(i,j)+ph_save(i,k,j)/muts(i,j))
538 a_muts(i,j) = a_muts(i,j)+a_field(i,k,j)*((-(field(i,k,j)*mu_old(i,j)/(muts(i,j)*muts(i,j))))-dt*field_tend(i,k,j)/(muts(i,&
539 &j)*muts(i,j))-ph_save(i,k,j)*(mu_old(i,j)/(muts(i,j)*muts(i,j))))
540 a_ph_save(i,k,j) = a_ph_save(i,k,j)+a_field(i,k,j)*((-1)+mu_old(i,j)/muts(i,j))
541 a_field(i,k,j) = a_field(i,k,j)*(mu_old(i,j)/muts(i,j))
542 a_mu_tend(i,j) = a_mu_tend(i,j)-a_mu_old(i,j)*dt
543 a_muts(i,j) = a_muts(i,j)+a_mu_old(i,j)
544 a_mu_old(i,j) = 0.
545 end do
546 end do
547 end do
548 endif
549 field(:,:,:) = fieldh(:,:,:)
550 ! recdepend vars : dt,field,field_tend,ibe,ibs,itf,its,jbs,jtf,jts,ktf,
551 ! kts,mu_tend,muts,ph_save,spec_zone
552 ! recompute pos : IF_STMT module_bc_em.f90:71
553 ! recompute vars : field
554 if (jts-jbs .lt. spec_zone) then
555 do j = jts, min(jtf,jbs+spec_zone-1)
556 b_dist = j-jbs
557 do k = kts, ktf
558 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
559 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
560 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j)+dt*field_tend(i,k,j)/muts(i,j)+ph_save(i,k,j)*(mu_old(i,j)/muts(i,j)-1.)
561 end do
562 end do
563 end do
564 endif
565 ! recompute vars : field
566 ! recdepend vars : dt,field,field_tend,ibe,ibs,itf,its,jbe,jtf,jts,ktf,
567 ! kts,mu_tend,muts,ph_save,spec_zone
568 ! recompute pos : IF_STMT module_bc_em.f90:88
569 ! recompute vars : field
570 if (jbe-jtf .lt. spec_zone) then
571 do j = max(jts,jbe-spec_zone+1), jtf
572 b_dist = jbe-j
573 do k = kts, ktf
574 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
575 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
576 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j)+dt*field_tend(i,k,j)/muts(i,j)+ph_save(i,k,j)*(mu_old(i,j)/muts(i,j)-1.)
577 end do
578 end do
579 end do
580 endif
581 ! recompute vars : field
582 if (its-ibs .lt. spec_zone) then
583 do i = its, min(itf,ibs+spec_zone-1)
584 b_dist = i-ibs
585 ! recompute : b_dist
586 do k = kts, ktf
587 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
588 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
589 ! recompute : mu_old
590 a_field_tend(i,k,j) = a_field_tend(i,k,j)+a_field(i,k,j)*(dt/muts(i,j))
591 a_mu_old(i,j) = a_mu_old(i,j)+a_field(i,k,j)*(field(i,k,j)/muts(i,j)+ph_save(i,k,j)/muts(i,j))
592 a_muts(i,j) = a_muts(i,j)+a_field(i,k,j)*((-(field(i,k,j)*mu_old(i,j)/(muts(i,j)*muts(i,j))))-dt*field_tend(i,k,j)/(muts(i,&
593 &j)*muts(i,j))-ph_save(i,k,j)*(mu_old(i,j)/(muts(i,j)*muts(i,j))))
594 a_ph_save(i,k,j) = a_ph_save(i,k,j)+a_field(i,k,j)*((-1)+mu_old(i,j)/muts(i,j))
595 a_field(i,k,j) = a_field(i,k,j)*(mu_old(i,j)/muts(i,j))
596 a_mu_tend(i,j) = a_mu_tend(i,j)-a_mu_old(i,j)*dt
597 a_muts(i,j) = a_muts(i,j)+a_mu_old(i,j)
598 a_mu_old(i,j) = 0.
599 end do
600 end do
601 end do
602 endif
603 field(:,:,:) = fieldh(:,:,:)
604 ! recdepend vars : dt,field,field_tend,ibe,ibs,itf,its,jbs,jtf,jts,ktf,
605 ! kts,mu_tend,muts,ph_save,spec_zone
606 ! recompute pos : IF_STMT module_bc_em.f90:71
607 ! recompute vars : field
608 if (jts-jbs .lt. spec_zone) then
609 do j = jts, min(jtf,jbs+spec_zone-1)
610 b_dist = j-jbs
611 do k = kts, ktf
612 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
613 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
614 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j)+dt*field_tend(i,k,j)/muts(i,j)+ph_save(i,k,j)*(mu_old(i,j)/muts(i,j)-1.)
615 end do
616 end do
617 end do
618 endif
619 ! recompute vars : field
620 if (jbe-jtf .lt. spec_zone) then
621 do j = max(jts,jbe-spec_zone+1), jtf
622 b_dist = jbe-j
623 ! recompute : b_dist
624 do k = kts, ktf
625 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
626 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
627 ! recompute : mu_old
628 a_field_tend(i,k,j) = a_field_tend(i,k,j)+a_field(i,k,j)*(dt/muts(i,j))
629 a_mu_old(i,j) = a_mu_old(i,j)+a_field(i,k,j)*(field(i,k,j)/muts(i,j)+ph_save(i,k,j)/muts(i,j))
630 a_muts(i,j) = a_muts(i,j)+a_field(i,k,j)*((-(field(i,k,j)*mu_old(i,j)/(muts(i,j)*muts(i,j))))-dt*field_tend(i,k,j)/(muts(i,&
631 &j)*muts(i,j))-ph_save(i,k,j)*(mu_old(i,j)/(muts(i,j)*muts(i,j))))
632 a_ph_save(i,k,j) = a_ph_save(i,k,j)+a_field(i,k,j)*((-1)+mu_old(i,j)/muts(i,j))
633 a_field(i,k,j) = a_field(i,k,j)*(mu_old(i,j)/muts(i,j))
634 a_mu_tend(i,j) = a_mu_tend(i,j)-a_mu_old(i,j)*dt
635 a_muts(i,j) = a_muts(i,j)+a_mu_old(i,j)
636 a_mu_old(i,j) = 0.
637 end do
638 end do
639 end do
640 endif
641 field(:,:,:) = fieldh(:,:,:)
642 if (jts-jbs .lt. spec_zone) then
643 do j = jts, min(jtf,jbs+spec_zone-1)
644 b_dist = j-jbs
645 ! recompute : b_dist
646 do k = kts, ktf
647 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
648 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
649 ! recompute : mu_old
650 a_field_tend(i,k,j) = a_field_tend(i,k,j)+a_field(i,k,j)*(dt/muts(i,j))
651 a_mu_old(i,j) = a_mu_old(i,j)+a_field(i,k,j)*(field(i,k,j)/muts(i,j)+ph_save(i,k,j)/muts(i,j))
652 a_muts(i,j) = a_muts(i,j)+a_field(i,k,j)*((-(field(i,k,j)*mu_old(i,j)/(muts(i,j)*muts(i,j))))-dt*field_tend(i,k,j)/(muts(i,&
653 &j)*muts(i,j))-ph_save(i,k,j)*(mu_old(i,j)/(muts(i,j)*muts(i,j))))
654 a_ph_save(i,k,j) = a_ph_save(i,k,j)+a_field(i,k,j)*((-1)+mu_old(i,j)/muts(i,j))
655 a_field(i,k,j) = a_field(i,k,j)*(mu_old(i,j)/muts(i,j))
656 a_mu_tend(i,j) = a_mu_tend(i,j)-a_mu_old(i,j)*dt
657 a_muts(i,j) = a_muts(i,j)+a_mu_old(i,j)
658 a_mu_old(i,j) = 0.
659 end do
660 end do
661 end do
662 endif
663
664 !----------------------------------------------
665 ! FREE DYNAMIC MEMORY
666 !----------------------------------------------
667
668 end subroutine a_spec_bdyupdate_ph
669
670
671 end module a_module_bc_em
672
673