module_bc_ad.F
References to this file elsewhere.
1 ! DISCLAIMER
2 !
3 ! This file was generated by TAF version 1.7.22
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
24 !******************************************************************
25 !******************************************************************
26 !** This routine was generated by Automatic differentiation. **
27 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.22 **
28 !******************************************************************
29 !******************************************************************
30 !==============================================
31 ! referencing used modules
32 !==============================================
33 use module_configure
34 use module_wrf_error
35 use module_bc
36
37 !==============================================
38 ! all entries are defined explicitly
39 !==============================================
40 implicit none
41
42 contains
43 subroutine a_relax_bdytend( a_field, a_field_tend, a_field_bdy, a_field_bdy_tend, variable_in, spec_bdy_width, spec_zone, &
44 &relax_zone, dtbc, fcx, gcx, ijds, ijde, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
45 !******************************************************************
46 !******************************************************************
47 !** This routine was generated by Automatic differentiation. **
48 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.22 **
49 !******************************************************************
50 !******************************************************************
51 !==============================================
52 ! all entries are defined explicitly
53 !==============================================
54 implicit none
55
56 !==============================================
57 ! declare arguments
58 !==============================================
59 integer, intent(in) :: ime
60 integer, intent(in) :: ims
61 integer, intent(in) :: jme
62 integer, intent(in) :: jms
63 integer, intent(in) :: kme
64 integer, intent(in) :: kms
65 real, intent(inout) :: a_field(ims:ime,kms:kme,jms:jme)
66 integer, intent(in) :: ijde
67 integer, intent(in) :: ijds
68 integer, intent(in) :: kde
69 integer, intent(in) :: kds
70 integer, intent(in) :: spec_bdy_width
71 real, intent(inout) :: a_field_bdy(ijds:ijde,kds:kde,spec_bdy_width,4)
72 real, intent(inout) :: a_field_bdy_tend(ijds:ijde,kds:kde,spec_bdy_width,4)
73 real, intent(inout) :: a_field_tend(ims:ime,kms:kme,jms:jme)
74 real, intent(in) :: dtbc
75 real, intent(in) :: fcx(spec_bdy_width)
76 real, intent(in) :: gcx(spec_bdy_width)
77 integer, intent(in) :: ide
78 integer, intent(in) :: ids
79 integer, intent(in) :: ite
80 integer, intent(in) :: its
81 integer, intent(in) :: jde
82 integer, intent(in) :: jds
83 integer, intent(in) :: jte
84 integer, intent(in) :: jts
85 integer, intent(in) :: kte
86 integer, intent(in) :: kts
87 integer, intent(in) :: relax_zone
88 integer, intent(in) :: spec_zone
89 character, intent(in) :: variable_in
90
91 !==============================================
92 ! declare local variables
93 !==============================================
94 real a_fls0
95 real a_fls1
96 real a_fls2
97 real a_fls3
98 real a_fls4
99 integer b_dist
100 integer i
101 integer ibe
102 integer ibs
103 integer itf
104 integer j
105 integer jbe
106 integer jbs
107 integer jtf
108 integer k
109 integer ktf
110 character variable
111
112 !----------------------------------------------
113 ! RESET LOCAL ADJOINT VARIABLES
114 !----------------------------------------------
115 a_fls0 = 0.
116 a_fls1 = 0.
117 a_fls2 = 0.
118 a_fls3 = 0.
119 a_fls4 = 0.
120
121 !----------------------------------------------
122 ! ROUTINE BODY
123 !----------------------------------------------
124 variable = variable_in
125 ! recompute : variable
126 if (variable .eq. 'U') then
127 variable = 'u'
128 endif
129 ! recompute : variable
130 if (variable .eq. 'V') then
131 variable = 'v'
132 endif
133 ! recompute : variable
134 if (variable .eq. 'M') then
135 variable = 'm'
136 endif
137 ! recompute : variable
138 if (variable .eq. 'H') then
139 variable = 'h'
140 endif
141 ! recompute : variable
142 ibs = ids
143 ! recompute : ibs
144 ibe = ide-1
145 ! recompute : ibe
146 itf = min(ite,ide-1)
147 ! recompute : itf
148 jbs = jds
149 ! recompute : jbs
150 jbe = jde-1
151 ! recompute : jbe
152 jtf = min(jte,jde-1)
153 ! recompute : jtf
154 ktf = kde-1
155 ! recompute : ktf
156 if (variable .eq. 'u') then
157 ibe = ide
158 endif
159 ! recompute : ibe
160 if (variable .eq. 'u') then
161 itf = min(ite,ide)
162 endif
163 ! recompute : itf
164 if (variable .eq. 'v') then
165 jbe = jde
166 endif
167 ! recompute : jbe
168 if (variable .eq. 'v') then
169 jtf = min(jte,jde)
170 endif
171 ! recompute : jtf
172 if (variable .eq. 'm') then
173 ktf = kte
174 endif
175 ! recompute : ktf
176 if (variable .eq. 'h') then
177 ktf = kte
178 endif
179 ! recompute : ktf
180 if (ibe-itf .lt. relax_zone) then
181 do i = max(its,ibe-relax_zone+1), min(itf,ibe-spec_zone)
182 a_fls0 = 0.
183 a_fls1 = 0.
184 a_fls2 = 0.
185 a_fls3 = 0.
186 a_fls4 = 0.
187 b_dist = ibe-i
188 ! recompute : b_dist
189 do k = kts, ktf
190 a_fls0 = 0.
191 a_fls1 = 0.
192 a_fls2 = 0.
193 a_fls3 = 0.
194 a_fls4 = 0.
195 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
196 a_fls0 = 0.
197 a_fls1 = 0.
198 a_fls2 = 0.
199 a_fls3 = 0.
200 a_fls4 = 0.
201 a_fls0 = a_fls0+a_field_tend(i,k,j)*(fcx(b_dist+1)-(-4)*gcx(b_dist+1))
202 a_fls1 = a_fls1-a_field_tend(i,k,j)*gcx(b_dist+1)
203 a_fls2 = a_fls2-a_field_tend(i,k,j)*gcx(b_dist+1)
204 a_fls3 = a_fls3-a_field_tend(i,k,j)*gcx(b_dist+1)
205 a_fls4 = a_fls4-a_field_tend(i,k,j)*gcx(b_dist+1)
206 a_field(i-1,k,j) = a_field(i-1,k,j)-a_fls4
207 a_field_bdy(j,k,b_dist+2,p_xeb) = a_field_bdy(j,k,b_dist+2,p_xeb)+a_fls4
208 a_field_bdy_tend(j,k,b_dist+2,p_xeb) = a_field_bdy_tend(j,k,b_dist+2,p_xeb)+a_fls4*dtbc
209 a_fls4 = 0.
210 a_field(i+1,k,j) = a_field(i+1,k,j)-a_fls3
211 a_field_bdy(j,k,b_dist,p_xeb) = a_field_bdy(j,k,b_dist,p_xeb)+a_fls3
212 a_field_bdy_tend(j,k,b_dist,p_xeb) = a_field_bdy_tend(j,k,b_dist,p_xeb)+a_fls3*dtbc
213 a_fls3 = 0.
214 a_field(i,k,j+1) = a_field(i,k,j+1)-a_fls2
215 a_field_bdy(j+1,k,b_dist+1,p_xeb) = a_field_bdy(j+1,k,b_dist+1,p_xeb)+a_fls2
216 a_field_bdy_tend(j+1,k,b_dist+1,p_xeb) = a_field_bdy_tend(j+1,k,b_dist+1,p_xeb)+a_fls2*dtbc
217 a_fls2 = 0.
218 a_field(i,k,j-1) = a_field(i,k,j-1)-a_fls1
219 a_field_bdy(j-1,k,b_dist+1,p_xeb) = a_field_bdy(j-1,k,b_dist+1,p_xeb)+a_fls1
220 a_field_bdy_tend(j-1,k,b_dist+1,p_xeb) = a_field_bdy_tend(j-1,k,b_dist+1,p_xeb)+a_fls1*dtbc
221 a_fls1 = 0.
222 a_field(i,k,j) = a_field(i,k,j)-a_fls0
223 a_field_bdy(j,k,b_dist+1,p_xeb) = a_field_bdy(j,k,b_dist+1,p_xeb)+a_fls0
224 a_field_bdy_tend(j,k,b_dist+1,p_xeb) = a_field_bdy_tend(j,k,b_dist+1,p_xeb)+a_fls0*dtbc
225 a_fls0 = 0.
226 end do
227 end do
228 end do
229 endif
230 if (its-ibs .lt. relax_zone) then
231 do i = max(its,ibs+spec_zone), min(itf,ibs+relax_zone-1)
232 a_fls0 = 0.
233 a_fls1 = 0.
234 a_fls2 = 0.
235 a_fls3 = 0.
236 a_fls4 = 0.
237 b_dist = i-ibs
238 ! recompute : b_dist
239 do k = kts, ktf
240 a_fls0 = 0.
241 a_fls1 = 0.
242 a_fls2 = 0.
243 a_fls3 = 0.
244 a_fls4 = 0.
245 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
246 a_fls0 = 0.
247 a_fls1 = 0.
248 a_fls2 = 0.
249 a_fls3 = 0.
250 a_fls4 = 0.
251 a_fls0 = a_fls0+a_field_tend(i,k,j)*(fcx(b_dist+1)-(-4)*gcx(b_dist+1))
252 a_fls1 = a_fls1-a_field_tend(i,k,j)*gcx(b_dist+1)
253 a_fls2 = a_fls2-a_field_tend(i,k,j)*gcx(b_dist+1)
254 a_fls3 = a_fls3-a_field_tend(i,k,j)*gcx(b_dist+1)
255 a_fls4 = a_fls4-a_field_tend(i,k,j)*gcx(b_dist+1)
256 a_field(i+1,k,j) = a_field(i+1,k,j)-a_fls4
257 a_field_bdy(j,k,b_dist+2,p_xsb) = a_field_bdy(j,k,b_dist+2,p_xsb)+a_fls4
258 a_field_bdy_tend(j,k,b_dist+2,p_xsb) = a_field_bdy_tend(j,k,b_dist+2,p_xsb)+a_fls4*dtbc
259 a_fls4 = 0.
260 a_field(i-1,k,j) = a_field(i-1,k,j)-a_fls3
261 a_field_bdy(j,k,b_dist,p_xsb) = a_field_bdy(j,k,b_dist,p_xsb)+a_fls3
262 a_field_bdy_tend(j,k,b_dist,p_xsb) = a_field_bdy_tend(j,k,b_dist,p_xsb)+a_fls3*dtbc
263 a_fls3 = 0.
264 a_field(i,k,j+1) = a_field(i,k,j+1)-a_fls2
265 a_field_bdy(j+1,k,b_dist+1,p_xsb) = a_field_bdy(j+1,k,b_dist+1,p_xsb)+a_fls2
266 a_field_bdy_tend(j+1,k,b_dist+1,p_xsb) = a_field_bdy_tend(j+1,k,b_dist+1,p_xsb)+a_fls2*dtbc
267 a_fls2 = 0.
268 a_field(i,k,j-1) = a_field(i,k,j-1)-a_fls1
269 a_field_bdy(j-1,k,b_dist+1,p_xsb) = a_field_bdy(j-1,k,b_dist+1,p_xsb)+a_fls1
270 a_field_bdy_tend(j-1,k,b_dist+1,p_xsb) = a_field_bdy_tend(j-1,k,b_dist+1,p_xsb)+a_fls1*dtbc
271 a_fls1 = 0.
272 a_field(i,k,j) = a_field(i,k,j)-a_fls0
273 a_field_bdy(j,k,b_dist+1,p_xsb) = a_field_bdy(j,k,b_dist+1,p_xsb)+a_fls0
274 a_field_bdy_tend(j,k,b_dist+1,p_xsb) = a_field_bdy_tend(j,k,b_dist+1,p_xsb)+a_fls0*dtbc
275 a_fls0 = 0.
276 end do
277 end do
278 end do
279 endif
280 if (jbe-jtf .lt. relax_zone) then
281 do j = max(jts,jbe-relax_zone+1), min(jtf,jbe-spec_zone)
282 a_fls0 = 0.
283 a_fls1 = 0.
284 a_fls2 = 0.
285 a_fls3 = 0.
286 a_fls4 = 0.
287 b_dist = jbe-j
288 ! recompute : b_dist
289 do k = kts, ktf
290 a_fls0 = 0.
291 a_fls1 = 0.
292 a_fls2 = 0.
293 a_fls3 = 0.
294 a_fls4 = 0.
295 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
296 a_fls0 = 0.
297 a_fls1 = 0.
298 a_fls2 = 0.
299 a_fls3 = 0.
300 a_fls4 = 0.
301 a_fls0 = a_fls0+a_field_tend(i,k,j)*(fcx(b_dist+1)-(-4)*gcx(b_dist+1))
302 a_fls1 = a_fls1-a_field_tend(i,k,j)*gcx(b_dist+1)
303 a_fls2 = a_fls2-a_field_tend(i,k,j)*gcx(b_dist+1)
304 a_fls3 = a_fls3-a_field_tend(i,k,j)*gcx(b_dist+1)
305 a_fls4 = a_fls4-a_field_tend(i,k,j)*gcx(b_dist+1)
306 a_field(i,k,j-1) = a_field(i,k,j-1)-a_fls4
307 a_field_bdy(i,k,b_dist+2,p_yeb) = a_field_bdy(i,k,b_dist+2,p_yeb)+a_fls4
308 a_field_bdy_tend(i,k,b_dist+2,p_yeb) = a_field_bdy_tend(i,k,b_dist+2,p_yeb)+a_fls4*dtbc
309 a_fls4 = 0.
310 a_field(i,k,j+1) = a_field(i,k,j+1)-a_fls3
311 a_field_bdy(i,k,b_dist,p_yeb) = a_field_bdy(i,k,b_dist,p_yeb)+a_fls3
312 a_field_bdy_tend(i,k,b_dist,p_yeb) = a_field_bdy_tend(i,k,b_dist,p_yeb)+a_fls3*dtbc
313 a_fls3 = 0.
314 a_field(i+1,k,j) = a_field(i+1,k,j)-a_fls2
315 a_field_bdy(i+1,k,b_dist+1,p_yeb) = a_field_bdy(i+1,k,b_dist+1,p_yeb)+a_fls2
316 a_field_bdy_tend(i+1,k,b_dist+1,p_yeb) = a_field_bdy_tend(i+1,k,b_dist+1,p_yeb)+a_fls2*dtbc
317 a_fls2 = 0.
318 a_field(i-1,k,j) = a_field(i-1,k,j)-a_fls1
319 a_field_bdy(i-1,k,b_dist+1,p_yeb) = a_field_bdy(i-1,k,b_dist+1,p_yeb)+a_fls1
320 a_field_bdy_tend(i-1,k,b_dist+1,p_yeb) = a_field_bdy_tend(i-1,k,b_dist+1,p_yeb)+a_fls1*dtbc
321 a_fls1 = 0.
322 a_field(i,k,j) = a_field(i,k,j)-a_fls0
323 a_field_bdy(i,k,b_dist+1,p_yeb) = a_field_bdy(i,k,b_dist+1,p_yeb)+a_fls0
324 a_field_bdy_tend(i,k,b_dist+1,p_yeb) = a_field_bdy_tend(i,k,b_dist+1,p_yeb)+a_fls0*dtbc
325 a_fls0 = 0.
326 end do
327 end do
328 end do
329 endif
330 if (jts-jbs .lt. relax_zone) then
331 do j = max(jts,jbs+spec_zone), min(jtf,jbs+relax_zone-1)
332 a_fls0 = 0.
333 a_fls1 = 0.
334 a_fls2 = 0.
335 a_fls3 = 0.
336 a_fls4 = 0.
337 b_dist = j-jbs
338 ! recompute : b_dist
339 do k = kts, ktf
340 a_fls0 = 0.
341 a_fls1 = 0.
342 a_fls2 = 0.
343 a_fls3 = 0.
344 a_fls4 = 0.
345 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
346 a_fls0 = 0.
347 a_fls1 = 0.
348 a_fls2 = 0.
349 a_fls3 = 0.
350 a_fls4 = 0.
351 a_fls0 = a_fls0+a_field_tend(i,k,j)*(fcx(b_dist+1)-(-4)*gcx(b_dist+1))
352 a_fls1 = a_fls1-a_field_tend(i,k,j)*gcx(b_dist+1)
353 a_fls2 = a_fls2-a_field_tend(i,k,j)*gcx(b_dist+1)
354 a_fls3 = a_fls3-a_field_tend(i,k,j)*gcx(b_dist+1)
355 a_fls4 = a_fls4-a_field_tend(i,k,j)*gcx(b_dist+1)
356 a_field(i,k,j+1) = a_field(i,k,j+1)-a_fls4
357 a_field_bdy(i,k,b_dist+2,p_ysb) = a_field_bdy(i,k,b_dist+2,p_ysb)+a_fls4
358 a_field_bdy_tend(i,k,b_dist+2,p_ysb) = a_field_bdy_tend(i,k,b_dist+2,p_ysb)+a_fls4*dtbc
359 a_fls4 = 0.
360 a_field(i,k,j-1) = a_field(i,k,j-1)-a_fls3
361 a_field_bdy(i,k,b_dist,p_ysb) = a_field_bdy(i,k,b_dist,p_ysb)+a_fls3
362 a_field_bdy_tend(i,k,b_dist,p_ysb) = a_field_bdy_tend(i,k,b_dist,p_ysb)+a_fls3*dtbc
363 a_fls3 = 0.
364 a_field(i+1,k,j) = a_field(i+1,k,j)-a_fls2
365 a_field_bdy(i+1,k,b_dist+1,p_ysb) = a_field_bdy(i+1,k,b_dist+1,p_ysb)+a_fls2
366 a_field_bdy_tend(i+1,k,b_dist+1,p_ysb) = a_field_bdy_tend(i+1,k,b_dist+1,p_ysb)+a_fls2*dtbc
367 a_fls2 = 0.
368 a_field(i-1,k,j) = a_field(i-1,k,j)-a_fls1
369 a_field_bdy(i-1,k,b_dist+1,p_ysb) = a_field_bdy(i-1,k,b_dist+1,p_ysb)+a_fls1
370 a_field_bdy_tend(i-1,k,b_dist+1,p_ysb) = a_field_bdy_tend(i-1,k,b_dist+1,p_ysb)+a_fls1*dtbc
371 a_fls1 = 0.
372 a_field(i,k,j) = a_field(i,k,j)-a_fls0
373 a_field_bdy(i,k,b_dist+1,p_ysb) = a_field_bdy(i,k,b_dist+1,p_ysb)+a_fls0
374 a_field_bdy_tend(i,k,b_dist+1,p_ysb) = a_field_bdy_tend(i,k,b_dist+1,p_ysb)+a_fls0*dtbc
375 a_fls0 = 0.
376 end do
377 end do
378 end do
379 endif
380
381 end subroutine a_relax_bdytend
382
383
384 subroutine a_spec_bdytend( a_field_tend, a_field_bdy_tend, variable_in, spec_bdy_width, spec_zone, ijds, ijde, ids, ide, jds, jde, &
385 &kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
386 !******************************************************************
387 !******************************************************************
388 !** This routine was generated by Automatic differentiation. **
389 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.22 **
390 !******************************************************************
391 !******************************************************************
392 !==============================================
393 ! all entries are defined explicitly
394 !==============================================
395 implicit none
396
397 !==============================================
398 ! declare arguments
399 !==============================================
400 integer, intent(in) :: ijde
401 integer, intent(in) :: ijds
402 integer, intent(in) :: kde
403 integer, intent(in) :: kds
404 integer, intent(in) :: spec_bdy_width
405 real, intent(inout) :: a_field_bdy_tend(ijds:ijde,kds:kde,spec_bdy_width,4)
406 integer, intent(in) :: ime
407 integer, intent(in) :: ims
408 integer, intent(in) :: jme
409 integer, intent(in) :: jms
410 integer, intent(in) :: kme
411 integer, intent(in) :: kms
412 real, intent(inout) :: a_field_tend(ims:ime,kms:kme,jms:jme)
413 integer, intent(in) :: ide
414 integer, intent(in) :: ids
415 integer, intent(in) :: ite
416 integer, intent(in) :: its
417 integer, intent(in) :: jde
418 integer, intent(in) :: jds
419 integer, intent(in) :: jte
420 integer, intent(in) :: jts
421 integer, intent(in) :: kte
422 integer, intent(in) :: kts
423 integer, intent(in) :: spec_zone
424 character, intent(in) :: variable_in
425
426 !==============================================
427 ! declare local variables
428 !==============================================
429 integer b_dist
430 integer i
431 integer ibe
432 integer ibs
433 integer itf
434 integer j
435 integer jbe
436 integer jbs
437 integer jtf
438 integer k
439 integer ktf
440 character variable
441
442 !----------------------------------------------
443 ! ROUTINE BODY
444 !----------------------------------------------
445 variable = variable_in
446 ! recompute : variable
447 if (variable .eq. 'U') then
448 variable = 'u'
449 endif
450 ! recompute : variable
451 if (variable .eq. 'V') then
452 variable = 'v'
453 endif
454 ! recompute : variable
455 if (variable .eq. 'M') then
456 variable = 'm'
457 endif
458 ! recompute : variable
459 if (variable .eq. 'H') then
460 variable = 'h'
461 endif
462 ! recompute : variable
463 ibs = ids
464 ! recompute : ibs
465 ibe = ide-1
466 ! recompute : ibe
467 itf = min(ite,ide-1)
468 ! recompute : itf
469 jbs = jds
470 ! recompute : jbs
471 jbe = jde-1
472 ! recompute : jbe
473 jtf = min(jte,jde-1)
474 ! recompute : jtf
475 ktf = kde-1
476 ! recompute : ktf
477 if (variable .eq. 'u') then
478 ibe = ide
479 endif
480 ! recompute : ibe
481 if (variable .eq. 'u') then
482 itf = min(ite,ide)
483 endif
484 ! recompute : itf
485 if (variable .eq. 'v') then
486 jbe = jde
487 endif
488 ! recompute : jbe
489 if (variable .eq. 'v') then
490 jtf = min(jte,jde)
491 endif
492 ! recompute : jtf
493 if (variable .eq. 'm') then
494 ktf = kte
495 endif
496 ! recompute : ktf
497 if (variable .eq. 'h') then
498 ktf = kte
499 endif
500 ! recompute : ktf
501 if (ibe-itf .lt. spec_zone) then
502 do i = max(its,ibe-spec_zone+1), itf
503 b_dist = ibe-i
504 ! recompute : b_dist
505 do k = kts, ktf
506 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
507 a_field_bdy_tend(j,k,b_dist+1,p_xeb) = a_field_bdy_tend(j,k,b_dist+1,p_xeb)+a_field_tend(i,k,j)
508 a_field_tend(i,k,j) = 0.
509 end do
510 end do
511 end do
512 endif
513 if (its-ibs .lt. spec_zone) then
514 do i = its, min(itf,ibs+spec_zone-1)
515 b_dist = i-ibs
516 ! recompute : b_dist
517 do k = kts, ktf
518 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
519 a_field_bdy_tend(j,k,b_dist+1,p_xsb) = a_field_bdy_tend(j,k,b_dist+1,p_xsb)+a_field_tend(i,k,j)
520 a_field_tend(i,k,j) = 0.
521 end do
522 end do
523 end do
524 endif
525 if (jbe-jtf .lt. spec_zone) then
526 do j = max(jts,jbe-spec_zone+1), jtf
527 b_dist = jbe-j
528 ! recompute : b_dist
529 do k = kts, ktf
530 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
531 a_field_bdy_tend(i,k,b_dist+1,p_yeb) = a_field_bdy_tend(i,k,b_dist+1,p_yeb)+a_field_tend(i,k,j)
532 a_field_tend(i,k,j) = 0.
533 end do
534 end do
535 end do
536 endif
537 if (jts-jbs .lt. spec_zone) then
538 do j = jts, min(jtf,jbs+spec_zone-1)
539 b_dist = j-jbs
540 ! recompute : b_dist
541 do k = kts, ktf
542 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
543 a_field_bdy_tend(i,k,b_dist+1,p_ysb) = a_field_bdy_tend(i,k,b_dist+1,p_ysb)+a_field_tend(i,k,j)
544 a_field_tend(i,k,j) = 0.
545 end do
546 end do
547 end do
548 endif
549
550 end subroutine a_spec_bdytend
551
552
553 subroutine a_spec_bdyupdate( a_field, a_field_tend, dt, variable_in, spec_zone, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, &
554 &kme, its, ite, jts, jte, kts, kte )
555 !******************************************************************
556 !******************************************************************
557 !** This routine was generated by Automatic differentiation. **
558 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.22 **
559 !******************************************************************
560 !******************************************************************
561 !==============================================
562 ! all entries are defined explicitly
563 !==============================================
564 implicit none
565
566 !==============================================
567 ! declare arguments
568 !==============================================
569 integer, intent(in) :: ime
570 integer, intent(in) :: ims
571 integer, intent(in) :: jme
572 integer, intent(in) :: jms
573 integer, intent(in) :: kme
574 integer, intent(in) :: kms
575 real, intent(inout) :: a_field(ims:ime,kms:kme,jms:jme)
576 real, intent(inout) :: a_field_tend(ims:ime,kms:kme,jms:jme)
577 real, intent(in) :: dt
578 integer, intent(in) :: ide
579 integer, intent(in) :: ids
580 integer, intent(in) :: ite
581 integer, intent(in) :: its
582 integer, intent(in) :: jde
583 integer, intent(in) :: jds
584 integer, intent(in) :: jte
585 integer, intent(in) :: jts
586 integer, intent(in) :: kde
587 integer, intent(in) :: kte
588 integer, intent(in) :: kts
589 integer, intent(in) :: spec_zone
590 character, intent(in) :: variable_in
591
592 !==============================================
593 ! declare local variables
594 !==============================================
595 integer b_dist
596 integer i
597 integer ibe
598 integer ibs
599 integer itf
600 integer j
601 integer jbe
602 integer jbs
603 integer jtf
604 integer k
605 integer ktf
606 character variable
607
608 !----------------------------------------------
609 ! ROUTINE BODY
610 !----------------------------------------------
611 variable = variable_in
612 ! recompute : variable
613 if (variable .eq. 'U') then
614 variable = 'u'
615 endif
616 ! recompute : variable
617 if (variable .eq. 'V') then
618 variable = 'v'
619 endif
620 ! recompute : variable
621 if (variable .eq. 'M') then
622 variable = 'm'
623 endif
624 ! recompute : variable
625 if (variable .eq. 'H') then
626 variable = 'h'
627 endif
628 ! recompute : variable
629 ibs = ids
630 ! recompute : ibs
631 ibe = ide-1
632 ! recompute : ibe
633 itf = min(ite,ide-1)
634 ! recompute : itf
635 jbs = jds
636 ! recompute : jbs
637 jbe = jde-1
638 ! recompute : jbe
639 jtf = min(jte,jde-1)
640 ! recompute : jtf
641 ktf = kde-1
642 ! recompute : ktf
643 if (variable .eq. 'u') then
644 ibe = ide
645 endif
646 ! recompute : ibe
647 if (variable .eq. 'u') then
648 itf = min(ite,ide)
649 endif
650 ! recompute : itf
651 if (variable .eq. 'v') then
652 jbe = jde
653 endif
654 ! recompute : jbe
655 if (variable .eq. 'v') then
656 jtf = min(jte,jde)
657 endif
658 ! recompute : jtf
659 if (variable .eq. 'm') then
660 ktf = kte
661 endif
662 ! recompute : ktf
663 if (variable .eq. 'h') then
664 ktf = kte
665 endif
666 ! recompute : ktf
667 if (ibe-itf .lt. spec_zone) then
668 do i = max(its,ibe-spec_zone+1), itf
669 b_dist = ibe-i
670 ! recompute : b_dist
671 do k = kts, ktf
672 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
673 a_field_tend(i,k,j) = a_field_tend(i,k,j)+a_field(i,k,j)*dt
674 end do
675 end do
676 end do
677 endif
678 if (its-ibs .lt. spec_zone) then
679 do i = its, min(itf,ibs+spec_zone-1)
680 b_dist = i-ibs
681 ! recompute : b_dist
682 do k = kts, ktf
683 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
684 a_field_tend(i,k,j) = a_field_tend(i,k,j)+a_field(i,k,j)*dt
685 end do
686 end do
687 end do
688 endif
689 if (jbe-jtf .lt. spec_zone) then
690 do j = max(jts,jbe-spec_zone+1), jtf
691 b_dist = jbe-j
692 ! recompute : b_dist
693 do k = kts, ktf
694 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
695 a_field_tend(i,k,j) = a_field_tend(i,k,j)+a_field(i,k,j)*dt
696 end do
697 end do
698 end do
699 endif
700 if (jts-jbs .lt. spec_zone) then
701 do j = jts, min(jtf,jbs+spec_zone-1)
702 b_dist = j-jbs
703 ! recompute : b_dist
704 do k = kts, ktf
705 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
706 a_field_tend(i,k,j) = a_field_tend(i,k,j)+a_field(i,k,j)*dt
707 end do
708 end do
709 end do
710 endif
711
712 end subroutine a_spec_bdyupdate
713
714
715 subroutine a_zero_grad_bdy( a_field, variable_in, spec_zone, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, &
716 &jte, kts )
717 !******************************************************************
718 !******************************************************************
719 !** This routine was generated by Automatic differentiation. **
720 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.22 **
721 !******************************************************************
722 !******************************************************************
723 !==============================================
724 ! all entries are defined explicitly
725 !==============================================
726 implicit none
727
728 !==============================================
729 ! declare arguments
730 !==============================================
731 integer, intent(in) :: ime
732 integer, intent(in) :: ims
733 integer, intent(in) :: jme
734 integer, intent(in) :: jms
735 integer, intent(in) :: kme
736 integer, intent(in) :: kms
737 real, intent(inout) :: a_field(ims:ime,kms:kme,jms:jme)
738 integer, intent(in) :: ide
739 integer, intent(in) :: ids
740 integer, intent(in) :: ite
741 integer, intent(in) :: its
742 integer, intent(in) :: jde
743 integer, intent(in) :: jds
744 integer, intent(in) :: jte
745 integer, intent(in) :: jts
746 integer, intent(in) :: kde
747 integer, intent(in) :: kts
748 integer, intent(in) :: spec_zone
749 character, intent(in) :: variable_in
750
751 !==============================================
752 ! declare local variables
753 !==============================================
754 real a_fieldh
755 real a_fieldi
756 real a_fieldj
757 real a_fieldk
758 integer b_dist
759 integer i
760 integer i_inner
761 integer ibe
762 integer ibs
763 integer itf
764 integer j
765 integer j_inner
766 integer jbe
767 integer jbs
768 integer jtf
769 integer k
770 integer ktf
771 character variable
772
773 !----------------------------------------------
774 ! ROUTINE BODY
775 !----------------------------------------------
776 variable = variable_in
777 ! recompute : variable
778 if (variable .eq. 'U') then
779 variable = 'u'
780 endif
781 ! recompute : variable
782 if (variable .eq. 'V') then
783 variable = 'v'
784 endif
785 ! recompute : variable
786 ibs = ids
787 ! recompute : ibs
788 ibe = ide-1
789 ! recompute : ibe
790 itf = min(ite,ide-1)
791 ! recompute : itf
792 jbs = jds
793 ! recompute : jbs
794 jbe = jde-1
795 ! recompute : jbe
796 jtf = min(jte,jde-1)
797 ! recompute : jtf
798 ktf = kde-1
799 ! recompute : ktf
800 if (variable .eq. 'u') then
801 ibe = ide
802 endif
803 ! recompute : ibe
804 if (variable .eq. 'u') then
805 itf = min(ite,ide)
806 endif
807 ! recompute : itf
808 if (variable .eq. 'v') then
809 jbe = jde
810 endif
811 ! recompute : jbe
812 if (variable .eq. 'v') then
813 jtf = min(jte,jde)
814 endif
815 ! recompute : jtf
816 if (variable .eq. 'w') then
817 ktf = kde
818 endif
819 ! recompute : ktf
820 if (ibe-itf .lt. spec_zone) then
821 do i = itf, max(its,ibe-spec_zone+1), -1
822 b_dist = ibe-i
823 ! recompute : b_dist
824 do k = kts, ktf
825 do j = min(jtf,jbe-b_dist-1), max(jts,b_dist+jbs+1), -1
826 j_inner = max(j,jbs+spec_zone)
827 ! recompute : j_inner
828 j_inner = min(j_inner,jbe-spec_zone)
829 ! recompute : j_inner
830 a_fieldh = a_field(i,k,j)
831 a_field(i,k,j) = 0.
832 a_field(ibe-spec_zone,k,j_inner) = a_field(ibe-spec_zone,k,j_inner)+a_fieldh
833 end do
834 end do
835 end do
836 endif
837 if (its-ibs .lt. spec_zone) then
838 do i = min(itf,ibs+spec_zone-1), its, -1
839 b_dist = i-ibs
840 ! recompute : b_dist
841 do k = kts, ktf
842 do j = min(jtf,jbe-b_dist-1), max(jts,b_dist+jbs+1), -1
843 j_inner = max(j,jbs+spec_zone)
844 ! recompute : j_inner
845 j_inner = min(j_inner,jbe-spec_zone)
846 ! recompute : j_inner
847 a_fieldi = a_field(i,k,j)
848 a_field(i,k,j) = 0.
849 a_field(ibs+spec_zone,k,j_inner) = a_field(ibs+spec_zone,k,j_inner)+a_fieldi
850 end do
851 end do
852 end do
853 endif
854 if (jbe-jtf .lt. spec_zone) then
855 do j = jtf, max(jts,jbe-spec_zone+1), -1
856 b_dist = jbe-j
857 ! recompute : b_dist
858 do k = kts, ktf
859 do i = min(itf,ibe-b_dist), max(its,b_dist+ibs), -1
860 i_inner = max(i,ibs+spec_zone)
861 ! recompute : i_inner
862 i_inner = min(i_inner,ibe-spec_zone)
863 ! recompute : i_inner
864 a_fieldj = a_field(i,k,j)
865 a_field(i,k,j) = 0.
866 a_field(i_inner,k,jbe-spec_zone) = a_field(i_inner,k,jbe-spec_zone)+a_fieldj
867 end do
868 end do
869 end do
870 endif
871 if (jts-jbs .lt. spec_zone) then
872 do j = min(jtf,jbs+spec_zone-1), jts, -1
873 b_dist = j-jbs
874 ! recompute : b_dist
875 do k = kts, ktf
876 do i = min(itf,ibe-b_dist), max(its,b_dist+ibs), -1
877 i_inner = max(i,ibs+spec_zone)
878 ! recompute : i_inner
879 i_inner = min(i_inner,ibe-spec_zone)
880 ! recompute : i_inner
881 a_fieldk = a_field(i,k,j)
882 a_field(i,k,j) = 0.
883 a_field(i_inner,k,jbs+spec_zone) = a_field(i_inner,k,jbs+spec_zone)+a_fieldk
884 end do
885 end do
886 end do
887 endif
888
889 end subroutine a_zero_grad_bdy
890
891
892 end module a_module_bc
893
894