| blob | 9fe52975d2d07c01f70793321087f641fd53ebd2 |
2 !WRF:MODEL_LAYER:BOUNDARY
3 !
4 MODULE module_bc_em
6 USE module_bc, ONLY: set_physical_bc2d, set_physical_bc3d, spec_bdytend, &
7 spec_bdytend_perturb, relax_bdytend_tile, relax_bdytend, &
8 spec_bdytend_perturb_chem
9 USE module_configure, ONLY: grid_config_rec_type
10 USE module_wrf_error
11 USE module_model_constants, ONLY: R_d, R_v, T0
13 CONTAINS
15 !------------------------------------------------------------------------
17 SUBROUTINE spec_bdyupdate_ph( ph_save, field, &
18 field_tend, mu_tend, muts, &
19 c1, c2, dt, &
20 variable_in, config_flags, &
21 spec_zone, &
22 ids,ide, jds,jde, kds,kde, & ! domain dims
23 ims,ime, jms,jme, kms,kme, & ! memory dims
24 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
25 its,ite, jts,jte, kts,kte )
27 ! This subroutine adds the tendencies in the boundary specified region.
28 ! spec_zone is the width of the outer specified b.c.s that are set here.
29 ! (JD August 2000)
31 IMPLICIT NONE
33 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
34 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
35 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
36 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
37 INTEGER, INTENT(IN ) :: spec_zone
38 CHARACTER, INTENT(IN ) :: variable_in
39 REAL, INTENT(IN ) :: dt
42 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
43 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: field_tend, ph_save
44 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: mu_tend, muts
45 REAL, DIMENSION( kms:kme ), INTENT(IN ) :: c1, c2
46 TYPE( grid_config_rec_type ) config_flags
48 CHARACTER :: variable
49 INTEGER :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
50 INTEGER :: b_dist, b_limit
52 ! Local array
54 REAL, DIMENSION( its:ite , jts:jte ) :: mu_old
55 LOGICAL :: periodic_x
57 periodic_x = config_flags%periodic_x
59 variable = variable_in
61 IF (variable == 'U') variable = 'u'
62 IF (variable == 'V') variable = 'v'
63 IF (variable == 'M') variable = 'm'
64 IF (variable == 'H') variable = 'h'
66 ibs = ids
67 ibe = ide-1
68 itf = min(ite,ide-1)
69 jbs = jds
70 jbe = jde-1
71 jtf = min(jte,jde-1)
72 ktf = kde-1
73 IF (variable == 'u') ibe = ide
74 IF (variable == 'u') itf = min(ite,ide)
75 IF (variable == 'v') jbe = jde
76 IF (variable == 'v') jtf = min(jte,jde)
77 IF (variable == 'm') ktf = kte
78 IF (variable == 'h') ktf = kte
80 IF (jts - jbs .lt. spec_zone) THEN
81 ! Y-start boundary
82 DO j = jts, min(jtf,jbs+spec_zone-1)
83 b_dist = j - jbs
84 b_limit = b_dist
85 IF(periodic_x)b_limit = 0
86 DO k = kts, ktf
87 DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
89 MU_OLD(i,j) = MUTS(i,j) - dt*MU_TEND(i,j)
91 field(i,k,j) = field(i,k,j)*(c1(k)*mu_old(i,j)+c2(k))/(c1(k)*muts(i,j)+c2(k)) + &
92 dt*field_tend(i,k,j)/(c1(k)*muts(i,j)+c2(k)) + &
93 ph_save(i,k,j)*((c1(k)*mu_old(i,j)+c2(k))/(c1(k)*muts(i,j)+c2(k)) - 1.)
95 ENDDO
96 ENDDO
97 ENDDO
98 ENDIF
99 IF (jbe - jtf .lt. spec_zone) THEN
100 ! Y-end boundary
101 DO j = max(jts,jbe-spec_zone+1), jtf
102 b_dist = jbe - j
103 b_limit = b_dist
104 IF(periodic_x)b_limit = 0
105 DO k = kts, ktf
106 DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
108 MU_OLD(i,j) = MUTS(i,j) - dt*MU_TEND(i,j)
110 field(i,k,j) = field(i,k,j)*(c1(k)*mu_old(i,j)+c2(k))/(c1(k)*muts(i,j)+c2(k)) + &
111 dt*field_tend(i,k,j)/(c1(k)*muts(i,j)+c2(k)) + &
112 ph_save(i,k,j)*((c1(k)*mu_old(i,j)+c2(k))/(c1(k)*muts(i,j)+c2(k)) - 1.)
114 ENDDO
115 ENDDO
116 ENDDO
117 ENDIF
119 IF(.NOT.periodic_x)THEN
120 IF (its - ibs .lt. spec_zone) THEN
121 ! X-start boundary
122 DO i = its, min(itf,ibs+spec_zone-1)
123 b_dist = i - ibs
124 DO k = kts, ktf
125 DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
127 MU_OLD(i,j) = MUTS(i,j) - dt*MU_TEND(i,j)
129 field(i,k,j) = field(i,k,j)*(c1(k)*mu_old(i,j)+c2(k))/(c1(k)*muts(i,j)+c2(k)) + &
130 dt*field_tend(i,k,j)/(c1(k)*muts(i,j)+c2(k)) + &
131 ph_save(i,k,j)*((c1(k)*mu_old(i,j)+c2(k))/(c1(k)*muts(i,j)+c2(k)) - 1.)
133 ENDDO
134 ENDDO
135 ENDDO
136 ENDIF
138 IF (ibe - itf .lt. spec_zone) THEN
139 ! X-end boundary
140 DO i = max(its,ibe-spec_zone+1), itf
141 b_dist = ibe - i
142 DO k = kts, ktf
143 DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
145 MU_OLD(i,j) = MUTS(i,j) - dt*MU_TEND(i,j)
147 field(i,k,j) = field(i,k,j)*(c1(k)*mu_old(i,j)+c2(k))/(c1(k)*muts(i,j)+c2(k)) + &
148 dt*field_tend(i,k,j)/(c1(k)*muts(i,j)+c2(k)) + &
149 ph_save(i,k,j)*((c1(k)*mu_old(i,j)+c2(k))/(c1(k)*muts(i,j)+c2(k)) - 1.)
151 ENDDO
152 ENDDO
153 ENDDO
154 ENDIF
155 ENDIF
157 END SUBROUTINE spec_bdyupdate_ph
159 !------------------------------------------------------------------------
161 SUBROUTINE relax_bdy_dry ( config_flags, &
162 ru_tendf, rv_tendf, ph_tendf, t_tendf, &
163 rw_tendf, mu_tend, c1h, c2h, c1f, c2f, &
164 ru, rv, ph, t, &
165 w, mu, mut, &
166 u_bxs,u_bxe,u_bys,u_bye, &
167 v_bxs,v_bxe,v_bys,v_bye, &
168 ph_bxs,ph_bxe,ph_bys,ph_bye, &
169 t_bxs,t_bxe,t_bys,t_bye, &
170 w_bxs,w_bxe,w_bys,w_bye, &
171 mu_bxs,mu_bxe,mu_bys,mu_bye, &
172 u_btxs,u_btxe,u_btys,u_btye, &
173 v_btxs,v_btxe,v_btys,v_btye, &
174 ph_btxs,ph_btxe,ph_btys,ph_btye, &
175 t_btxs,t_btxe,t_btys,t_btye, &
176 w_btxs,w_btxe,w_btys,w_btye, &
177 mu_btxs,mu_btxe,mu_btys,mu_btye, &
178 spec_bdy_width, spec_zone, relax_zone, &
179 dtbc, fcx, gcx, &
180 ids,ide, jds,jde, kds,kde, & ! domain dims
181 ims,ime, jms,jme, kms,kme, & ! memory dims
182 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
183 its, ite, jts, jte, kts, kte)
184 IMPLICIT NONE
186 ! Input data.
187 TYPE( grid_config_rec_type ) config_flags
189 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
190 ims, ime, jms, jme, kms, kme, &
191 ips, ipe, jps, jpe, kps, kpe, &
192 its, ite, jts, jte, kts, kte
193 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone, relax_zone
195 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: ru, &
196 rv, &
197 ph, &
198 w, &
199 t
200 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu , &
201 mut
202 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: ru_tendf, &
203 rv_tendf, &
204 ph_tendf, &
205 rw_tendf, &
206 t_tendf
207 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: mu_tend
209 REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h, c1f, c2f
211 REAL , DIMENSION( spec_bdy_width) , INTENT(IN ) :: fcx, gcx
213 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bxs,u_bxe, &
214 v_bxs,v_bxe, &
215 ph_bxs,ph_bxe, &
216 w_bxs,w_bxe, &
217 t_bxs,t_bxe, &
218 u_btxs,u_btxe, &
219 v_btxs,v_btxe, &
220 ph_btxs,ph_btxe, &
221 w_btxs,w_btxe, &
222 t_btxs,t_btxe
224 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bys,u_bye, &
225 v_bys,v_bye, &
226 ph_bys,ph_bye, &
227 w_bys,w_bye, &
228 t_bys,t_bye, &
229 u_btys,u_btye, &
230 v_btys,v_btye, &
231 ph_btys,ph_btye, &
232 w_btys,w_btye, &
233 t_btys,t_btye
236 REAL, DIMENSION( jms:jme , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bxs,mu_bxe, &
237 mu_btxs,mu_btxe
239 REAL, DIMENSION( ims:ime , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bys,mu_bye, &
240 mu_btys,mu_btye
241 REAL, INTENT(IN ) :: dtbc
243 ! changed to tile dimensions, 20090923, JM
244 REAL , DIMENSION( its-1:ite+1 , kts:kte, jts-1:jte+1 ) :: rfield
245 INTEGER :: i_start, i_end, j_start, j_end, i, j, k
247 CALL relax_bdytend ( ru, ru_tendf, &
248 u_bxs,u_bxe,u_bys,u_bye,u_btxs,u_btxe,u_btys,u_btye, &
249 'u' , config_flags, &
250 spec_bdy_width, spec_zone, relax_zone, &
251 dtbc, fcx, gcx, &
252 ids,ide, jds,jde, kds,kde, & ! domain dims
253 ims,ime, jms,jme, kms,kme, & ! memory dims
254 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
255 its,ite, jts,jte, kts,kte )
256 CALL relax_bdytend ( rv, rv_tendf, &
257 v_bxs,v_bxe,v_bys,v_bye,v_btxs,v_btxe,v_btys,v_btye, &
258 'v' , config_flags, &
259 spec_bdy_width, spec_zone, relax_zone, &
260 dtbc, fcx, gcx, &
261 ids,ide, jds,jde, kds,kde, & ! domain dims
262 ims,ime, jms,jme, kms,kme, & ! memory dims
263 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
264 its,ite, jts,jte, kts,kte )
266 ! rfield will be calculated beyond tile limits because relax_bdytend
267 ! requires a 5-point stencil, and this avoids need for inter-tile/patch
268 ! communication here
269 i_start = max(its-1, ids)
270 i_end = min(ite+1, ide-1)
271 j_start = max(jts-1, jds)
272 j_end = min(jte+1, jde-1)
274 CALL mass_weight ( ph , mut , rfield , c1f, c2f, &
275 ids,ide, jds,jde, kds,kde, & ! domain dims
276 ims,ime, jms,jme, kms,kme, & ! memory dims
277 its-1,ite+1 , jts-1,jte+1 , & ! rfield dims
278 kts,kte, & ! rfield
279 i_start,i_end, j_start,j_end, kts,kte) ! tile dims
281 CALL relax_bdytend_tile ( rfield, ph_tendf, &
282 ph_bxs,ph_bxe,ph_bys,ph_bye, ph_btxs,ph_btxe,ph_btys,ph_btye, &
283 'h' , config_flags, &
284 spec_bdy_width, spec_zone, relax_zone, &
285 dtbc, fcx, gcx, &
286 ids,ide, jds,jde, kds,kde, & ! domain dims
287 ims,ime, jms,jme, kms,kme, & ! memory dims
288 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
289 its,ite, jts,jte, kts,kte, &
290 its-1, ite+1, jts-1,jte+1,kts,kte ) ! dims of first argument
292 CALL mass_weight ( t, mut , rfield , c1h, c2h, &
293 ids,ide, jds,jde, kds,kde, & ! domain dims
294 ims,ime, jms,jme, kms,kme, & ! memory dims
295 its-1,ite+1 , jts-1,jte+1 , & ! rfield dims
296 kts,kte, & ! rfield
297 i_start,i_end, j_start,j_end, kts,kte-1) ! tile dims
299 CALL relax_bdytend_tile ( rfield, t_tendf, &
300 t_bxs,t_bxe,t_bys,t_bye, t_btxs,t_btxe,t_btys,t_btye, &
301 't' , config_flags, &
302 spec_bdy_width, spec_zone, relax_zone, &
303 dtbc, fcx, gcx, &
304 ids,ide, jds,jde, kds,kde, & ! domain dims
305 ims,ime, jms,jme, kms,kme, & ! memory dims
306 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
307 its,ite, jts,jte, kts,kte, &
308 its-1, ite+1, jts-1,jte+1,kts,kte ) ! dims of first argument
310 CALL relax_bdytend ( mu, mu_tend, &
311 mu_bxs,mu_bxe,mu_bys,mu_bye, mu_btxs,mu_btxe,mu_btys,mu_btye, &
312 'm' , config_flags, &
313 spec_bdy_width, spec_zone, relax_zone, &
314 dtbc, fcx, gcx, &
315 ids,ide, jds,jde, 1 ,1 , & ! domain dims
316 ims,ime, jms,jme, 1 ,1 , & ! memory dims
317 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
318 its,ite, jts,jte, 1 ,1 )
320 IF( config_flags%nested) THEN
322 i_start = max(its-1, ids)
323 i_end = min(ite+1, ide-1)
324 j_start = max(jts-1, jds)
325 j_end = min(jte+1, jde-1)
327 CALL mass_weight ( w , mut , rfield , c1f, c2f, &
328 ids,ide, jds,jde, kds,kde, & ! domain dims
329 ims,ime, jms,jme, kms,kme, & ! memory dims
330 its-1,ite+1 , jts-1,jte+1 , & ! rfield dims
331 kts,kte, & ! rfield
332 i_start,i_end, j_start,j_end, kts,kte) ! tile dims
334 CALL relax_bdytend_tile ( rfield, rw_tendf, &
335 w_bxs,w_bxe,w_bys,w_bye, w_btxs,w_btxe,w_btys,w_btye, &
336 'h' , config_flags, &
337 spec_bdy_width, spec_zone, relax_zone, &
338 dtbc, fcx, gcx, &
339 ids,ide, jds,jde, kds,kde, & ! domain dims
340 ims,ime, jms,jme, kms,kme, & ! memory dims
341 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
342 its,ite, jts,jte, kts,kte, &
343 its-1, ite+1, jts-1,jte+1,kts,kte ) ! dims of first argument
345 END IF
346 END SUBROUTINE relax_bdy_dry
347 !------------------------------------------------------------------------
348 SUBROUTINE relax_bdy_scalar ( scalar_tend, &
349 scalar, mu, c1h, c2h, &
350 scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, &
351 scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
352 spec_bdy_width, spec_zone, relax_zone, &
353 dtbc, fcx, gcx, &
354 config_flags, &
355 ids,ide, jds,jde, kds,kde, & ! domain dims
356 ims,ime, jms,jme, kms,kme, & ! memory dims
357 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
358 its, ite, jts, jte, kts, kte)
359 IMPLICIT NONE
361 ! Input data.
362 TYPE( grid_config_rec_type ) config_flags
364 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
365 ims, ime, jms, jme, kms, kme, &
366 ips, ipe, jps, jpe, kps, kpe, &
367 its, ite, jts, jte, kts, kte
368 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone, relax_zone
370 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: scalar
371 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu
372 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: scalar_tend
373 REAL , DIMENSION( spec_bdy_width) , INTENT(IN ) :: fcx, gcx
375 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bxs,scalar_bxe, &
376 scalar_btxs,scalar_btxe
377 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bys,scalar_bye, &
378 scalar_btys,scalar_btye
379 REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h
380 REAL, INTENT(IN ) :: dtbc
381 !Local
382 INTEGER :: i,j,k, i_start, i_end, j_start, j_end
383 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: rscalar
385 ! rscalar will be calculated beyond tile limits because relax_bdytend
386 ! requires a 5-point stencil, and this avoids need for inter-tile/patch
387 ! communication here
388 i_start = max(its-1, ids)
389 i_end = min(ite+1, ide-1)
390 j_start = max(jts-1, jds)
391 j_end = min(jte+1, jde-1)
393 CALL mass_weight ( scalar , mu , rscalar, c1h, c2h, &
394 ids,ide, jds,jde, kds,kde, & ! domain dims
395 ims,ime, jms,jme, kms,kme, & ! memory dims
396 ims,ime, jms,jme, kms,kme, & ! rfield dims
397 i_start,i_end, j_start,j_end, kts,kte-1) ! tile dims
399 CALL relax_bdytend (rscalar, scalar_tend, &
400 scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
401 'q' , config_flags, &
402 spec_bdy_width, spec_zone, relax_zone, &
403 dtbc, fcx, gcx, &
404 ids,ide, jds,jde, kds,kde, & ! domain dims
405 ims,ime, jms,jme, kms,kme, & ! memory dims
406 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
407 its,ite, jts,jte, kts,kte )
410 END SUBROUTINE relax_bdy_scalar
412 !------------------------------------------------------------------------
413 SUBROUTINE spec_bdy_dry ( config_flags, &
414 ru_tend, rv_tend, ph_tend, t_tend, &
415 rw_tend, mu_tend, &
416 u_bxs,u_bxe,u_bys,u_bye, &
417 v_bxs,v_bxe,v_bys,v_bye, &
418 ph_bxs,ph_bxe,ph_bys,ph_bye, &
419 t_bxs,t_bxe,t_bys,t_bye, &
420 w_bxs,w_bxe,w_bys,w_bye, &
421 mu_bxs,mu_bxe,mu_bys,mu_bye, &
422 u_btxs,u_btxe,u_btys,u_btye, &
423 v_btxs,v_btxe,v_btys,v_btye, &
424 ph_btxs,ph_btxe,ph_btys,ph_btye, &
425 t_btxs,t_btxe,t_btys,t_btye, &
426 w_btxs,w_btxe,w_btys,w_btye, &
427 mu_btxs,mu_btxe,mu_btys,mu_btye, &
428 spec_bdy_width, spec_zone, &
429 ids,ide, jds,jde, kds,kde, & ! domain dims
430 ims,ime, jms,jme, kms,kme, & ! memory dims
431 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
432 its, ite, jts, jte, kts, kte)
433 IMPLICIT NONE
435 ! Input data.
436 TYPE( grid_config_rec_type ) config_flags
439 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
440 ims, ime, jms, jme, kms, kme, &
441 ips, ipe, jps, jpe, kps, kpe, &
442 its, ite, jts, jte, kts, kte
443 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
445 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT ) :: ru_tend, &
446 rv_tend, &
447 ph_tend, &
448 rw_tend, &
449 t_tend
450 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(OUT ) :: mu_tend
452 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bxs,u_bxe, &
453 v_bxs,v_bxe, &
454 ph_bxs,ph_bxe, &
455 w_bxs,w_bxe, &
456 t_bxs,t_bxe, &
457 u_btxs,u_btxe, &
458 v_btxs,v_btxe, &
459 ph_btxs,ph_btxe, &
460 w_btxs,w_btxe, &
461 t_btxs,t_btxe
463 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bys,u_bye, &
464 v_bys,v_bye, &
465 ph_bys,ph_bye, &
466 w_bys,w_bye, &
467 t_bys,t_bye, &
468 u_btys,u_btye, &
469 v_btys,v_btye, &
470 ph_btys,ph_btye, &
471 w_btys,w_btye, &
472 t_btys,t_btye
474 REAL, DIMENSION( jms:jme , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bxs,mu_bxe, &
475 mu_btxs,mu_btxe
477 REAL, DIMENSION( ims:ime , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bys,mu_bye, &
478 mu_btys,mu_btye
479 CALL spec_bdytend ( ru_tend, &
480 u_bxs,u_bxe,u_bys,u_bye, u_btxs,u_btxe,u_btys,u_btye, &
481 'u' , config_flags, &
482 spec_bdy_width, spec_zone, &
483 ids,ide, jds,jde, kds,kde, & ! domain dims
484 ims,ime, jms,jme, kms,kme, & ! memory dims
485 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
486 its,ite, jts,jte, kts,kte )
487 CALL spec_bdytend ( rv_tend, &
488 v_bxs,v_bxe,v_bys,v_bye, v_btxs,v_btxe,v_btys,v_btye, &
489 'v' , config_flags, &
490 spec_bdy_width, spec_zone, &
491 ids,ide, jds,jde, kds,kde, & ! domain dims
492 ims,ime, jms,jme, kms,kme, & ! memory dims
493 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
494 its,ite, jts,jte, kts,kte )
495 CALL spec_bdytend ( ph_tend, &
496 ph_bxs,ph_bxe,ph_bys,ph_bye, ph_btxs,ph_btxe,ph_btys,ph_btye, &
497 'h' , config_flags, &
498 spec_bdy_width, spec_zone, &
499 ids,ide, jds,jde, kds,kde, & ! domain dims
500 ims,ime, jms,jme, kms,kme, & ! memory dims
501 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
502 its,ite, jts,jte, kts,kte )
503 CALL spec_bdytend ( t_tend, &
504 t_bxs,t_bxe,t_bys,t_bye, t_btxs,t_btxe,t_btys,t_btye, &
505 't' , config_flags, &
506 spec_bdy_width, spec_zone, &
507 ids,ide, jds,jde, kds,kde, & ! domain dims
508 ims,ime, jms,jme, kms,kme, & ! memory dims
509 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
510 its,ite, jts,jte, kts,kte )
511 CALL spec_bdytend ( mu_tend, &
512 mu_bxs,mu_bxe,mu_bys,mu_bye, mu_btxs,mu_btxe,mu_btys,mu_btye, &
513 'm' , config_flags, &
514 spec_bdy_width, spec_zone, &
515 ids,ide, jds,jde, 1 ,1 , & ! domain dims
516 ims,ime, jms,jme, 1 ,1 , & ! memory dims
517 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
518 its,ite, jts,jte, 1 ,1 )
520 if(config_flags%nested) &
521 CALL spec_bdytend ( rw_tend, &
522 w_bxs,w_bxe,w_bys,w_bye, w_btxs,w_btxe,w_btys,w_btye, &
523 'h' , config_flags, &
524 spec_bdy_width, spec_zone, &
525 ids,ide, jds,jde, kds,kde, & ! domain dims
526 ims,ime, jms,jme, kms,kme, & ! memory dims
527 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
528 its,ite, jts,jte, kts,kte )
530 END SUBROUTINE spec_bdy_dry
533 !------------------------------------------------------------------------
534 ! KRS 9/13/2012: New subroutine spec_bdy_dry_perturb.
535 ! Perturbation field passed in: field_(u,v,t)_tend_perturb
536 ! field_(u,v,t)_tend_perturb=r(u,v,t)_tendf_stoch if perturb_bdy=1
537 ! field_(u,v,t)_tend_perturb=User provided patterns if perturb_bdy=2
538 ! This routine calls spec_bdytend_perturb in share/module_bc.F for u,v,t.
539 !------------------------------------------------------------------------
541 SUBROUTINE spec_bdy_dry_perturb ( config_flags, &
542 ru_tend, rv_tend, t_tend,mu_2, mub, c1, c2, &
543 msfu, msfv, msft, &
544 field_u_tend_perturb,field_v_tend_perturb,field_t_tend_perturb, &
545 spec_bdy_width, spec_zone, &
546 kme_stoch, & ! stoch dims
547 ids,ide, jds,jde, kds,kde, & ! domain dims
548 ims,ime, jms,jme, kms,kme, & ! memory dims
549 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
550 its, ite, jts, jte, kts, kte)
551 IMPLICIT NONE
553 ! Input data.
554 TYPE( grid_config_rec_type ) config_flags
557 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
558 ims, ime, jms, jme, kms, kme, &
559 ips, ipe, jps, jpe, kps, kpe, &
560 its, ite, jts, jte, kts, kte, &
561 kme_stoch
562 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
564 REAL , DIMENSION( ims:ime , kms:kme ,jms:jme ) , INTENT(INOUT) :: ru_tend, &
565 rv_tend, &
566 t_tend
568 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ) :: mu_2
569 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ) :: mub
570 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: msfu
571 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: msfv
572 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: msft
573 REAL, DIMENSION( kms:kme ), INTENT(IN ) :: c1, c2
575 REAL, DIMENSION( ims:ime , kms:kme_stoch , jms:jme ), INTENT(IN ) :: field_u_tend_perturb, &
576 field_v_tend_perturb, &
577 field_t_tend_perturb
579 CALL spec_bdytend_perturb ( ru_tend, &
580 field_u_tend_perturb, &
581 mu_2,mub, c1, c2, &
582 'u', msfu, config_flags, &
583 spec_bdy_width, spec_zone, &
584 kme_stoch, & ! stoch dims
585 ids,ide, jds,jde, kds,kde, & ! domain dims
586 ims,ime, jms,jme, kms,kme, & ! memory dims
587 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
588 its,ite, jts,jte, kts,kte )
589 CALL spec_bdytend_perturb ( rv_tend, &
590 field_v_tend_perturb, &
591 mu_2,mub, c1, c2, &
592 'v', msfv, config_flags, &
593 spec_bdy_width, spec_zone, &
594 kme_stoch, & ! stoch dims
595 ids,ide, jds,jde, kds,kde, & ! domain dims
596 ims,ime, jms,jme, kms,kme, & ! memory dims
597 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
598 its,ite, jts,jte, kts,kte )
600 CALL spec_bdytend_perturb ( t_tend, &
601 field_t_tend_perturb, &
602 mu_2,mub, c1, c2, &
603 't', msft, config_flags, &
604 spec_bdy_width, spec_zone, &
605 kme_stoch, & ! stoch dims
606 ids,ide, jds,jde, kds,kde, & ! domain dims
607 ims,ime, jms,jme, kms,kme, & ! memory dims
608 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
609 its,ite, jts,jte, kts,kte )
611 END SUBROUTINE spec_bdy_dry_perturb
615 !------------------------------------------------------------------------
616 SUBROUTINE spec_bdy_chem_perturb (periodic_x, &
617 field_bdy_tend_xs, field_bdy_tend_xe, &
618 field_bdy_tend_ys, field_bdy_tend_ye, &
619 field_scalar_perturb, &
620 spec_bdy_width, spec_zone, &
621 kme_stoch, & ! stoch dims
622 ids,ide, jds,jde, kds,kde, & ! domain dims
623 ims,ime, jms,jme, kms,kme, & ! memory dims
624 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
625 its, ite, jts, jte, kts, kte)
626 IMPLICIT NONE
629 LOGICAL , INTENT(IN ) :: periodic_x
630 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
631 ims, ime, jms, jme, kms, kme, &
632 ips, ipe, jps, jpe, kps, kpe, &
633 its, ite, jts, jte, kts, kte, &
634 kme_stoch
635 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
637 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: field_scalar_perturb
638 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(INOUT) :: field_bdy_tend_xs, field_bdy_tend_xe
639 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(INOUT) :: field_bdy_tend_ys, field_bdy_tend_ye
642 CALL spec_bdytend_perturb_chem ( field_bdy_tend_xs, field_bdy_tend_xe, &
643 field_bdy_tend_ys, field_bdy_tend_ye, &
644 field_scalar_perturb, 'c', &
645 periodic_x, &
646 spec_bdy_width, spec_zone, &
647 kme_stoch, &
648 ids,ide, jds,jde, kds,kde, & ! domain dims
649 ims,ime, jms,jme, kms,kme, & ! memory dims
650 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
651 its,ite, jts,jte, kts,kte )
653 END SUBROUTINE spec_bdy_chem_perturb
657 !------------------------------------------------------------------------
658 SUBROUTINE spec_bdy_scalar ( scalar_tend, &
659 scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, &
660 scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
661 spec_bdy_width, spec_zone, &
662 config_flags, &
663 ids,ide, jds,jde, kds,kde, & ! domain dims
664 ims,ime, jms,jme, kms,kme, & ! memory dims
665 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
666 its, ite, jts, jte, kts, kte)
667 IMPLICIT NONE
669 ! Input data.
670 TYPE( grid_config_rec_type ) config_flags
673 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
674 ims, ime, jms, jme, kms, kme, &
675 ips, ipe, jps, jpe, kps, kpe, &
676 its, ite, jts, jte, kts, kte
677 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
679 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT ) :: scalar_tend
681 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bxs,scalar_bxe, &
682 scalar_btxs,scalar_btxe
684 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bys,scalar_bye, &
685 scalar_btys,scalar_btye
687 !Local
688 INTEGER :: i,j,k
691 CALL spec_bdytend ( scalar_tend, &
692 scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
693 'q' , config_flags, &
694 spec_bdy_width, spec_zone, &
695 ids,ide, jds,jde, kds,kde, & ! domain dims
696 ims,ime, jms,jme, kms,kme, & ! memory dims
697 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
698 its,ite, jts,jte, kts,kte )
701 END SUBROUTINE spec_bdy_scalar
703 !------------------------------------------------------------------------
705 SUBROUTINE set_phys_bc_dry_1( config_flags, u_1, u_2, v_1, v_2, &
706 rw_1, rw_2, w_1, w_2, &
707 t_1, t_2, tp_1, tp_2, pp, pip, &
708 ids,ide, jds,jde, kds,kde, &
709 ims,ime, jms,jme, kms,kme, &
710 ips,ipe, jps,jpe, kps,kpe, &
711 its,ite, jts,jte, kts,kte )
713 !
714 ! this is just a wrapper to call the boundary condition routines
715 ! for each variable
716 !
718 IMPLICIT NONE
720 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
721 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
722 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
723 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
725 TYPE( grid_config_rec_type ) config_flags
727 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
728 u_1,u_2, v_1, v_2, rw_1, rw_2, w_1, w_2, &
729 t_1, t_2, tp_1, tp_2, pp, pip
733 CALL set_physical_bc3d( u_1 , 'u', config_flags, &
734 ids, ide, jds, jde, kds, kde, &
735 ims, ime, jms, jme, kms, kme, &
736 ips, ipe, jps, jpe, kps, kpe, &
737 its, ite, jts, jte, kts, kte )
738 CALL set_physical_bc3d( u_2 , 'u', config_flags, &
739 ids, ide, jds, jde, kds, kde, &
740 ims, ime, jms, jme, kms, kme, &
741 ips, ipe, jps, jpe, kps, kpe, &
742 its, ite, jts, jte, kts, kte )
743 CALL set_physical_bc3d( v_1 , 'v', config_flags, &
744 ids, ide, jds, jde, kds, kde, &
745 ims, ime, jms, jme, kms, kme, &
746 ips, ipe, jps, jpe, kps, kpe, &
747 its, ite, jts, jte, kts, kte )
748 CALL set_physical_bc3d( v_2 , 'v', config_flags, &
749 ids, ide, jds, jde, kds, kde, &
750 ims, ime, jms, jme, kms, kme, &
751 ips, ipe, jps, jpe, kps, kpe, &
752 its, ite, jts, jte, kts, kte )
753 CALL set_physical_bc3d( rw_1 , 'w', config_flags, &
754 ids, ide, jds, jde, kds, kde, &
755 ims, ime, jms, jme, kms, kme, &
756 ips, ipe, jps, jpe, kps, kpe, &
757 its, ite, jts, jte, kts, kte )
758 CALL set_physical_bc3d( rw_2 , 'w', config_flags, &
759 ids, ide, jds, jde, kds, kde, &
760 ims, ime, jms, jme, kms, kme, &
761 ips, ipe, jps, jpe, kps, kpe, &
762 its, ite, jts, jte, kts, kte )
763 CALL set_physical_bc3d( w_1 , 'w', config_flags, &
764 ids, ide, jds, jde, kds, kde, &
765 ims, ime, jms, jme, kms, kme, &
766 ips, ipe, jps, jpe, kps, kpe, &
767 its, ite, jts, jte, kts, kte )
768 CALL set_physical_bc3d( w_2 , 'w', config_flags, &
769 ids, ide, jds, jde, kds, kde, &
770 ims, ime, jms, jme, kms, kme, &
771 ips, ipe, jps, jpe, kps, kpe, &
772 its, ite, jts, jte, kts, kte )
773 CALL set_physical_bc3d( t_1, 'p', config_flags, &
774 ids, ide, jds, jde, kds, kde, &
775 ims, ime, jms, jme, kms, kme, &
776 ips, ipe, jps, jpe, kps, kpe, &
777 its, ite, jts, jte, kts, kte )
778 CALL set_physical_bc3d( t_2, 'p', config_flags, &
779 ids, ide, jds, jde, kds, kde, &
780 ims, ime, jms, jme, kms, kme, &
781 ips, ipe, jps, jpe, kps, kpe, &
782 its, ite, jts, jte, kts, kte )
783 CALL set_physical_bc3d( tp_1, 'p', config_flags, &
784 ids, ide, jds, jde, kds, kde, &
785 ims, ime, jms, jme, kms, kme, &
786 ips, ipe, jps, jpe, kps, kpe, &
787 its, ite, jts, jte, kts, kte )
788 CALL set_physical_bc3d( tp_2, 'p', config_flags, &
789 ids, ide, jds, jde, kds, kde, &
790 ims, ime, jms, jme, kms, kme, &
791 ips, ipe, jps, jpe, kps, kpe, &
792 its, ite, jts, jte, kts, kte )
793 CALL set_physical_bc3d( pp , 'p', config_flags, &
794 ids, ide, jds, jde, kds, kde, &
795 ims, ime, jms, jme, kms, kme, &
796 ips, ipe, jps, jpe, kps, kpe, &
797 its, ite, jts, jte, kts, kte )
798 CALL set_physical_bc3d( pip , 'p', config_flags, &
799 ids, ide, jds, jde, kds, kde, &
800 ims, ime, jms, jme, kms, kme, &
801 ips, ipe, jps, jpe, kps, kpe, &
802 its, ite, jts, jte, kts, kte )
804 END SUBROUTINE set_phys_bc_dry_1
806 !--------------------------------------------------------------
808 SUBROUTINE set_phys_bc_dry_2( config_flags, &
809 u_1, u_2, v_1, v_2, w_1, w_2, &
810 t_1, t_2, ph_1, ph_2, mu_1, mu_2, &
811 ids,ide, jds,jde, kds,kde, &
812 ims,ime, jms,jme, kms,kme, &
813 ips,ipe, jps,jpe, kps,kpe, &
814 its,ite, jts,jte, kts,kte )
816 !
817 ! this is just a wrapper to call the boundary condition routines
818 ! for each variable
819 !
821 IMPLICIT NONE
823 TYPE( grid_config_rec_type ) config_flags
825 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
826 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
827 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
828 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
830 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
831 u_1, u_2, v_1, v_2, w_1, w_2, &
832 t_1, t_2, ph_1, ph_2
834 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
835 mu_1, mu_2
838 CALL set_physical_bc3d( u_1, 'U', config_flags, &
839 ids, ide, jds, jde, kds, kde, &
840 ims, ime, jms, jme, kms, kme, &
841 ips, ipe, jps, jpe, kps, kpe, &
842 its, ite, jts, jte, kts, kte )
844 CALL set_physical_bc3d( u_2, 'U', config_flags, &
845 ids, ide, jds, jde, kds, kde, &
846 ims, ime, jms, jme, kms, kme, &
847 ips, ipe, jps, jpe, kps, kpe, &
848 its, ite, jts, jte, kts, kte )
850 CALL set_physical_bc3d( v_1 , 'V', config_flags, &
851 ids, ide, jds, jde, kds, kde, &
852 ims, ime, jms, jme, kms, kme, &
853 ips, ipe, jps, jpe, kps, kpe, &
854 its, ite, jts, jte, kts, kte )
855 CALL set_physical_bc3d( v_2 , 'V', config_flags, &
856 ids, ide, jds, jde, kds, kde, &
857 ims, ime, jms, jme, kms, kme, &
858 ips, ipe, jps, jpe, kps, kpe, &
859 its, ite, jts, jte, kts, kte )
861 CALL set_physical_bc3d( w_1, 'w', config_flags, &
862 ids, ide, jds, jde, kds, kde, &
863 ims, ime, jms, jme, kms, kme, &
864 ips, ipe, jps, jpe, kps, kpe, &
865 its, ite, jts, jte, kts, kte )
866 CALL set_physical_bc3d( w_2, 'w', config_flags, &
867 ids, ide, jds, jde, kds, kde, &
868 ims, ime, jms, jme, kms, kme, &
869 ips, ipe, jps, jpe, kps, kpe, &
870 its, ite, jts, jte, kts, kte )
872 CALL set_physical_bc3d( t_1, 'p', config_flags, &
873 ids, ide, jds, jde, kds, kde, &
874 ims, ime, jms, jme, kms, kme, &
875 ips, ipe, jps, jpe, kps, kpe, &
876 its, ite, jts, jte, kts, kte )
878 CALL set_physical_bc3d( t_2, 'p', config_flags, &
879 ids, ide, jds, jde, kds, kde, &
880 ims, ime, jms, jme, kms, kme, &
881 ips, ipe, jps, jpe, kps, kpe, &
882 its, ite, jts, jte, kts, kte )
884 CALL set_physical_bc3d( ph_1 , 'w', config_flags, &
885 ids, ide, jds, jde, kds, kde, &
886 ims, ime, jms, jme, kms, kme, &
887 ips, ipe, jps, jpe, kps, kpe, &
888 its, ite, jts, jte, kts, kte )
890 CALL set_physical_bc3d( ph_2 , 'w', config_flags, &
891 ids, ide, jds, jde, kds, kde, &
892 ims, ime, jms, jme, kms, kme, &
893 ips, ipe, jps, jpe, kps, kpe, &
894 its, ite, jts, jte, kts, kte )
896 CALL set_physical_bc2d( mu_1, 't', config_flags, &
897 ids, ide, jds, jde, &
898 ims, ime, jms, jme, &
899 ips, ipe, jps, jpe, &
900 its, ite, jts, jte )
902 CALL set_physical_bc2d( mu_2, 't', config_flags, &
903 ids, ide, jds, jde, &
904 ims, ime, jms, jme, &
905 ips, ipe, jps, jpe, &
906 its, ite, jts, jte )
908 END SUBROUTINE set_phys_bc_dry_2
910 !------------------------------------------------------------------------
912 SUBROUTINE set_phys_bc_smallstep_1( config_flags, ru_1, du, rv_1, dv, &
913 ids,ide, jds,jde, kds,kde, &
914 ims,ime, jms,jme, kms,kme, &
915 ips,ipe, jps,jpe, kps,kpe, &
916 its,ite, jts,jte, kts,kte )
918 !
919 ! this is just a wrapper to call the boundary condition routines
920 ! for each variable
921 !
923 IMPLICIT NONE
925 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
926 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
927 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
928 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
930 TYPE( grid_config_rec_type ) config_flags
932 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
933 ru_1,du, rv_1, dv
935 CALL set_physical_bc3d( ru_1 , 'u', config_flags, &
936 ids, ide, jds, jde, kds, kde, &
937 ims, ime, jms, jme, kms, kme, &
938 ips, ipe, jps, jpe, kps, kpe, &
939 its, ite, jts, jte, kts, kde )
940 CALL set_physical_bc3d( du , 'u', config_flags, &
941 ids, ide, jds, jde, kds, kde, &
942 ims, ime, jms, jme, kms, kme, &
943 ips, ipe, jps, jpe, kps, kpe, &
944 its, ite, jts, jte, kts, kde )
945 CALL set_physical_bc3d( rv_1 , 'v', config_flags, &
946 ids, ide, jds, jde, kds, kde, &
947 ims, ime, jms, jme, kms, kme, &
948 ips, ipe, jps, jpe, kps, kpe, &
949 its, ite, jts, jte, kts, kde )
950 CALL set_physical_bc3d( dv , 'v', config_flags, &
951 ids, ide, jds, jde, kds, kde, &
952 ims, ime, jms, jme, kms, kme, &
953 ips, ipe, jps, jpe, kps, kpe, &
954 its, ite, jts, jte, kts, kde )
956 END SUBROUTINE set_phys_bc_smallstep_1
958 !-------------------------------------------------------------------
960 SUBROUTINE rk_phys_bc_dry_1( config_flags, u, v, rw, w, &
961 muu, muv, mut, php, alt, p, &
962 ids,ide, jds,jde, kds,kde, &
963 ims,ime, jms,jme, kms,kme, &
964 ips,ipe, jps,jpe, kps,kpe, &
965 its,ite, jts,jte, kts,kte )
967 !
968 ! this is just a wrapper to call the boundary condition routines
969 ! for each variable
970 !
972 IMPLICIT NONE
974 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
975 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
976 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
977 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
979 TYPE( grid_config_rec_type ) config_flags
981 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
982 INTENT(INOUT) :: u, v, rw, w, php, alt, p
983 REAL, DIMENSION( ims:ime, jms:jme ), &
984 INTENT(INOUT) :: muu, muv, mut
986 CALL set_physical_bc3d( u , 'u', config_flags, &
987 ids, ide, jds, jde, kds, kde, &
988 ims, ime, jms, jme, kms, kme, &
989 ips, ipe, jps, jpe, kps, kpe, &
990 its, ite, jts, jte, kts, kte )
991 CALL set_physical_bc3d( v , 'v', config_flags, &
992 ids, ide, jds, jde, kds, kde, &
993 ims, ime, jms, jme, kms, kme, &
994 ips, ipe, jps, jpe, kps, kpe, &
995 its, ite, jts, jte, kts, kte )
996 CALL set_physical_bc3d(rw , 'w', config_flags, &
997 ids, ide, jds, jde, kds, kde, &
998 ims, ime, jms, jme, kms, kme, &
999 ips, ipe, jps, jpe, kps, kpe, &
1000 its, ite, jts, jte, kts, kte )
1001 CALL set_physical_bc3d( w , 'w', config_flags, &
1002 ids, ide, jds, jde, kds, kde, &
1003 ims, ime, jms, jme, kms, kme, &
1004 ips, ipe, jps, jpe, kps, kpe, &
1005 its, ite, jts, jte, kts, kte )
1006 CALL set_physical_bc3d( php , 'w', config_flags, &
1007 ids, ide, jds, jde, kds, kde, &
1008 ims, ime, jms, jme, kms, kme, &
1009 ips, ipe, jps, jpe, kps, kpe, &
1010 its, ite, jts, jte, kts, kte )
1011 CALL set_physical_bc3d( alt, 't', config_flags, &
1012 ids, ide, jds, jde, kds, kde, &
1013 ims, ime, jms, jme, kms, kme, &
1014 ips, ipe, jps, jpe, kps, kpe, &
1015 its, ite, jts, jte, kts, kte )
1017 CALL set_physical_bc3d( p, 'p', config_flags, &
1018 ids, ide, jds, jde, kds, kde, &
1019 ims, ime, jms, jme, kms, kme, &
1020 ips, ipe, jps, jpe, kps, kpe, &
1021 its, ite, jts, jte, kts, kte )
1023 CALL set_physical_bc2d( muu, 'u', config_flags, &
1024 ids, ide, jds, jde, &
1025 ims, ime, jms, jme, &
1026 ips, ipe, jps, jpe, &
1027 its, ite, jts, jte )
1029 CALL set_physical_bc2d( muv, 'v', config_flags, &
1030 ids, ide, jds, jde, &
1031 ims, ime, jms, jme, &
1032 ips, ipe, jps, jpe, &
1033 its, ite, jts, jte )
1035 CALL set_physical_bc2d( mut, 't', config_flags, &
1036 ids, ide, jds, jde, &
1037 ims, ime, jms, jme, &
1038 ips, ipe, jps, jpe, &
1039 its, ite, jts, jte )
1041 END SUBROUTINE rk_phys_bc_dry_1
1043 !------------------------------------------------------------------------
1045 SUBROUTINE rk_phys_bc_dry_2( config_flags, u, v, w, &
1046 t, ph, mu, &
1047 ids,ide, jds,jde, kds,kde, &
1048 ims,ime, jms,jme, kms,kme, &
1049 ips,ipe, jps,jpe, kps,kpe, &
1050 its,ite, jts,jte, kts,kte )
1052 !
1053 ! this is just a wrapper to call the boundary condition routines
1054 ! for each variable
1055 !
1057 IMPLICIT NONE
1059 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
1060 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
1061 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
1062 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
1064 TYPE( grid_config_rec_type ) config_flags
1066 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
1067 u, v, w, t, ph
1069 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
1070 mu
1072 CALL set_physical_bc3d( u , 'U', config_flags, &
1073 ids, ide, jds, jde, kds, kde, &
1074 ims, ime, jms, jme, kms, kme, &
1075 ips, ipe, jps, jpe, kps, kpe, &
1076 its, ite, jts, jte, kts, kte )
1077 CALL set_physical_bc3d( v , 'V', config_flags, &
1078 ids, ide, jds, jde, kds, kde, &
1079 ims, ime, jms, jme, kms, kme, &
1080 ips, ipe, jps, jpe, kps, kpe, &
1081 its, ite, jts, jte, kts, kte )
1082 CALL set_physical_bc3d( w , 'w', config_flags, &
1083 ids, ide, jds, jde, kds, kde, &
1084 ims, ime, jms, jme, kms, kme, &
1085 ips, ipe, jps, jpe, kps, kpe, &
1086 its, ite, jts, jte, kts, kte )
1087 CALL set_physical_bc3d( t, 'p', config_flags, &
1088 ids, ide, jds, jde, kds, kde, &
1089 ims, ime, jms, jme, kms, kme, &
1090 ips, ipe, jps, jpe, kps, kpe, &
1091 its, ite, jts, jte, kts, kte )
1092 CALL set_physical_bc3d( ph , 'w', config_flags, &
1093 ids, ide, jds, jde, kds, kde, &
1094 ims, ime, jms, jme, kms, kme, &
1095 ips, ipe, jps, jpe, kps, kpe, &
1096 its, ite, jts, jte, kts, kte )
1098 CALL set_physical_bc2d( mu, 't', config_flags, &
1099 ids, ide, jds, jde, &
1100 ims, ime, jms, jme, &
1101 ips, ipe, jps, jpe, &
1102 its, ite, jts, jte )
1104 END SUBROUTINE rk_phys_bc_dry_2
1106 !---------------------------------------------------------------------
1108 SUBROUTINE zero_bdytend ( &
1109 u_btxs,u_btxe,u_btys,u_btye, &
1110 v_btxs,v_btxe,v_btys,v_btye, &
1111 ph_btxs,ph_btxe,ph_btys,ph_btye, &
1112 t_btxs,t_btxe,t_btys,t_btye, &
1113 w_btxs,w_btxe,w_btys,w_btye, &
1114 mu_btxs,mu_btxe,mu_btys,mu_btye, &
1115 moist_btxs,moist_btxe, &
1116 moist_btys,moist_btye, &
1117 scalar_btxs,scalar_btxe, &
1118 scalar_btys,scalar_btye, &
1119 spec_bdy_width,n_moist,n_scalar, &
1120 ids,ide, jds,jde, kds,kde, & ! domain dims
1121 ims,ime, jms,jme, kms,kme, & ! memory dims
1122 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1123 its,ite, jts,jte, kts,kte )
1124 IMPLICIT NONE
1126 ! Input data.
1128 INTEGER , INTENT(IN ) :: spec_bdy_width, n_moist,n_scalar
1130 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1131 ims, ime, jms, jme, kms, kme, &
1132 ips, ipe, jps, jpe, kps, kpe, &
1133 its, ite, jts, jte, kts, kte
1135 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(INOUT) :: u_btxs,u_btxe, &
1136 v_btxs,v_btxe, &
1137 ph_btxs,ph_btxe, &
1138 w_btxs,w_btxe, &
1139 t_btxs,t_btxe
1141 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(INOUT) :: u_btys,u_btye, &
1142 v_btys,v_btye, &
1143 ph_btys,ph_btye, &
1144 w_btys,w_btye, &
1145 t_btys,t_btye
1147 REAL, DIMENSION( jms:jme , 1:1 , spec_bdy_width ), INTENT(INOUT) :: mu_btxs,mu_btxe
1148 REAL, DIMENSION( ims:ime , 1:1 , spec_bdy_width ), INTENT(INOUT) :: mu_btys,mu_btye
1150 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width , n_moist ), INTENT(INOUT) :: moist_btxs,moist_btxe
1151 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width , n_moist ), INTENT(INOUT) :: moist_btys,moist_btye
1153 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width , n_scalar ), INTENT(INOUT) :: scalar_btxs,scalar_btxe
1154 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width , n_scalar ), INTENT(INOUT) :: scalar_btys,scalar_btye
1157 ! setting bdy tendencies to zero during DFI
1159 CALL wrf_debug( 10, 'In zero_bdytend, setting bdy tendencies to 0 during DFI' )
1160 u_btxs = 0.
1161 u_btxe = 0.
1162 u_btys = 0.
1163 u_btye = 0.
1164 v_btxs = 0.
1165 v_btxe = 0.
1166 v_btys = 0.
1167 v_btye = 0.
1168 t_btxs = 0.
1169 t_btxe = 0.
1170 t_btys = 0.
1171 t_btye = 0.
1172 ph_btxs = 0.
1173 ph_btxe = 0.
1174 ph_btys = 0.
1175 ph_btye = 0.
1176 mu_btxs = 0.
1177 mu_btxe = 0.
1178 mu_btys = 0.
1179 mu_btye = 0.
1180 moist_btxs = 0.
1181 moist_btxe = 0.
1182 moist_btys = 0.
1183 moist_btye = 0.
1184 scalar_btxs = 0.
1185 scalar_btxe = 0.
1186 scalar_btys = 0.
1187 scalar_btye = 0.
1190 ! ENDIF
1192 END SUBROUTINE zero_bdytend
1194 !---------------------------------------------------------------------
1196 SUBROUTINE set_w_surface( config_flags, znw, fill_w_flag, &
1197 w, ht, u, v, cf1, cf2, cf3, rdx, rdy, &
1198 msftx, msfty, &
1199 ids, ide, jds, jde, kds, kde, &
1200 ims, ime, jms, jme, kms, kme, &
1201 its, ite, jts, jte, kts, kte )
1202 implicit none
1204 TYPE( grid_config_rec_type ) config_flags
1206 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1207 ims, ime, jms, jme, kms, kme, &
1208 its, ite, jts, jte, kts, kte
1210 REAL :: rdx, rdy, cf1, cf2, cf3
1212 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , &
1213 INTENT(IN ) :: u, &
1214 v
1216 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , &
1217 INTENT(INOUT) :: w
1219 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: ht, &
1220 msftx, &
1221 msfty
1222 REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: znw
1224 LOGICAL, INTENT(IN ) :: fill_w_flag
1227 INTEGER :: i,j,k
1228 INTEGER :: ip1,im1,jp1,jm1
1229 INTEGER :: ip1_limit,im1_limit,jp1_limit,jm1_limit
1231 ! set kinematic lower boundary condition on W
1233 ! Comments on directional map scale factors:
1234 ! Chain rule: if Z=Z(X,Y) [true at the surface] then
1235 ! dZ/dt = dZ/dX * dX/dt + dZ/dY * dY/dt, U=dX/dt, V=dY/dt
1236 ! using capitals to denote actual values
1237 ! in mapped values, u=U, v=V, z=Z, 1/dX=mx/dx, 1/dY=my/dy
1238 ! => w = dz/dt = mx u dz/dx + my v dz/dy
1239 ! [where dz/dx is just the surface height change between x
1240 ! gridpoints, and dz/dy is the change between y gridpoints]
1241 ! [NB - cf1, cf2 and cf3 do vertical weighting of u or v values
1242 ! nearest the surface]
1244 ! get indices for points next to edge of domain
1246 jm1_limit = jds ! No periodic BC's
1247 jp1_limit = jde-1
1248 im1_limit = ids
1249 ip1_limit = ide-1
1251 IF ( config_flags%periodic_x ) THEN
1252 im1_limit = ids-1
1253 ip1_limit = ide
1254 ENDIF
1256 IF ( config_flags%periodic_y ) THEN
1257 jm1_limit = jds-1
1258 jp1_limit = jde
1259 ENDIF
1261 DO j = jts,min(jte,jde-1)
1262 jm1 = max(j-1, jm1_limit)
1263 jp1 = min(j+1, jp1_limit)
1264 DO i = its,min(ite,ide-1)
1265 im1 = max(i-1, im1_limit)
1266 ip1 = min(i+1, ip1_limit)
1268 w(i,1,j)= msfty(i,j)* &
1269 .5*rdy*( &
1270 (ht(i,jp1)-ht(i,j )) &
1271 *(cf1*v(i,1,j+1)+cf2*v(i,2,j+1)+cf3*v(i,3,j+1)) &
1272 +(ht(i,j )-ht(i,jm1)) &
1273 *(cf1*v(i,1,j )+cf2*v(i,2,j )+cf3*v(i,3,j )) ) &
1274 +msftx(i,j)* &
1275 .5*rdx*( &
1276 (ht(ip1,j)-ht(i,j )) &
1277 *(cf1*u(i+1,1,j)+cf2*u(i+1,2,j)+cf3*u(i+1,3,j)) &
1278 +(ht(i ,j)-ht(im1,j)) &
1279 *(cf1*u(i ,1,j)+cf2*u(i ,2,j)+cf3*u(i ,3,j)) )
1281 ENDDO
1282 ENDDO
1284 ! Fill the atmospheric w field with smoothly decaying values
1285 IF (fill_w_flag) THEN
1286 DO j = jts,min(jte,jde-1)
1287 DO k = kts+1,kte
1288 DO i = its,min(ite,ide-1)
1289 w(i,k,j) = w(i,1,j)*znw(k)*znw(k)
1290 ENDDO
1291 ENDDO
1292 ENDDO
1293 ENDIF
1295 END SUBROUTINE set_w_surface
1297 SUBROUTINE lbc_fcx_gcx ( fcx , gcx , spec_bdy_width , &
1298 spec_zone , relax_zone , dt , spec_exp , &
1299 specified , nested )
1301 IMPLICIT NONE
1303 INTEGER , INTENT(IN) :: spec_bdy_width , spec_zone , relax_zone
1304 REAL , INTENT(IN) :: dt , spec_exp
1305 LOGICAL , INTENT(IN) :: specified , nested
1306 REAL , DIMENSION(spec_bdy_width) :: fcx , gcx
1308 ! Local variables.
1310 INTEGER :: loop
1311 REAL :: spongeweight
1313 IF (specified) THEN
1315 ! Arrays for specified boundary conditions
1317 DO loop = spec_zone + 1, spec_zone + relax_zone
1318 fcx(loop) = 0.1 / dt * (spec_zone + relax_zone - loop) / (relax_zone - 1)
1319 gcx(loop) = 1.0 / dt / 50. * (spec_zone + relax_zone - loop) / (relax_zone - 1)
1320 spongeweight=exp(-(loop-(spec_zone + 1))*spec_exp)
1321 fcx(loop) = fcx(loop)*spongeweight
1322 gcx(loop) = gcx(loop)*spongeweight
1323 ENDDO
1325 ELSE IF (nested) THEN
1327 ! Arrays for specified boundary conditions
1329 DO loop = spec_zone + 1, spec_zone + relax_zone
1330 fcx(loop) = 0.1 / dt * (spec_zone + relax_zone - loop) / (relax_zone - 1)
1331 gcx(loop) = 1.0 / dt / 50. * (spec_zone + relax_zone - loop) / (relax_zone - 1)
1332 ! spongeweight=EXP(-(loop-2)/3.)
1333 ! fcx(loop) = fcx(loop)*spongeweight
1334 ! gcx(loop) = gcx(loop)*spongeweight
1335 ! fcx(loop) = 0.
1336 ! gcx(loop) = 0.
1337 ENDDO
1339 ENDIF
1341 END SUBROUTINE lbc_fcx_gcx
1343 !------------------------------------------------------------------------
1345 SUBROUTINE theta_and_thetam_lbc_only ( &
1346 theta_to_thetam, &
1347 mub, &
1348 mu_bdy_xs, mu_bdy_xe, &
1349 mu_bdy_ys, mu_bdy_ye, &
1350 mu_bdy_tend_xs, mu_bdy_tend_xe, &
1351 mu_bdy_tend_ys, mu_bdy_tend_ye, &
1352 orig_t_bdy_xs, orig_t_bdy_xe, &
1353 orig_t_bdy_ys, orig_t_bdy_ye, &
1354 orig_t_bdy_tend_xs, orig_t_bdy_tend_xe,&
1355 orig_t_bdy_tend_ys, orig_t_bdy_tend_ye,&
1356 moist_bdy_xs, moist_bdy_xe, &
1357 moist_bdy_ys, moist_bdy_ye, &
1358 moist_bdy_tend_xs, moist_bdy_tend_xe, &
1359 moist_bdy_tend_ys, moist_bdy_tend_ye, &
1360 spec_bdy_width, &
1361 dt_interval, &
1362 ids,ide, jds,jde, kds,kde, &
1363 ims,ime, jms,jme, kms,kme, &
1364 ips,ipe, jps,jpe, kps,kpe, &
1365 its,ite, jts,jte, kts,kte )
1367 IMPLICIT NONE
1369 ! This routine is called from the solve_em routine. The purpose is to
1370 ! convert the thermal lateral boundary conditions between dry potential
1371 ! temperature and moist potential temperature. The first argument is a
1372 ! flag telling us the direction of the conversion:
1373 ! True = convert dry to moist potential temp
1374 ! False = convert moist to dry potential temp
1376 LOGICAL, INTENT(IN ) :: theta_to_thetam
1378 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
1379 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
1380 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
1381 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
1382 INTEGER, INTENT(IN ) :: spec_bdy_width
1383 REAL , INTENT(IN ) :: dt_interval
1385 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: mub
1387 REAL, DIMENSION( jms:jme , 1 , spec_bdy_width ), INTENT(IN ) :: mu_bdy_xs, mu_bdy_xe
1388 REAL, DIMENSION( ims:ime , 1 , spec_bdy_width ), INTENT(IN ) :: mu_bdy_ys, mu_bdy_ye
1389 REAL, DIMENSION( jms:jme , 1 , spec_bdy_width ), INTENT(IN ) :: mu_bdy_tend_xs, mu_bdy_tend_xe
1390 REAL, DIMENSION( ims:ime , 1 , spec_bdy_width ), INTENT(IN ) :: mu_bdy_tend_ys, mu_bdy_tend_ye
1392 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(INOUT) :: orig_t_bdy_xs, orig_t_bdy_xe
1393 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(INOUT) :: orig_t_bdy_ys, orig_t_bdy_ye
1394 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(INOUT) :: orig_t_bdy_tend_xs, orig_t_bdy_tend_xe
1395 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(INOUT) :: orig_t_bdy_tend_ys, orig_t_bdy_tend_ye
1397 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: moist_bdy_xs, moist_bdy_xe
1398 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: moist_bdy_ys, moist_bdy_ye
1399 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: moist_bdy_tend_xs, moist_bdy_tend_xe
1400 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: moist_bdy_tend_ys, moist_bdy_tend_ye
1402 ! Local variables
1403 #ifdef _OPENMP
1404 INTEGER, EXTERNAL :: omp_get_thread_num
1405 #endif
1407 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ) :: t_bdy_xs, t_bdy_xe
1408 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ) :: t_bdy_ys, t_bdy_ye
1409 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ) :: t_bdy_tend_xs, t_bdy_tend_xe
1410 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ) :: t_bdy_tend_ys, t_bdy_tend_ye
1412 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ) :: new_t_bdy_xs, new_t_bdy_xe
1413 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ) :: new_t_bdy_ys, new_t_bdy_ye
1414 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ) :: new_t_bdy_tend_xs, new_t_bdy_tend_xe
1415 REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ) :: new_t_bdy_tend_ys, new_t_bdy_tend_ye
1417 INTEGER :: i, j, k, ii, jj
1419 REAL :: dt_time_until_next_lbc
1421 REAL :: mu_old_bdy_xs , mu_old_bdy_xe
1422 REAL :: mu_old_bdy_ys , mu_old_bdy_ye
1423 REAL :: mu_new_bdy_xs , mu_new_bdy_xe
1424 REAL :: mu_new_bdy_ys , mu_new_bdy_ye
1426 REAL :: t_old_bdy_xs , t_old_bdy_xe
1427 REAL :: t_old_bdy_ys , t_old_bdy_ye
1428 REAL :: t_new_bdy_xs , t_new_bdy_xe
1429 REAL :: t_new_bdy_ys , t_new_bdy_ye
1430 REAL :: t_old_bdy_tend_xs , t_old_bdy_tend_xe
1431 REAL :: t_old_bdy_tend_ys , t_old_bdy_tend_ye
1433 REAL :: moist_old_bdy_xs , moist_old_bdy_xe
1434 REAL :: moist_old_bdy_ys , moist_old_bdy_ye
1435 REAL :: moist_new_bdy_xs , moist_new_bdy_xe
1436 REAL :: moist_new_bdy_ys , moist_new_bdy_ye
1437 REAL :: moist_old_bdy_tend_xs , moist_old_bdy_tend_xe
1438 REAL :: moist_old_bdy_tend_ys , moist_old_bdy_tend_ye
1440 INTEGER :: i_min, i_max, j_min, j_max
1442 ! IF ( theta_to_thetam ) THEN
1443 ! Convert dry potential temperature to theta_m
1444 ! Defined as: theta_m = ( theta + T0 ) * ( 1. + (R_v/R_d) Qv ) - T0
1445 ! ELSE
1446 ! Convert dry potential temperature to theta_m
1447 ! Defined as: theta = ( theta_m + T0 ) / ( 1. + (R_v/R_d) Qv ) - T0
1448 ! END IF
1450 ! We want the current value and the tendency, using information mostly
1451 ! from the lateral boundary file. In that file, the thermal variable
1452 ! is a potential temperature with the T0 offset removed (theta-300). Both
1453 ! the moisture variable and the potential temperature are coupled
1454 ! (multiplied by total dry column pressure). And to add one more complication,
1455 ! the MU variable in the lateral boundary array is perturbation only.
1457 ! Since we need to end up with lateral boundary values that are coupled,
1458 ! we need to first DECOUPLE T and Qv, compute Tm, and then couple that. As
1459 ! there is a need for the lateral tendency also, we compute the T and Qv
1460 ! values at the two boundary times (previous/current and next). These two
1461 ! times are adequate to get us a tendency. For the tendency, we need to have
1462 ! coupled values for the T (or Tm) at both times, which gives us a coupled
1463 ! tendency. We cannot have an uncoupled tendency and somehow multiply that
1464 ! by some intermediate/average column pressure.
1466 ! This routine's purpose is to manufacture a lateral boundary set of arrays
1467 ! (all eight of them) for the thermal field. Depending on the logical flag
1468 ! passed in, this will either be dry potential temperature or moist potential
1469 ! temperature.
1471 ! The i_min, i_max for the south and north boundaries depends on if we are doing
1472 ! serial, OpenMP, or MPI. For OpenMP, we do not want any overlap between tiles that
1473 ! are on the same task (either OpenMP only, or OpenMP+MPI).
1475 IF ( its .EQ. ids ) THEN
1476 i_min = its
1477 ELSE IF ( its .EQ. ips ) THEN
1478 i_min = ims
1479 ELSE
1480 i_min = its
1481 END IF
1482 i_min = MAX(ids,i_min)
1484 IF ( ite .EQ. ide ) THEN
1485 i_max = ite
1486 ELSE IF ( ite .EQ. ipe ) THEN
1487 i_max = ime
1488 ELSE
1489 i_max = ite
1490 END IF
1491 i_max = MIN(i_max,ide-1)
1493 ! South and north lateral boundaries. This is the i-extent of its through ite, but j only
1494 ! goes to within spec_bdy_width of the top and bottom (north and south) boundaries.
1496 ! South boundary: i,k,j
1497 ! jj increasing
1499 DO jj = MAX(jts,1) , MIN(jte,jde-1,spec_bdy_width)
1500 j = jj
1501 DO k = kts , kte-1
1502 DO i = i_min , i_max
1503 t_bdy_ys (i,k,j) = orig_t_bdy_ys (i,k,j)
1504 t_bdy_tend_ys(i,k,j) = orig_t_bdy_tend_ys(i,k,j)
1505 END DO
1506 END DO
1507 END DO
1508 DO jj = MAX(jts,1) , MIN(jte,jde-1,spec_bdy_width)
1509 j = jj
1510 DO k = kts , kte-1
1511 DO i = i_min , i_max
1512 mu_old_bdy_ys = mu_bdy_ys(i,1,j) + mub(i,jj)
1513 t_old_bdy_ys = ( t_bdy_ys(i,k,j) ) / mu_old_bdy_ys
1514 moist_old_bdy_ys = ( moist_bdy_ys(i,k,j) ) / mu_old_bdy_ys
1515 mu_new_bdy_ys = mu_old_bdy_ys + mu_bdy_tend_ys(i,1,j) *dt_interval
1516 t_new_bdy_ys = ( t_bdy_ys(i,k,j) + t_bdy_tend_ys(i,k,j) *dt_interval ) / mu_new_bdy_ys
1517 moist_new_bdy_ys = ( moist_bdy_ys(i,k,j) + moist_bdy_tend_ys(i,k,j)*dt_interval ) / mu_new_bdy_ys
1518 t_old_bdy_tend_ys = ( t_new_bdy_ys - t_old_bdy_ys ) / dt_interval
1519 moist_old_bdy_tend_ys = ( moist_new_bdy_ys - moist_old_bdy_ys ) / dt_interval
1520 IF ( theta_to_thetam ) THEN
1521 new_t_bdy_ys(i,k,j) = ( ( ( t_old_bdy_ys + T0 ) * ( 1. + (R_v/R_d) * moist_old_bdy_ys ) ) - T0 ) * mu_old_bdy_ys
1522 new_t_bdy_tend_ys(i,k,j) = ( ( mu_new_bdy_ys * ( ( t_new_bdy_ys + T0 ) * ( 1. + (R_v/R_d) * moist_new_bdy_ys ) - T0 ) ) - &
1523 ( mu_old_bdy_ys * ( ( t_old_bdy_ys + T0 ) * ( 1. + (R_v/R_d) * moist_old_bdy_ys ) - T0 ) ) ) / dt_interval
1524 ELSE
1525 new_t_bdy_ys(i,k,j) = ( ( ( t_old_bdy_ys + T0 ) / ( 1. + (R_v/R_d) * moist_old_bdy_ys ) ) - T0 ) * mu_old_bdy_ys
1526 new_t_bdy_tend_ys(i,k,j) = ( ( mu_new_bdy_ys * ( ( t_new_bdy_ys + T0 ) / ( 1. + (R_v/R_d) * moist_new_bdy_ys ) - T0 ) ) - &
1527 ( mu_old_bdy_ys * ( ( t_old_bdy_ys + T0 ) / ( 1. + (R_v/R_d) * moist_old_bdy_ys ) - T0 ) ) ) / dt_interval
1528 END IF
1529 END DO
1530 END DO
1531 END DO
1533 ! North boundary: i,k,j
1534 ! jj decreasing
1536 DO jj = MIN(jde-1,jte) , MAX(jde-spec_bdy_width,jts) , -1
1537 j = jde-jj
1538 DO k = kts , kte-1
1539 DO i = i_min , i_max
1540 t_bdy_ye (i,k,j) = orig_t_bdy_ye (i,k,j)
1541 t_bdy_tend_ye(i,k,j) = orig_t_bdy_tend_ye(i,k,j)
1542 END DO
1543 END DO
1544 END DO
1545 DO jj = MIN(jde-1,jte) , MAX(jde-spec_bdy_width,jts) , -1
1546 j = jde-jj
1547 DO k = kts , kte-1
1548 DO i = i_min , i_max
1549 mu_old_bdy_ye = mu_bdy_ye(i,1,j) + mub(i,jj)
1550 t_old_bdy_ye = ( t_bdy_ye(i,k,j) ) / mu_old_bdy_ye
1551 moist_old_bdy_ye = ( moist_bdy_ye(i,k,j) ) / mu_old_bdy_ye
1552 mu_new_bdy_ye = mu_old_bdy_ye + mu_bdy_tend_ye(i,1,j) *dt_interval
1553 t_new_bdy_ye = ( t_bdy_ye(i,k,j) + t_bdy_tend_ye(i,k,j) *dt_interval ) / mu_new_bdy_ye
1554 moist_new_bdy_ye = ( moist_bdy_ye(i,k,j) + moist_bdy_tend_ye(i,k,j)*dt_interval ) / mu_new_bdy_ye
1555 t_old_bdy_tend_ye = ( t_new_bdy_ye - t_old_bdy_ye ) / dt_interval
1556 moist_old_bdy_tend_ye = ( moist_new_bdy_ye - moist_old_bdy_ye ) / dt_interval
1557 IF ( theta_to_thetam ) THEN
1558 new_t_bdy_ye(i,k,j) = ( ( ( t_old_bdy_ye + T0 ) * ( 1. + (R_v/R_d) * moist_old_bdy_ye ) ) - T0 ) * mu_old_bdy_ye
1559 new_t_bdy_tend_ye(i,k,j) = ( ( mu_new_bdy_ye * ( ( t_new_bdy_ye + T0 ) * ( 1. + (R_v/R_d) * moist_new_bdy_ye ) - T0 ) ) - &
1560 ( mu_old_bdy_ye * ( ( t_old_bdy_ye + T0 ) * ( 1. + (R_v/R_d) * moist_old_bdy_ye ) - T0 ) ) ) / dt_interval
1561 ELSE
1562 new_t_bdy_ye(i,k,j) = ( ( ( t_old_bdy_ye + T0 ) / ( 1. + (R_v/R_d) * moist_old_bdy_ye ) ) - T0 ) * mu_old_bdy_ye
1563 new_t_bdy_tend_ye(i,k,j) = ( ( mu_new_bdy_ye * ( ( t_new_bdy_ye + T0 ) / ( 1. + (R_v/R_d) * moist_new_bdy_ye ) - T0 ) ) - &
1564 ( mu_old_bdy_ye * ( ( t_old_bdy_ye + T0 ) / ( 1. + (R_v/R_d) * moist_old_bdy_ye ) - T0 ) ) ) / dt_interval
1565 END IF
1566 END DO
1567 END DO
1568 END DO
1570 ! The j_min, j_max for the west and east boundaries depends on if we are doing
1571 ! serial, OpenMP, or MPI. For OpenMP, we do not want any overlap between tiles that
1572 ! are on the same task (either OpenMP only, or OpenMP+MPI).
1574 IF ( jts .EQ. jds ) THEN
1575 j_min = jts
1576 ELSE IF ( jts .EQ. jps ) THEN
1577 j_min = jms
1578 ELSE
1579 j_min = jts
1580 END IF
1581 j_min = MAX(jds,j_min)
1583 IF ( jte .EQ. jde ) THEN
1584 j_max = jte
1585 ELSE IF ( jte .EQ. jpe ) THEN
1586 j_max = jme
1587 ELSE
1588 j_max = jte
1589 END IF
1590 j_max = MIN(j_max,jde-1)
1592 ! West and east lateral boundaries. This is the j-extent of jts through jte, but i only
1593 ! goes to within spec_bdy_width of the left and right (west and east) boundaries.
1595 ! West boundary: j,k,i
1596 ! ii increasing
1598 DO ii = MAX(its,1) , MIN(ite,ide-1,spec_bdy_width)
1599 i = ii
1600 DO k = kts , kte-1
1601 DO j = j_min , j_max
1602 t_bdy_xs (j,k,i) = orig_t_bdy_xs (j,k,i)
1603 t_bdy_tend_xs(j,k,i) = orig_t_bdy_tend_xs(j,k,i)
1604 END DO
1605 END DO
1606 END DO
1607 DO ii = MAX(its,1) , MIN(ite,ide-1,spec_bdy_width)
1608 i = ii
1609 DO k = kts , kte-1
1610 DO j = j_min , j_max
1611 mu_old_bdy_xs = mu_bdy_xs(j,1,i) + mub(ii,j)
1612 t_old_bdy_xs = ( t_bdy_xs(j,k,i) ) / mu_old_bdy_xs
1613 moist_old_bdy_xs = ( moist_bdy_xs(j,k,i) ) / mu_old_bdy_xs
1614 mu_new_bdy_xs = mu_old_bdy_xs + mu_bdy_tend_xs(j,1,i) *dt_interval
1615 t_new_bdy_xs = ( t_bdy_xs(j,k,i) + t_bdy_tend_xs(j,k,i) *dt_interval ) / mu_new_bdy_xs
1616 moist_new_bdy_xs = ( moist_bdy_xs(j,k,i) + moist_bdy_tend_xs(j,k,i)*dt_interval ) / mu_new_bdy_xs
1617 t_old_bdy_tend_xs = ( t_new_bdy_xs - t_old_bdy_xs ) / dt_interval
1618 moist_old_bdy_tend_xs = ( moist_new_bdy_xs - moist_old_bdy_xs ) / dt_interval
1619 IF ( theta_to_thetam ) THEN
1620 new_t_bdy_xs(j,k,i) = ( ( ( t_old_bdy_xs + T0 ) * ( 1. + (R_v/R_d) * moist_old_bdy_xs ) ) - T0 ) * mu_old_bdy_xs
1621 new_t_bdy_tend_xs(j,k,i) = ( ( mu_new_bdy_xs * ( ( t_new_bdy_xs + T0 ) * ( 1. + (R_v/R_d) * moist_new_bdy_xs ) - T0 ) ) - &
1622 ( mu_old_bdy_xs * ( ( t_old_bdy_xs + T0 ) * ( 1. + (R_v/R_d) * moist_old_bdy_xs ) - T0 ) ) ) / dt_interval
1623 ELSE
1624 new_t_bdy_xs(j,k,i) = ( ( ( t_old_bdy_xs + T0 ) / ( 1. + (R_v/R_d) * moist_old_bdy_xs ) ) - T0 ) * mu_old_bdy_xs
1625 new_t_bdy_tend_xs(j,k,i) = ( ( mu_new_bdy_xs * ( ( t_new_bdy_xs + T0 ) / ( 1. + (R_v/R_d) * moist_new_bdy_xs ) - T0 ) ) - &
1626 ( mu_old_bdy_xs * ( ( t_old_bdy_xs + T0 ) / ( 1. + (R_v/R_d) * moist_old_bdy_xs ) - T0 ) ) ) / dt_interval
1627 END IF
1628 END DO
1629 END DO
1630 END DO
1632 ! East boundary: j,k,i
1633 ! ii decreasing
1635 DO ii = MIN(ide-1,ite) , MAX(ide-spec_bdy_width,its) , -1
1636 i = ide-ii
1637 DO k = kts , kte-1
1638 DO j = j_min , j_max
1639 t_bdy_xe (j,k,i) = orig_t_bdy_xe (j,k,i)
1640 t_bdy_tend_xe(j,k,i) = orig_t_bdy_tend_xe(j,k,i)
1641 END DO
1642 END DO
1643 END DO
1644 DO ii = MIN(ide-1,ite) , MAX(ide-spec_bdy_width,its) , -1
1645 i = ide-ii
1646 DO k = kts , kte-1
1647 DO j = j_min , j_max
1648 mu_old_bdy_xe = mu_bdy_xe(j,1,i) + mub(ii,j)
1649 t_old_bdy_xe = ( t_bdy_xe(j,k,i) ) / mu_old_bdy_xe
1650 moist_old_bdy_xe = ( moist_bdy_xe(j,k,i) ) / mu_old_bdy_xe
1651 mu_new_bdy_xe = mu_old_bdy_xe + mu_bdy_tend_xe(j,1,i) *dt_interval
1652 t_new_bdy_xe = ( t_bdy_xe(j,k,i) + t_bdy_tend_xe(j,k,i) *dt_interval ) / mu_new_bdy_xe
1653 moist_new_bdy_xe = ( moist_bdy_xe(j,k,i) + moist_bdy_tend_xe(j,k,i)*dt_interval ) / mu_new_bdy_xe
1654 t_old_bdy_tend_xe = ( t_new_bdy_xe - t_old_bdy_xe ) / dt_interval
1655 moist_old_bdy_tend_xe = ( moist_new_bdy_xe - moist_old_bdy_xe ) / dt_interval
1656 IF ( theta_to_thetam ) THEN
1657 new_t_bdy_xe(j,k,i) = ( ( ( t_old_bdy_xe + T0 ) * ( 1. + (R_v/R_d) * moist_old_bdy_xe ) ) - T0 ) * mu_old_bdy_xe
1658 new_t_bdy_tend_xe(j,k,i) = ( ( mu_new_bdy_xe * ( ( t_new_bdy_xe + T0 ) * ( 1. + (R_v/R_d) * moist_new_bdy_xe ) - T0 ) ) - &
1659 ( mu_old_bdy_xe * ( ( t_old_bdy_xe + T0 ) * ( 1. + (R_v/R_d) * moist_old_bdy_xe ) - T0 ) ) ) / dt_interval
1660 ELSE
1661 new_t_bdy_xe(j,k,i) = ( ( ( t_old_bdy_xe + T0 ) / ( 1. + (R_v/R_d) * moist_old_bdy_xe ) ) - T0 ) * mu_old_bdy_xe
1662 new_t_bdy_tend_xe(j,k,i) = ( ( mu_new_bdy_xe * ( ( t_new_bdy_xe + T0 ) / ( 1. + (R_v/R_d) * moist_new_bdy_xe ) - T0 ) ) - &
1663 ( mu_old_bdy_xe * ( ( t_old_bdy_xe + T0 ) / ( 1. + (R_v/R_d) * moist_old_bdy_xe ) - T0 ) ) ) / dt_interval
1664 END IF
1665 END DO
1666 END DO
1667 END DO
1669 ! Put the final values for the tendencies into the arrays that get passed
1670 ! back out to the calling routine.
1672 DO jj = MAX(jts,1) , MIN(jte,jde-1,spec_bdy_width)
1673 j = jj
1674 DO k = kts , kte-1
1675 DO i = i_min , i_max
1676 orig_t_bdy_ys (i,k,j) = new_t_bdy_ys (i,k,j)
1677 orig_t_bdy_tend_ys(i,k,j) = new_t_bdy_tend_ys(i,k,j)
1678 END DO
1679 END DO
1680 END DO
1682 DO jj = MIN(jde-1,jte) , MAX(jde-spec_bdy_width,jts) , -1
1683 j = jde-jj
1684 DO k = kts , kte-1
1685 DO i = i_min , i_max
1686 orig_t_bdy_ye (i,k,j) = new_t_bdy_ye (i,k,j)
1687 orig_t_bdy_tend_ye(i,k,j) = new_t_bdy_tend_ye(i,k,j)
1688 END DO
1689 END DO
1690 END DO
1692 DO ii = its , MIN(ite,ide-1,spec_bdy_width)
1693 i = ii
1694 DO k = kts , kte-1
1695 DO j = j_min , j_max
1696 orig_t_bdy_xs (j,k,i) = new_t_bdy_xs (j,k,i)
1697 orig_t_bdy_tend_xs(j,k,i) = new_t_bdy_tend_xs(j,k,i)
1698 END DO
1699 END DO
1700 END DO
1702 DO ii = MIN(ide-1,ite) , MAX(ide-spec_bdy_width,its) , -1
1703 i = ide-ii
1704 DO k = kts , kte-1
1705 DO j = j_min , j_max
1706 orig_t_bdy_xe (j,k,i) = new_t_bdy_xe (j,k,i)
1707 orig_t_bdy_tend_xe(j,k,i) = new_t_bdy_tend_xe(j,k,i)
1708 END DO
1709 END DO
1710 END DO
1712 END SUBROUTINE theta_and_thetam_lbc_only
1714 !------------------------------------------------------------------------
1716 SUBROUTINE mass_weight ( field , mut, rfield , c1 , c2 , &
1717 ids,ide, jds,jde, kds,kde, & ! domain dims
1718 ims,ime, jms,jme, kms,kme, & ! memory dims
1719 irs,ire, jrs,jre, krs,kre, & ! rfield dims
1720 its,ite, jts,jte, kts,kte ) ! tile dims
1722 IMPLICIT NONE
1724 INTEGER , INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
1725 ims,ime, jms,jme, kms,kme, &
1726 irs,ire, jrs,jre, krs,kre, &
1727 its,ite, jts,jte, kts,kte
1728 REAL , DIMENSION(ims:ime, kms:kme, jms:jme) , INTENT(IN ) :: field
1729 REAL , DIMENSION(ims:ime, jms:jme) , INTENT(IN ) :: mut
1730 REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1, c2
1731 REAL , DIMENSION(irs:ire, krs:kre, jrs:jre) , INTENT( OUT) :: rfield
1733 ! Local loop counters
1735 INTEGER :: i , j , k
1737 DO j = jts , jte
1738 DO k = kts , kte
1739 DO i = its , ite
1740 rfield(i,k,j) = field(i,k,j) * (c1(k)*mut(i,j)+c2(k))
1741 END DO
1742 END DO
1743 END DO
1745 END SUBROUTINE mass_weight
1747 END MODULE module_bc_em