module_bc_tl.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 g_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 g_relax_bdytend( field, g_field, field_tend, g_field_tend, field_bdy, g_field_bdy, field_bdy_tend, g_field_bdy_tend, &
44 &variable_in, spec_bdy_width, spec_zone, relax_zone, dtbc, fcx, gcx, ijds, ijde, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, &
45 &kms, kme, its, ite, jts, jte, kts, kte )
46 !******************************************************************
47 !******************************************************************
48 !** This routine was generated by Automatic differentiation. **
49 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.22 **
50 !******************************************************************
51 !******************************************************************
52 !==============================================
53 ! all entries are defined explicitly
54 !==============================================
55 implicit none
56
57 !==============================================
58 ! declare arguments
59 !==============================================
60 real, intent(in) :: dtbc
61 integer, intent(in) :: spec_bdy_width
62 real, intent(in) :: fcx(spec_bdy_width)
63 integer, intent(in) :: ime
64 integer, intent(in) :: ims
65 integer, intent(in) :: jme
66 integer, intent(in) :: jms
67 integer, intent(in) :: kme
68 integer, intent(in) :: kms
69 real, intent(in) :: field(ims:ime,kms:kme,jms:jme)
70 integer, intent(in) :: ijde
71 integer, intent(in) :: ijds
72 integer, intent(in) :: kde
73 integer, intent(in) :: kds
74 real, intent(in) :: field_bdy(ijds:ijde,kds:kde,spec_bdy_width,4)
75 real, intent(in) :: field_bdy_tend(ijds:ijde,kds:kde,spec_bdy_width,4)
76 real, intent(inout) :: field_tend(ims:ime,kms:kme,jms:jme)
77 real, intent(in) :: g_field(ims:ime,kms:kme,jms:jme)
78 real, intent(in) :: g_field_bdy(ijds:ijde,kds:kde,spec_bdy_width,4)
79 real, intent(in) :: g_field_bdy_tend(ijds:ijde,kds:kde,spec_bdy_width,4)
80 real, intent(inout) :: g_field_tend(ims:ime,kms:kme,jms:jme)
81 real, intent(in) :: gcx(spec_bdy_width)
82 integer, intent(in) :: ide
83 integer, intent(in) :: ids
84 integer, intent(in) :: ite
85 integer, intent(in) :: its
86 integer, intent(in) :: jde
87 integer, intent(in) :: jds
88 integer, intent(in) :: jte
89 integer, intent(in) :: jts
90 integer, intent(in) :: kte
91 integer, intent(in) :: kts
92 integer, intent(in) :: relax_zone
93 integer, intent(in) :: spec_zone
94 character, intent(in) :: variable_in
95
96 !==============================================
97 ! declare local variables
98 !==============================================
99 integer b_dist
100 real fls0
101 real fls1
102 real fls2
103 real fls3
104 real fls4
105 real g_fls0
106 real g_fls1
107 real g_fls2
108 real g_fls3
109 real g_fls4
110 integer i
111 integer ibe
112 integer ibs
113 integer itf
114 integer j
115 integer jbe
116 integer jbs
117 integer jtf
118 integer k
119 integer ktf
120 character variable
121
122 !----------------------------------------------
123 ! TANGENT LINEAR AND FUNCTION STATEMENTS
124 !----------------------------------------------
125 variable = variable_in
126 if (variable .eq. 'U') then
127 variable = 'u'
128 endif
129 if (variable .eq. 'V') then
130 variable = 'v'
131 endif
132 if (variable .eq. 'M') then
133 variable = 'm'
134 endif
135 if (variable .eq. 'H') then
136 variable = 'h'
137 endif
138 ibs = ids
139 ibe = ide-1
140 itf = min(ite,ide-1)
141 jbs = jds
142 jbe = jde-1
143 jtf = min(jte,jde-1)
144 ktf = kde-1
145 if (variable .eq. 'u') then
146 ibe = ide
147 endif
148 if (variable .eq. 'u') then
149 itf = min(ite,ide)
150 endif
151 if (variable .eq. 'v') then
152 jbe = jde
153 endif
154 if (variable .eq. 'v') then
155 jtf = min(jte,jde)
156 endif
157 if (variable .eq. 'm') then
158 ktf = kte
159 endif
160 if (variable .eq. 'h') then
161 ktf = kte
162 endif
163 if (jts-jbs .lt. relax_zone) then
164 do j = max(jts,jbs+spec_zone), min(jtf,jbs+relax_zone-1)
165 b_dist = j-jbs
166 do k = kts, ktf
167 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
168 g_fls0 = (-g_field(i,k,j))+g_field_bdy(i,k,b_dist+1,p_ysb)+g_field_bdy_tend(i,k,b_dist+1,p_ysb)*dtbc
169 fls0 = field_bdy(i,k,b_dist+1,p_ysb)+dtbc*field_bdy_tend(i,k,b_dist+1,p_ysb)-field(i,k,j)
170 g_fls1 = (-g_field(i-1,k,j))+g_field_bdy(i-1,k,b_dist+1,p_ysb)+g_field_bdy_tend(i-1,k,b_dist+1,p_ysb)*dtbc
171 fls1 = field_bdy(i-1,k,b_dist+1,p_ysb)+dtbc*field_bdy_tend(i-1,k,b_dist+1,p_ysb)-field(i-1,k,j)
172 g_fls2 = (-g_field(i+1,k,j))+g_field_bdy(i+1,k,b_dist+1,p_ysb)+g_field_bdy_tend(i+1,k,b_dist+1,p_ysb)*dtbc
173 fls2 = field_bdy(i+1,k,b_dist+1,p_ysb)+dtbc*field_bdy_tend(i+1,k,b_dist+1,p_ysb)-field(i+1,k,j)
174 g_fls3 = (-g_field(i,k,j-1))+g_field_bdy(i,k,b_dist,p_ysb)+g_field_bdy_tend(i,k,b_dist,p_ysb)*dtbc
175 fls3 = field_bdy(i,k,b_dist,p_ysb)+dtbc*field_bdy_tend(i,k,b_dist,p_ysb)-field(i,k,j-1)
176 g_fls4 = (-g_field(i,k,j+1))+g_field_bdy(i,k,b_dist+2,p_ysb)+g_field_bdy_tend(i,k,b_dist+2,p_ysb)*dtbc
177 fls4 = field_bdy(i,k,b_dist+2,p_ysb)+dtbc*field_bdy_tend(i,k,b_dist+2,p_ysb)-field(i,k,j+1)
178 g_field_tend(i,k,j) = g_field_tend(i,k,j)+g_fls0*(fcx(b_dist+1)-(-4)*gcx(b_dist+1))-g_fls1*gcx(b_dist+1)-g_fls2*gcx(b_dist+&
179 &1)-g_fls3*gcx(b_dist+1)-g_fls4*gcx(b_dist+1)
180 field_tend(i,k,j) = field_tend(i,k,j)+fcx(b_dist+1)*fls0-gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
181 end do
182 end do
183 end do
184 endif
185 if (jbe-jtf .lt. relax_zone) then
186 do j = max(jts,jbe-relax_zone+1), min(jtf,jbe-spec_zone)
187 b_dist = jbe-j
188 do k = kts, ktf
189 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
190 g_fls0 = (-g_field(i,k,j))+g_field_bdy(i,k,b_dist+1,p_yeb)+g_field_bdy_tend(i,k,b_dist+1,p_yeb)*dtbc
191 fls0 = field_bdy(i,k,b_dist+1,p_yeb)+dtbc*field_bdy_tend(i,k,b_dist+1,p_yeb)-field(i,k,j)
192 g_fls1 = (-g_field(i-1,k,j))+g_field_bdy(i-1,k,b_dist+1,p_yeb)+g_field_bdy_tend(i-1,k,b_dist+1,p_yeb)*dtbc
193 fls1 = field_bdy(i-1,k,b_dist+1,p_yeb)+dtbc*field_bdy_tend(i-1,k,b_dist+1,p_yeb)-field(i-1,k,j)
194 g_fls2 = (-g_field(i+1,k,j))+g_field_bdy(i+1,k,b_dist+1,p_yeb)+g_field_bdy_tend(i+1,k,b_dist+1,p_yeb)*dtbc
195 fls2 = field_bdy(i+1,k,b_dist+1,p_yeb)+dtbc*field_bdy_tend(i+1,k,b_dist+1,p_yeb)-field(i+1,k,j)
196 g_fls3 = (-g_field(i,k,j+1))+g_field_bdy(i,k,b_dist,p_yeb)+g_field_bdy_tend(i,k,b_dist,p_yeb)*dtbc
197 fls3 = field_bdy(i,k,b_dist,p_yeb)+dtbc*field_bdy_tend(i,k,b_dist,p_yeb)-field(i,k,j+1)
198 g_fls4 = (-g_field(i,k,j-1))+g_field_bdy(i,k,b_dist+2,p_yeb)+g_field_bdy_tend(i,k,b_dist+2,p_yeb)*dtbc
199 fls4 = field_bdy(i,k,b_dist+2,p_yeb)+dtbc*field_bdy_tend(i,k,b_dist+2,p_yeb)-field(i,k,j-1)
200 g_field_tend(i,k,j) = g_field_tend(i,k,j)+g_fls0*(fcx(b_dist+1)-(-4)*gcx(b_dist+1))-g_fls1*gcx(b_dist+1)-g_fls2*gcx(b_dist+&
201 &1)-g_fls3*gcx(b_dist+1)-g_fls4*gcx(b_dist+1)
202 field_tend(i,k,j) = field_tend(i,k,j)+fcx(b_dist+1)*fls0-gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
203 end do
204 end do
205 end do
206 endif
207 if (its-ibs .lt. relax_zone) then
208 do i = max(its,ibs+spec_zone), min(itf,ibs+relax_zone-1)
209 b_dist = i-ibs
210 do k = kts, ktf
211 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
212 g_fls0 = (-g_field(i,k,j))+g_field_bdy(j,k,b_dist+1,p_xsb)+g_field_bdy_tend(j,k,b_dist+1,p_xsb)*dtbc
213 fls0 = field_bdy(j,k,b_dist+1,p_xsb)+dtbc*field_bdy_tend(j,k,b_dist+1,p_xsb)-field(i,k,j)
214 g_fls1 = (-g_field(i,k,j-1))+g_field_bdy(j-1,k,b_dist+1,p_xsb)+g_field_bdy_tend(j-1,k,b_dist+1,p_xsb)*dtbc
215 fls1 = field_bdy(j-1,k,b_dist+1,p_xsb)+dtbc*field_bdy_tend(j-1,k,b_dist+1,p_xsb)-field(i,k,j-1)
216 g_fls2 = (-g_field(i,k,j+1))+g_field_bdy(j+1,k,b_dist+1,p_xsb)+g_field_bdy_tend(j+1,k,b_dist+1,p_xsb)*dtbc
217 fls2 = field_bdy(j+1,k,b_dist+1,p_xsb)+dtbc*field_bdy_tend(j+1,k,b_dist+1,p_xsb)-field(i,k,j+1)
218 g_fls3 = (-g_field(i-1,k,j))+g_field_bdy(j,k,b_dist,p_xsb)+g_field_bdy_tend(j,k,b_dist,p_xsb)*dtbc
219 fls3 = field_bdy(j,k,b_dist,p_xsb)+dtbc*field_bdy_tend(j,k,b_dist,p_xsb)-field(i-1,k,j)
220 g_fls4 = (-g_field(i+1,k,j))+g_field_bdy(j,k,b_dist+2,p_xsb)+g_field_bdy_tend(j,k,b_dist+2,p_xsb)*dtbc
221 fls4 = field_bdy(j,k,b_dist+2,p_xsb)+dtbc*field_bdy_tend(j,k,b_dist+2,p_xsb)-field(i+1,k,j)
222 g_field_tend(i,k,j) = g_field_tend(i,k,j)+g_fls0*(fcx(b_dist+1)-(-4)*gcx(b_dist+1))-g_fls1*gcx(b_dist+1)-g_fls2*gcx(b_dist+&
223 &1)-g_fls3*gcx(b_dist+1)-g_fls4*gcx(b_dist+1)
224 field_tend(i,k,j) = field_tend(i,k,j)+fcx(b_dist+1)*fls0-gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
225 end do
226 end do
227 end do
228 endif
229 if (ibe-itf .lt. relax_zone) then
230 do i = max(its,ibe-relax_zone+1), min(itf,ibe-spec_zone)
231 b_dist = ibe-i
232 do k = kts, ktf
233 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
234 g_fls0 = (-g_field(i,k,j))+g_field_bdy(j,k,b_dist+1,p_xeb)+g_field_bdy_tend(j,k,b_dist+1,p_xeb)*dtbc
235 fls0 = field_bdy(j,k,b_dist+1,p_xeb)+dtbc*field_bdy_tend(j,k,b_dist+1,p_xeb)-field(i,k,j)
236 g_fls1 = (-g_field(i,k,j-1))+g_field_bdy(j-1,k,b_dist+1,p_xeb)+g_field_bdy_tend(j-1,k,b_dist+1,p_xeb)*dtbc
237 fls1 = field_bdy(j-1,k,b_dist+1,p_xeb)+dtbc*field_bdy_tend(j-1,k,b_dist+1,p_xeb)-field(i,k,j-1)
238 g_fls2 = (-g_field(i,k,j+1))+g_field_bdy(j+1,k,b_dist+1,p_xeb)+g_field_bdy_tend(j+1,k,b_dist+1,p_xeb)*dtbc
239 fls2 = field_bdy(j+1,k,b_dist+1,p_xeb)+dtbc*field_bdy_tend(j+1,k,b_dist+1,p_xeb)-field(i,k,j+1)
240 g_fls3 = (-g_field(i+1,k,j))+g_field_bdy(j,k,b_dist,p_xeb)+g_field_bdy_tend(j,k,b_dist,p_xeb)*dtbc
241 fls3 = field_bdy(j,k,b_dist,p_xeb)+dtbc*field_bdy_tend(j,k,b_dist,p_xeb)-field(i+1,k,j)
242 g_fls4 = (-g_field(i-1,k,j))+g_field_bdy(j,k,b_dist+2,p_xeb)+g_field_bdy_tend(j,k,b_dist+2,p_xeb)*dtbc
243 fls4 = field_bdy(j,k,b_dist+2,p_xeb)+dtbc*field_bdy_tend(j,k,b_dist+2,p_xeb)-field(i-1,k,j)
244 g_field_tend(i,k,j) = g_field_tend(i,k,j)+g_fls0*(fcx(b_dist+1)-(-4)*gcx(b_dist+1))-g_fls1*gcx(b_dist+1)-g_fls2*gcx(b_dist+&
245 &1)-g_fls3*gcx(b_dist+1)-g_fls4*gcx(b_dist+1)
246 field_tend(i,k,j) = field_tend(i,k,j)+fcx(b_dist+1)*fls0-gcx(b_dist+1)*(fls1+fls2+fls3+fls4-4.*fls0)
247 end do
248 end do
249 end do
250 endif
251
252 end subroutine g_relax_bdytend
253
254
255 subroutine g_spec_bdytend( field_tend, g_field_tend, field_bdy_tend, g_field_bdy_tend, variable_in, spec_bdy_width, spec_zone, &
256 &ijds, ijde, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
257 !******************************************************************
258 !******************************************************************
259 !** This routine was generated by Automatic differentiation. **
260 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.22 **
261 !******************************************************************
262 !******************************************************************
263 !==============================================
264 ! all entries are defined explicitly
265 !==============================================
266 implicit none
267
268 !==============================================
269 ! declare arguments
270 !==============================================
271 integer, intent(in) :: ijde
272 integer, intent(in) :: ijds
273 integer, intent(in) :: kde
274 integer, intent(in) :: kds
275 integer, intent(in) :: spec_bdy_width
276 real, intent(in) :: field_bdy_tend(ijds:ijde,kds:kde,spec_bdy_width,4)
277 integer, intent(in) :: ime
278 integer, intent(in) :: ims
279 integer, intent(in) :: jme
280 integer, intent(in) :: jms
281 integer, intent(in) :: kme
282 integer, intent(in) :: kms
283 real, intent(out) :: field_tend(ims:ime,kms:kme,jms:jme)
284 real, intent(in) :: g_field_bdy_tend(ijds:ijde,kds:kde,spec_bdy_width,4)
285 real, intent(out) :: g_field_tend(ims:ime,kms:kme,jms:jme)
286 integer, intent(in) :: ide
287 integer, intent(in) :: ids
288 integer, intent(in) :: ite
289 integer, intent(in) :: its
290 integer, intent(in) :: jde
291 integer, intent(in) :: jds
292 integer, intent(in) :: jte
293 integer, intent(in) :: jts
294 integer, intent(in) :: kte
295 integer, intent(in) :: kts
296 integer, intent(in) :: spec_zone
297 character, intent(in) :: variable_in
298
299 !==============================================
300 ! declare local variables
301 !==============================================
302 integer b_dist
303 integer i
304 integer ibe
305 integer ibs
306 integer itf
307 integer j
308 integer jbe
309 integer jbs
310 integer jtf
311 integer k
312 integer ktf
313 character variable
314
315 !----------------------------------------------
316 ! TANGENT LINEAR AND FUNCTION STATEMENTS
317 !----------------------------------------------
318 variable = variable_in
319 if (variable .eq. 'U') then
320 variable = 'u'
321 endif
322 if (variable .eq. 'V') then
323 variable = 'v'
324 endif
325 if (variable .eq. 'M') then
326 variable = 'm'
327 endif
328 if (variable .eq. 'H') then
329 variable = 'h'
330 endif
331 ibs = ids
332 ibe = ide-1
333 itf = min(ite,ide-1)
334 jbs = jds
335 jbe = jde-1
336 jtf = min(jte,jde-1)
337 ktf = kde-1
338 if (variable .eq. 'u') then
339 ibe = ide
340 endif
341 if (variable .eq. 'u') then
342 itf = min(ite,ide)
343 endif
344 if (variable .eq. 'v') then
345 jbe = jde
346 endif
347 if (variable .eq. 'v') then
348 jtf = min(jte,jde)
349 endif
350 if (variable .eq. 'm') then
351 ktf = kte
352 endif
353 if (variable .eq. 'h') then
354 ktf = kte
355 endif
356 if (jts-jbs .lt. spec_zone) then
357 do j = jts, min(jtf,jbs+spec_zone-1)
358 b_dist = j-jbs
359 do k = kts, ktf
360 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
361 g_field_tend(i,k,j) = g_field_bdy_tend(i,k,b_dist+1,p_ysb)
362 field_tend(i,k,j) = field_bdy_tend(i,k,b_dist+1,p_ysb)
363 end do
364 end do
365 end do
366 endif
367 if (jbe-jtf .lt. spec_zone) then
368 do j = max(jts,jbe-spec_zone+1), jtf
369 b_dist = jbe-j
370 do k = kts, ktf
371 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
372 g_field_tend(i,k,j) = g_field_bdy_tend(i,k,b_dist+1,p_yeb)
373 field_tend(i,k,j) = field_bdy_tend(i,k,b_dist+1,p_yeb)
374 end do
375 end do
376 end do
377 endif
378 if (its-ibs .lt. spec_zone) then
379 do i = its, min(itf,ibs+spec_zone-1)
380 b_dist = i-ibs
381 do k = kts, ktf
382 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
383 g_field_tend(i,k,j) = g_field_bdy_tend(j,k,b_dist+1,p_xsb)
384 field_tend(i,k,j) = field_bdy_tend(j,k,b_dist+1,p_xsb)
385 end do
386 end do
387 end do
388 endif
389 if (ibe-itf .lt. spec_zone) then
390 do i = max(its,ibe-spec_zone+1), itf
391 b_dist = ibe-i
392 do k = kts, ktf
393 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
394 g_field_tend(i,k,j) = g_field_bdy_tend(j,k,b_dist+1,p_xeb)
395 field_tend(i,k,j) = field_bdy_tend(j,k,b_dist+1,p_xeb)
396 end do
397 end do
398 end do
399 endif
400
401 end subroutine g_spec_bdytend
402
403
404 subroutine g_spec_bdyupdate( field, g_field, field_tend, g_field_tend, dt, variable_in, spec_zone, ids, ide, jds, jde, kde, ims, &
405 &ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
406 !******************************************************************
407 !******************************************************************
408 !** This routine was generated by Automatic differentiation. **
409 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.22 **
410 !******************************************************************
411 !******************************************************************
412 !==============================================
413 ! all entries are defined explicitly
414 !==============================================
415 implicit none
416
417 !==============================================
418 ! declare arguments
419 !==============================================
420 real, intent(in) :: dt
421 integer, intent(in) :: ime
422 integer, intent(in) :: ims
423 integer, intent(in) :: jme
424 integer, intent(in) :: jms
425 integer, intent(in) :: kme
426 integer, intent(in) :: kms
427 real, intent(inout) :: field(ims:ime,kms:kme,jms:jme)
428 real, intent(in) :: field_tend(ims:ime,kms:kme,jms:jme)
429 real, intent(inout) :: g_field(ims:ime,kms:kme,jms:jme)
430 real, intent(in) :: g_field_tend(ims:ime,kms:kme,jms:jme)
431 integer, intent(in) :: ide
432 integer, intent(in) :: ids
433 integer, intent(in) :: ite
434 integer, intent(in) :: its
435 integer, intent(in) :: jde
436 integer, intent(in) :: jds
437 integer, intent(in) :: jte
438 integer, intent(in) :: jts
439 integer, intent(in) :: kde
440 integer, intent(in) :: kte
441 integer, intent(in) :: kts
442 integer, intent(in) :: spec_zone
443 character, intent(in) :: variable_in
444
445 !==============================================
446 ! declare local variables
447 !==============================================
448 integer b_dist
449 integer i
450 integer ibe
451 integer ibs
452 integer itf
453 integer j
454 integer jbe
455 integer jbs
456 integer jtf
457 integer k
458 integer ktf
459 character variable
460
461 !----------------------------------------------
462 ! TANGENT LINEAR AND FUNCTION STATEMENTS
463 !----------------------------------------------
464 variable = variable_in
465 if (variable .eq. 'U') then
466 variable = 'u'
467 endif
468 if (variable .eq. 'V') then
469 variable = 'v'
470 endif
471 if (variable .eq. 'M') then
472 variable = 'm'
473 endif
474 if (variable .eq. 'H') then
475 variable = 'h'
476 endif
477 ibs = ids
478 ibe = ide-1
479 itf = min(ite,ide-1)
480 jbs = jds
481 jbe = jde-1
482 jtf = min(jte,jde-1)
483 ktf = kde-1
484 if (variable .eq. 'u') then
485 ibe = ide
486 endif
487 if (variable .eq. 'u') then
488 itf = min(ite,ide)
489 endif
490 if (variable .eq. 'v') then
491 jbe = jde
492 endif
493 if (variable .eq. 'v') then
494 jtf = min(jte,jde)
495 endif
496 if (variable .eq. 'm') then
497 ktf = kte
498 endif
499 if (variable .eq. 'h') then
500 ktf = kte
501 endif
502 if (jts-jbs .lt. spec_zone) then
503 do j = jts, min(jtf,jbs+spec_zone-1)
504 b_dist = j-jbs
505 do k = kts, ktf
506 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
507 g_field(i,k,j) = g_field(i,k,j)+g_field_tend(i,k,j)*dt
508 field(i,k,j) = field(i,k,j)+dt*field_tend(i,k,j)
509 end do
510 end do
511 end do
512 endif
513 if (jbe-jtf .lt. spec_zone) then
514 do j = max(jts,jbe-spec_zone+1), jtf
515 b_dist = jbe-j
516 do k = kts, ktf
517 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
518 g_field(i,k,j) = g_field(i,k,j)+g_field_tend(i,k,j)*dt
519 field(i,k,j) = field(i,k,j)+dt*field_tend(i,k,j)
520 end do
521 end do
522 end do
523 endif
524 if (its-ibs .lt. spec_zone) then
525 do i = its, min(itf,ibs+spec_zone-1)
526 b_dist = i-ibs
527 do k = kts, ktf
528 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
529 g_field(i,k,j) = g_field(i,k,j)+g_field_tend(i,k,j)*dt
530 field(i,k,j) = field(i,k,j)+dt*field_tend(i,k,j)
531 end do
532 end do
533 end do
534 endif
535 if (ibe-itf .lt. spec_zone) then
536 do i = max(its,ibe-spec_zone+1), itf
537 b_dist = ibe-i
538 do k = kts, ktf
539 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
540 g_field(i,k,j) = g_field(i,k,j)+g_field_tend(i,k,j)*dt
541 field(i,k,j) = field(i,k,j)+dt*field_tend(i,k,j)
542 end do
543 end do
544 end do
545 endif
546
547 end subroutine g_spec_bdyupdate
548
549
550 subroutine g_zero_grad_bdy( field, g_field, variable_in, spec_zone, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, &
551 &ite, jts, jte, kts )
552 !******************************************************************
553 !******************************************************************
554 !** This routine was generated by Automatic differentiation. **
555 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.22 **
556 !******************************************************************
557 !******************************************************************
558 !==============================================
559 ! all entries are defined explicitly
560 !==============================================
561 implicit none
562
563 !==============================================
564 ! declare arguments
565 !==============================================
566 integer, intent(in) :: ime
567 integer, intent(in) :: ims
568 integer, intent(in) :: jme
569 integer, intent(in) :: jms
570 integer, intent(in) :: kme
571 integer, intent(in) :: kms
572 real, intent(inout) :: field(ims:ime,kms:kme,jms:jme)
573 real, intent(inout) :: g_field(ims:ime,kms:kme,jms:jme)
574 integer, intent(in) :: ide
575 integer, intent(in) :: ids
576 integer, intent(in) :: ite
577 integer, intent(in) :: its
578 integer, intent(in) :: jde
579 integer, intent(in) :: jds
580 integer, intent(in) :: jte
581 integer, intent(in) :: jts
582 integer, intent(in) :: kde
583 integer, intent(in) :: kts
584 integer, intent(in) :: spec_zone
585 character, intent(in) :: variable_in
586
587 !==============================================
588 ! declare local variables
589 !==============================================
590 integer b_dist
591 integer i
592 integer i_inner
593 integer ibe
594 integer ibs
595 integer itf
596 integer j
597 integer j_inner
598 integer jbe
599 integer jbs
600 integer jtf
601 integer k
602 integer ktf
603 character variable
604
605 !----------------------------------------------
606 ! TANGENT LINEAR AND FUNCTION STATEMENTS
607 !----------------------------------------------
608 variable = variable_in
609 if (variable .eq. 'U') then
610 variable = 'u'
611 endif
612 if (variable .eq. 'V') then
613 variable = 'v'
614 endif
615 ibs = ids
616 ibe = ide-1
617 itf = min(ite,ide-1)
618 jbs = jds
619 jbe = jde-1
620 jtf = min(jte,jde-1)
621 ktf = kde-1
622 if (variable .eq. 'u') then
623 ibe = ide
624 endif
625 if (variable .eq. 'u') then
626 itf = min(ite,ide)
627 endif
628 if (variable .eq. 'v') then
629 jbe = jde
630 endif
631 if (variable .eq. 'v') then
632 jtf = min(jte,jde)
633 endif
634 if (variable .eq. 'w') then
635 ktf = kde
636 endif
637 if (jts-jbs .lt. spec_zone) then
638 do j = jts, min(jtf,jbs+spec_zone-1)
639 b_dist = j-jbs
640 do k = kts, ktf
641 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
642 i_inner = max(i,ibs+spec_zone)
643 i_inner = min(i_inner,ibe-spec_zone)
644 g_field(i,k,j) = g_field(i_inner,k,jbs+spec_zone)
645 field(i,k,j) = field(i_inner,k,jbs+spec_zone)
646 end do
647 end do
648 end do
649 endif
650 if (jbe-jtf .lt. spec_zone) then
651 do j = max(jts,jbe-spec_zone+1), jtf
652 b_dist = jbe-j
653 do k = kts, ktf
654 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
655 i_inner = max(i,ibs+spec_zone)
656 i_inner = min(i_inner,ibe-spec_zone)
657 g_field(i,k,j) = g_field(i_inner,k,jbe-spec_zone)
658 field(i,k,j) = field(i_inner,k,jbe-spec_zone)
659 end do
660 end do
661 end do
662 endif
663 if (its-ibs .lt. spec_zone) then
664 do i = its, min(itf,ibs+spec_zone-1)
665 b_dist = i-ibs
666 do k = kts, ktf
667 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
668 j_inner = max(j,jbs+spec_zone)
669 j_inner = min(j_inner,jbe-spec_zone)
670 g_field(i,k,j) = g_field(ibs+spec_zone,k,j_inner)
671 field(i,k,j) = field(ibs+spec_zone,k,j_inner)
672 end do
673 end do
674 end do
675 endif
676 if (ibe-itf .lt. spec_zone) then
677 do i = max(its,ibe-spec_zone+1), itf
678 b_dist = ibe-i
679 do k = kts, ktf
680 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
681 j_inner = max(j,jbs+spec_zone)
682 j_inner = min(j_inner,jbe-spec_zone)
683 g_field(i,k,j) = g_field(ibe-spec_zone,k,j_inner)
684 field(i,k,j) = field(ibe-spec_zone,k,j_inner)
685 end do
686 end do
687 end do
688 endif
689
690 end subroutine g_zero_grad_bdy
691
692
693 end module g_module_bc
694
695