module_bc_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_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 g_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 g_relax_bdy_dry( config_flags, ru_tendf, g_ru_tendf, rv_tendf, g_rv_tendf, ph_tendf, g_ph_tendf, t_tendf, g_t_tendf, &
46 &rw_tendf, g_rw_tendf, mu_tend, g_mu_tend, ru, g_ru, rv, g_rv, ph, g_ph, t, g_t, w, g_w, mu, g_mu, mut, g_mut, u_b, g_u_b, v_b, &
47 &g_v_b, ph_b, g_ph_b, t_b, g_t_b, w_b, g_w_b, mu_b, g_mu_b, u_bt, g_u_bt, v_bt, g_v_bt, ph_bt, g_ph_bt, t_bt, g_t_bt, w_bt, g_w_bt,&
48 & mu_bt, g_mu_bt, spec_bdy_width, spec_zone, relax_zone, dtbc, fcx, gcx, ijds, ijde, ids, ide, jds, jde, kds, kde, ims, ime, jms, &
49 &jme, kms, kme, its, ite, jts, jte, kts, kte )
50 !******************************************************************
51 !******************************************************************
52 !** This routine was generated by Automatic differentiation. **
53 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
54 !******************************************************************
55 !******************************************************************
56 !==============================================
57 ! all entries are defined explicitly
58 !==============================================
59 implicit none
60
61 !==============================================
62 ! declare arguments
63 !==============================================
64 type (grid_config_rec_type) config_flags
65 real, intent(in) :: dtbc
66 integer, intent(in) :: spec_bdy_width
67 real, intent(in) :: fcx(spec_bdy_width)
68 integer, intent(in) :: ime
69 integer, intent(in) :: ims
70 integer, intent(in) :: jme
71 integer, intent(in) :: jms
72 real, intent(in) :: g_mu(ims:ime,jms:jme)
73 integer, intent(in) :: ijde
74 integer, intent(in) :: ijds
75 real, intent(in) :: g_mu_b(ijds:ijde,1:1,spec_bdy_width,4)
76 real, intent(in) :: g_mu_bt(ijds:ijde,1:1,spec_bdy_width,4)
77 real, intent(inout) :: g_mu_tend(ims:ime,jms:jme)
78 real, intent(in) :: g_mut(ims:ime,jms:jme)
79 integer, intent(in) :: kme
80 integer, intent(in) :: kms
81 real, intent(in) :: g_ph(ims:ime,kms:kme,jms:jme)
82 integer, intent(in) :: kde
83 integer, intent(in) :: kds
84 real, intent(in) :: g_ph_b(ijds:ijde,kds:kde,spec_bdy_width,4)
85 real, intent(in) :: g_ph_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
86 real, intent(inout) :: g_ph_tendf(ims:ime,kms:kme,jms:jme)
87 real, intent(in) :: g_ru(ims:ime,kms:kme,jms:jme)
88 real, intent(inout) :: g_ru_tendf(ims:ime,kms:kme,jms:jme)
89 real, intent(in) :: g_rv(ims:ime,kms:kme,jms:jme)
90 real, intent(inout) :: g_rv_tendf(ims:ime,kms:kme,jms:jme)
91 real, intent(inout) :: g_rw_tendf(ims:ime,kms:kme,jms:jme)
92 real, intent(in) :: g_t(ims:ime,kms:kme,jms:jme)
93 real, intent(in) :: g_t_b(ijds:ijde,kds:kde,spec_bdy_width,4)
94 real, intent(in) :: g_t_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
95 real, intent(inout) :: g_t_tendf(ims:ime,kms:kme,jms:jme)
96 real, intent(in) :: g_u_b(ijds:ijde,kds:kde,spec_bdy_width,4)
97 real, intent(in) :: g_u_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
98 real, intent(in) :: g_v_b(ijds:ijde,kds:kde,spec_bdy_width,4)
99 real, intent(in) :: g_v_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
100 real, intent(in) :: g_w(ims:ime,kms:kme,jms:jme)
101 real, intent(in) :: g_w_b(ijds:ijde,kds:kde,spec_bdy_width,4)
102 real, intent(in) :: g_w_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
103 real, intent(in) :: gcx(spec_bdy_width)
104 integer, intent(in) :: ide
105 integer, intent(in) :: ids
106 integer, intent(in) :: ite
107 integer, intent(in) :: its
108 integer, intent(in) :: jde
109 integer, intent(in) :: jds
110 integer, intent(in) :: jte
111 integer, intent(in) :: jts
112 integer, intent(in) :: kte
113 integer, intent(in) :: kts
114 real, intent(in) :: mu(ims:ime,jms:jme)
115 real, intent(in) :: mu_b(ijds:ijde,1:1,spec_bdy_width,4)
116 real, intent(in) :: mu_bt(ijds:ijde,1:1,spec_bdy_width,4)
117 real, intent(inout) :: mu_tend(ims:ime,jms:jme)
118 real, intent(in) :: mut(ims:ime,jms:jme)
119 real, intent(in) :: ph(ims:ime,kms:kme,jms:jme)
120 real, intent(in) :: ph_b(ijds:ijde,kds:kde,spec_bdy_width,4)
121 real, intent(in) :: ph_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
122 real, intent(inout) :: ph_tendf(ims:ime,kms:kme,jms:jme)
123 integer, intent(in) :: relax_zone
124 real, intent(in) :: ru(ims:ime,kms:kme,jms:jme)
125 real, intent(inout) :: ru_tendf(ims:ime,kms:kme,jms:jme)
126 real, intent(in) :: rv(ims:ime,kms:kme,jms:jme)
127 real, intent(inout) :: rv_tendf(ims:ime,kms:kme,jms:jme)
128 real, intent(inout) :: rw_tendf(ims:ime,kms:kme,jms:jme)
129 integer, intent(in) :: spec_zone
130 real, intent(in) :: t(ims:ime,kms:kme,jms:jme)
131 real, intent(in) :: t_b(ijds:ijde,kds:kde,spec_bdy_width,4)
132 real, intent(in) :: t_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
133 real, intent(inout) :: t_tendf(ims:ime,kms:kme,jms:jme)
134 real, intent(in) :: u_b(ijds:ijde,kds:kde,spec_bdy_width,4)
135 real, intent(in) :: u_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
136 real, intent(in) :: v_b(ijds:ijde,kds:kde,spec_bdy_width,4)
137 real, intent(in) :: v_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
138 real, intent(in) :: w(ims:ime,kms:kme,jms:jme)
139 real, intent(in) :: w_b(ijds:ijde,kds:kde,spec_bdy_width,4)
140 real, intent(in) :: w_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
141
142 !==============================================
143 ! declare local variables
144 !==============================================
145 real g_rfield(ims:ime,kms:kme,jms:jme)
146 integer i
147 integer i_end
148 integer i_start
149 integer j
150 integer j_end
151 integer j_start
152 integer k
153 real rfield(ims:ime,kms:kme,jms:jme)
154
155 !----------------------------------------------
156 ! TANGENT LINEAR AND FUNCTION STATEMENTS
157 !----------------------------------------------
158 call g_relax_bdytend( ru,g_ru,ru_tendf,g_ru_tendf,u_b,g_u_b,u_bt,g_u_bt,'u',spec_bdy_width,spec_zone,relax_zone,dtbc,fcx,gcx,ijds,&
159 &ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
160 call g_relax_bdytend( rv,g_rv,rv_tendf,g_rv_tendf,v_b,g_v_b,v_bt,g_v_bt,'v',spec_bdy_width,spec_zone,relax_zone,dtbc,fcx,gcx,ijds,&
161 &ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
162 i_start = max(its-1,ids)
163 i_end = min(ite+1,ide-1)
164 j_start = max(jts-1,jds)
165 j_end = min(jte+1,jde-1)
166 do j = j_start, j_end
167 do k = kts, kte
168 do i = i_start, i_end
169 g_rfield(i,k,j) = g_mut(i,j)*ph(i,k,j)+g_ph(i,k,j)*mut(i,j)
170 rfield(i,k,j) = ph(i,k,j)*mut(i,j)
171 end do
172 end do
173 end do
174 call g_relax_bdytend( rfield,g_rfield,ph_tendf,g_ph_tendf,ph_b,g_ph_b,ph_bt,g_ph_bt,'h',spec_bdy_width,spec_zone,relax_zone,dtbc,&
175 &fcx,gcx,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
176 do j = j_start, j_end
177 do k = kts, kte-1
178 do i = i_start, i_end
179 g_rfield(i,k,j) = g_mut(i,j)*t(i,k,j)+g_t(i,k,j)*mut(i,j)
180 rfield(i,k,j) = t(i,k,j)*mut(i,j)
181 end do
182 end do
183 end do
184 call g_relax_bdytend( rfield,g_rfield,t_tendf,g_t_tendf,t_b,g_t_b,t_bt,g_t_bt,'t',spec_bdy_width,spec_zone,relax_zone,dtbc,fcx,gcx,&
185 &ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
186 call g_relax_bdytend( mu,g_mu,mu_tend,g_mu_tend,mu_b,g_mu_b,mu_bt,g_mu_bt,'m',spec_bdy_width,spec_zone,relax_zone,dtbc,fcx,gcx,&
187 &ijds,ijde,ids,ide,jds,jde,1,1,ims,ime,jms,jme,1,1,its,ite,jts,jte,1,1 )
188 if (config_flags%nested) then
189 i_start = max(its-1,ids)
190 i_end = min(ite+1,ide-1)
191 j_start = max(jts-1,jds)
192 j_end = min(jte+1,jde-1)
193 do j = j_start, j_end
194 do k = kts, kte
195 do i = i_start, i_end
196 g_rfield(i,k,j) = g_mut(i,j)*w(i,k,j)+g_w(i,k,j)*mut(i,j)
197 rfield(i,k,j) = w(i,k,j)*mut(i,j)
198 end do
199 end do
200 end do
201 call g_relax_bdytend( rfield,g_rfield,rw_tendf,g_rw_tendf,w_b,g_w_b,w_bt,g_w_bt,'h',spec_bdy_width,spec_zone,relax_zone,dtbc,fcx,&
202 &gcx,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
203 endif
204
205 end subroutine g_relax_bdy_dry
206
207
208 subroutine g_spec_bdy_dry( config_flags, ru_tend, g_ru_tend, rv_tend, g_rv_tend, ph_tend, g_ph_tend, t_tend, g_t_tend, rw_tend, &
209 &g_rw_tend, mu_tend, g_mu_tend, u_bt, g_u_bt, v_bt, g_v_bt, ph_bt, g_ph_bt, t_bt, g_t_bt, w_bt, g_w_bt, mu_bt, g_mu_bt, &
210 &spec_bdy_width, spec_zone, ijds, ijde, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
211 !******************************************************************
212 !******************************************************************
213 !** This routine was generated by Automatic differentiation. **
214 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
215 !******************************************************************
216 !******************************************************************
217 !==============================================
218 ! all entries are defined explicitly
219 !==============================================
220 implicit none
221
222 !==============================================
223 ! declare arguments
224 !==============================================
225 type (grid_config_rec_type) config_flags
226 integer, intent(in) :: ijde
227 integer, intent(in) :: ijds
228 integer, intent(in) :: spec_bdy_width
229 real, intent(in) :: g_mu_bt(ijds:ijde,1:1,spec_bdy_width,4)
230 integer, intent(in) :: ime
231 integer, intent(in) :: ims
232 integer, intent(in) :: jme
233 integer, intent(in) :: jms
234 real, intent(out) :: g_mu_tend(ims:ime,jms:jme)
235 integer, intent(in) :: kde
236 integer, intent(in) :: kds
237 real, intent(in) :: g_ph_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
238 integer, intent(in) :: kme
239 integer, intent(in) :: kms
240 real, intent(out) :: g_ph_tend(ims:ime,kms:kme,jms:jme)
241 real, intent(out) :: g_ru_tend(ims:ime,kms:kme,jms:jme)
242 real, intent(out) :: g_rv_tend(ims:ime,kms:kme,jms:jme)
243 real, intent(out) :: g_rw_tend(ims:ime,kms:kme,jms:jme)
244 real, intent(in) :: g_t_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
245 real, intent(out) :: g_t_tend(ims:ime,kms:kme,jms:jme)
246 real, intent(in) :: g_u_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
247 real, intent(in) :: g_v_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
248 real, intent(in) :: g_w_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
249 integer, intent(in) :: ide
250 integer, intent(in) :: ids
251 integer, intent(in) :: ite
252 integer, intent(in) :: its
253 integer, intent(in) :: jde
254 integer, intent(in) :: jds
255 integer, intent(in) :: jte
256 integer, intent(in) :: jts
257 integer, intent(in) :: kte
258 integer, intent(in) :: kts
259 real, intent(in) :: mu_bt(ijds:ijde,1:1,spec_bdy_width,4)
260 real, intent(out) :: mu_tend(ims:ime,jms:jme)
261 real, intent(in) :: ph_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
262 real, intent(out) :: ph_tend(ims:ime,kms:kme,jms:jme)
263 real, intent(out) :: ru_tend(ims:ime,kms:kme,jms:jme)
264 real, intent(out) :: rv_tend(ims:ime,kms:kme,jms:jme)
265 real, intent(out) :: rw_tend(ims:ime,kms:kme,jms:jme)
266 integer, intent(in) :: spec_zone
267 real, intent(in) :: t_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
268 real, intent(out) :: t_tend(ims:ime,kms:kme,jms:jme)
269 real, intent(in) :: u_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
270 real, intent(in) :: v_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
271 real, intent(in) :: w_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
272
273 !----------------------------------------------
274 ! TANGENT LINEAR AND FUNCTION STATEMENTS
275 !----------------------------------------------
276 call g_spec_bdytend( ru_tend,g_ru_tend,u_bt,g_u_bt,'u',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,&
277 &kms,kme,its,ite,jts,jte,kts,kte )
278 call g_spec_bdytend( rv_tend,g_rv_tend,v_bt,g_v_bt,'v',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,&
279 &kms,kme,its,ite,jts,jte,kts,kte )
280 call g_spec_bdytend( ph_tend,g_ph_tend,ph_bt,g_ph_bt,'h',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,&
281 &jme,kms,kme,its,ite,jts,jte,kts,kte )
282 call g_spec_bdytend( t_tend,g_t_tend,t_bt,g_t_bt,'t',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,&
283 &kms,kme,its,ite,jts,jte,kts,kte )
284 call g_spec_bdytend( mu_tend,g_mu_tend,mu_bt,g_mu_bt,'m',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,1,1,ims,ime,jms,jme,1,&
285 &1,its,ite,jts,jte,1,1 )
286 if (config_flags%nested) then
287 call g_spec_bdytend( rw_tend,g_rw_tend,w_bt,g_w_bt,'h',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,kds,kde,ims,ime,jms,&
288 &jme,kms,kme,its,ite,jts,jte,kts,kte )
289 endif
290
291 end subroutine g_spec_bdy_dry
292
293
294 subroutine g_spec_bdy_scalar( scalar_tend, g_scalar_tend, scalar_bt, g_scalar_bt, spec_bdy_width, spec_zone, ijds, ijde, ids, ide, &
295 &jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
296 !******************************************************************
297 !******************************************************************
298 !** This routine was generated by Automatic differentiation. **
299 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
300 !******************************************************************
301 !******************************************************************
302 !==============================================
303 ! all entries are defined explicitly
304 !==============================================
305 implicit none
306
307 !==============================================
308 ! declare arguments
309 !==============================================
310 integer, intent(in) :: ijde
311 integer, intent(in) :: ijds
312 integer, intent(in) :: kde
313 integer, intent(in) :: kds
314 integer, intent(in) :: spec_bdy_width
315 real, intent(in) :: g_scalar_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
316 integer, intent(in) :: ime
317 integer, intent(in) :: ims
318 integer, intent(in) :: jme
319 integer, intent(in) :: jms
320 integer, intent(in) :: kme
321 integer, intent(in) :: kms
322 real, intent(out) :: g_scalar_tend(ims:ime,kms:kme,jms:jme)
323 integer, intent(in) :: ide
324 integer, intent(in) :: ids
325 integer, intent(in) :: ite
326 integer, intent(in) :: its
327 integer, intent(in) :: jde
328 integer, intent(in) :: jds
329 integer, intent(in) :: jte
330 integer, intent(in) :: jts
331 integer, intent(in) :: kte
332 integer, intent(in) :: kts
333 real, intent(in) :: scalar_bt(ijds:ijde,kds:kde,spec_bdy_width,4)
334 real, intent(out) :: scalar_tend(ims:ime,kms:kme,jms:jme)
335 integer, intent(in) :: spec_zone
336
337 !----------------------------------------------
338 ! TANGENT LINEAR AND FUNCTION STATEMENTS
339 !----------------------------------------------
340 call g_spec_bdytend( scalar_tend,g_scalar_tend,scalar_bt,g_scalar_bt,'q',spec_bdy_width,spec_zone,ijds,ijde,ids,ide,jds,jde,kds,&
341 &kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
342
343 end subroutine g_spec_bdy_scalar
344
345
346 subroutine g_spec_bdyupdate_ph( ph_save, g_ph_save, field, g_field, field_tend, g_field_tend, mu_tend, g_mu_tend, muts, g_muts, dt,&
347 & variable_in, spec_zone, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
348 !******************************************************************
349 !******************************************************************
350 !** This routine was generated by Automatic differentiation. **
351 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
352 !******************************************************************
353 !******************************************************************
354 !==============================================
355 ! all entries are defined explicitly
356 !==============================================
357 implicit none
358
359 !==============================================
360 ! declare arguments
361 !==============================================
362 real, intent(in) :: dt
363 integer, intent(in) :: ime
364 integer, intent(in) :: ims
365 integer, intent(in) :: jme
366 integer, intent(in) :: jms
367 integer, intent(in) :: kme
368 integer, intent(in) :: kms
369 real, intent(inout) :: field(ims:ime,kms:kme,jms:jme)
370 real, intent(in) :: field_tend(ims:ime,kms:kme,jms:jme)
371 real, intent(inout) :: g_field(ims:ime,kms:kme,jms:jme)
372 real, intent(in) :: g_field_tend(ims:ime,kms:kme,jms:jme)
373 real, intent(in) :: g_mu_tend(ims:ime,jms:jme)
374 real, intent(in) :: g_muts(ims:ime,jms:jme)
375 real, intent(in) :: g_ph_save(ims:ime,kms:kme,jms:jme)
376 integer, intent(in) :: ide
377 integer, intent(in) :: ids
378 integer, intent(in) :: ite
379 integer, intent(in) :: its
380 integer, intent(in) :: jde
381 integer, intent(in) :: jds
382 integer, intent(in) :: jte
383 integer, intent(in) :: jts
384 integer, intent(in) :: kde
385 integer, intent(in) :: kte
386 integer, intent(in) :: kts
387 real, intent(in) :: mu_tend(ims:ime,jms:jme)
388 real, intent(in) :: muts(ims:ime,jms:jme)
389 real, intent(in) :: ph_save(ims:ime,kms:kme,jms:jme)
390 integer, intent(in) :: spec_zone
391 character, intent(in) :: variable_in
392
393 !==============================================
394 ! declare local variables
395 !==============================================
396 integer b_dist
397 real g_mu_old(its:ite,jts:jte)
398 integer i
399 integer ibe
400 integer ibs
401 integer itf
402 integer j
403 integer jbe
404 integer jbs
405 integer jtf
406 integer k
407 integer ktf
408 real mu_old(its:ite,jts:jte)
409 character variable
410
411 !----------------------------------------------
412 ! TANGENT LINEAR AND FUNCTION STATEMENTS
413 !----------------------------------------------
414 variable = variable_in
415 if (variable .eq. 'U') then
416 variable = 'u'
417 endif
418 if (variable .eq. 'V') then
419 variable = 'v'
420 endif
421 if (variable .eq. 'M') then
422 variable = 'm'
423 endif
424 if (variable .eq. 'H') then
425 variable = 'h'
426 endif
427 ibs = ids
428 ibe = ide-1
429 itf = min(ite,ide-1)
430 jbs = jds
431 jbe = jde-1
432 jtf = min(jte,jde-1)
433 ktf = kde-1
434 if (variable .eq. 'u') then
435 ibe = ide
436 endif
437 if (variable .eq. 'u') then
438 itf = min(ite,ide)
439 endif
440 if (variable .eq. 'v') then
441 jbe = jde
442 endif
443 if (variable .eq. 'v') then
444 jtf = min(jte,jde)
445 endif
446 if (variable .eq. 'm') then
447 ktf = kte
448 endif
449 if (variable .eq. 'h') then
450 ktf = kte
451 endif
452 if (jts-jbs .lt. spec_zone) then
453 do j = jts, min(jtf,jbs+spec_zone-1)
454 b_dist = j-jbs
455 do k = kts, ktf
456 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
457 g_mu_old(i,j) = (-(g_mu_tend(i,j)*dt))+g_muts(i,j)
458 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
459 g_field(i,k,j) = g_field(i,k,j)*(mu_old(i,j)/muts(i,j))+g_field_tend(i,k,j)*(dt/muts(i,j))+g_mu_old(i,j)*(field(i,k,j)/&
460 &muts(i,j)+ph_save(i,k,j)/muts(i,j))+g_muts(i,j)*((-(field(i,k,j)*mu_old(i,j)/(muts(i,j)*muts(i,j))))-dt*field_tend(i,k,j)/&
461 &(muts(i,j)*muts(i,j))-ph_save(i,k,j)*(mu_old(i,j)/(muts(i,j)*muts(i,j))))+g_ph_save(i,k,j)*((-1)+mu_old(i,j)/muts(i,j))
462 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.)
463 end do
464 end do
465 end do
466 endif
467 if (jbe-jtf .lt. spec_zone) then
468 do j = max(jts,jbe-spec_zone+1), jtf
469 b_dist = jbe-j
470 do k = kts, ktf
471 do i = max(its,b_dist+ibs), min(itf,ibe-b_dist)
472 g_mu_old(i,j) = (-(g_mu_tend(i,j)*dt))+g_muts(i,j)
473 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
474 g_field(i,k,j) = g_field(i,k,j)*(mu_old(i,j)/muts(i,j))+g_field_tend(i,k,j)*(dt/muts(i,j))+g_mu_old(i,j)*(field(i,k,j)/&
475 &muts(i,j)+ph_save(i,k,j)/muts(i,j))+g_muts(i,j)*((-(field(i,k,j)*mu_old(i,j)/(muts(i,j)*muts(i,j))))-dt*field_tend(i,k,j)/&
476 &(muts(i,j)*muts(i,j))-ph_save(i,k,j)*(mu_old(i,j)/(muts(i,j)*muts(i,j))))+g_ph_save(i,k,j)*((-1)+mu_old(i,j)/muts(i,j))
477 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.)
478 end do
479 end do
480 end do
481 endif
482 if (its-ibs .lt. spec_zone) then
483 do i = its, min(itf,ibs+spec_zone-1)
484 b_dist = i-ibs
485 do k = kts, ktf
486 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
487 g_mu_old(i,j) = (-(g_mu_tend(i,j)*dt))+g_muts(i,j)
488 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
489 g_field(i,k,j) = g_field(i,k,j)*(mu_old(i,j)/muts(i,j))+g_field_tend(i,k,j)*(dt/muts(i,j))+g_mu_old(i,j)*(field(i,k,j)/&
490 &muts(i,j)+ph_save(i,k,j)/muts(i,j))+g_muts(i,j)*((-(field(i,k,j)*mu_old(i,j)/(muts(i,j)*muts(i,j))))-dt*field_tend(i,k,j)/&
491 &(muts(i,j)*muts(i,j))-ph_save(i,k,j)*(mu_old(i,j)/(muts(i,j)*muts(i,j))))+g_ph_save(i,k,j)*((-1)+mu_old(i,j)/muts(i,j))
492 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.)
493 end do
494 end do
495 end do
496 endif
497 if (ibe-itf .lt. spec_zone) then
498 do i = max(its,ibe-spec_zone+1), itf
499 b_dist = ibe-i
500 do k = kts, ktf
501 do j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
502 g_mu_old(i,j) = (-(g_mu_tend(i,j)*dt))+g_muts(i,j)
503 mu_old(i,j) = muts(i,j)-dt*mu_tend(i,j)
504 g_field(i,k,j) = g_field(i,k,j)*(mu_old(i,j)/muts(i,j))+g_field_tend(i,k,j)*(dt/muts(i,j))+g_mu_old(i,j)*(field(i,k,j)/&
505 &muts(i,j)+ph_save(i,k,j)/muts(i,j))+g_muts(i,j)*((-(field(i,k,j)*mu_old(i,j)/(muts(i,j)*muts(i,j))))-dt*field_tend(i,k,j)/&
506 &(muts(i,j)*muts(i,j))-ph_save(i,k,j)*(mu_old(i,j)/(muts(i,j)*muts(i,j))))+g_ph_save(i,k,j)*((-1)+mu_old(i,j)/muts(i,j))
507 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.)
508 end do
509 end do
510 end do
511 endif
512
513 end subroutine g_spec_bdyupdate_ph
514
515
516 end module g_module_bc_em
517
518