module_bc_em.F
References to this file elsewhere.
1 !WRF:MODEL_LAYER:BOUNDARY
2 !
3 MODULE module_bc_em
4
5 USE module_bc
6 USE module_configure
7 USE module_wrf_error
8
9 CONTAINS
10
11 !------------------------------------------------------------------------
12
13 SUBROUTINE spec_bdyupdate_ph( ph_save, field, &
14 field_tend, mu_tend, muts, dt, &
15 variable_in, config_flags, &
16 spec_zone, &
17 ids,ide, jds,jde, kds,kde, & ! domain dims
18 ims,ime, jms,jme, kms,kme, & ! memory dims
19 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
20 its,ite, jts,jte, kts,kte )
21
22 ! This subroutine adds the tendencies in the boundary specified region.
23 ! spec_zone is the width of the outer specified b.c.s that are set here.
24 ! (JD August 2000)
25
26 IMPLICIT NONE
27
28 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
29 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
30 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
31 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
32 INTEGER, INTENT(IN ) :: spec_zone
33 CHARACTER, INTENT(IN ) :: variable_in
34 REAL, INTENT(IN ) :: dt
35
36
37 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
38 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: field_tend, ph_save
39 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: mu_tend, muts
40 TYPE( grid_config_rec_type ) config_flags
41
42 CHARACTER :: variable
43 INTEGER :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
44 INTEGER :: b_dist, b_limit
45
46 ! Local array
47
48 REAL, DIMENSION( its:ite , jts:jte ) :: mu_old
49 LOGICAL :: periodic_x
50
51 periodic_x = config_flags%periodic_x
52
53 variable = variable_in
54
55 IF (variable == 'U') variable = 'u'
56 IF (variable == 'V') variable = 'v'
57 IF (variable == 'M') variable = 'm'
58 IF (variable == 'H') variable = 'h'
59
60 ibs = ids
61 ibe = ide-1
62 itf = min(ite,ide-1)
63 jbs = jds
64 jbe = jde-1
65 jtf = min(jte,jde-1)
66 ktf = kde-1
67 IF (variable == 'u') ibe = ide
68 IF (variable == 'u') itf = min(ite,ide)
69 IF (variable == 'v') jbe = jde
70 IF (variable == 'v') jtf = min(jte,jde)
71 IF (variable == 'm') ktf = kte
72 IF (variable == 'h') ktf = kte
73
74 IF (jts - jbs .lt. spec_zone) THEN
75 ! Y-start boundary
76 DO j = jts, min(jtf,jbs+spec_zone-1)
77 b_dist = j - jbs
78 b_limit = b_dist
79 IF(periodic_x)b_limit = 0
80 DO k = kts, ktf
81 DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
82
83 mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
84
85 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
86 dt*field_tend(i,k,j)/muts(i,j) + &
87 ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
88
89 ENDDO
90 ENDDO
91 ENDDO
92 ENDIF
93 IF (jbe - jtf .lt. spec_zone) THEN
94 ! Y-end boundary
95 DO j = max(jts,jbe-spec_zone+1), jtf
96 b_dist = jbe - j
97 b_limit = b_dist
98 IF(periodic_x)b_limit = 0
99 DO k = kts, ktf
100 DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
101
102 mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
103
104 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
105 dt*field_tend(i,k,j)/muts(i,j) + &
106 ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
107
108 ENDDO
109 ENDDO
110 ENDDO
111 ENDIF
112
113 IF(.NOT.periodic_x)THEN
114 IF (its - ibs .lt. spec_zone) THEN
115 ! X-start boundary
116 DO i = its, min(itf,ibs+spec_zone-1)
117 b_dist = i - ibs
118 DO k = kts, ktf
119 DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
120
121 mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
122
123 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
124 dt*field_tend(i,k,j)/muts(i,j) + &
125 ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
126
127 ENDDO
128 ENDDO
129 ENDDO
130 ENDIF
131
132 IF (ibe - itf .lt. spec_zone) THEN
133 ! X-end boundary
134 DO i = max(its,ibe-spec_zone+1), itf
135 b_dist = ibe - i
136 DO k = kts, ktf
137 DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
138
139 mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
140
141 field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
142 dt*field_tend(i,k,j)/muts(i,j) + &
143 ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
144
145 ENDDO
146 ENDDO
147 ENDDO
148 ENDIF
149 ENDIF
150
151 END SUBROUTINE spec_bdyupdate_ph
152
153 !------------------------------------------------------------------------
154
155 SUBROUTINE relax_bdy_dry ( config_flags, &
156 ru_tendf, rv_tendf, ph_tendf, t_tendf, &
157 rw_tendf, mu_tend, &
158 ru, rv, ph, t, &
159 w, mu, mut, &
160 u_b, v_b, ph_b, t_b, &
161 w_b, mu_b, &
162 u_bt, v_bt, ph_bt, t_bt, &
163 w_bt, mu_bt, &
164 spec_bdy_width, spec_zone, relax_zone, &
165 dtbc, fcx, gcx, &
166 ijds, ijde, & ! min/max(id,jd)
167 ids,ide, jds,jde, kds,kde, & ! domain dims
168 ims,ime, jms,jme, kms,kme, & ! memory dims
169 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
170 its, ite, jts, jte, kts, kte)
171 IMPLICIT NONE
172
173 ! Input data.
174 TYPE( grid_config_rec_type ) config_flags
175
176 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
177 ims, ime, jms, jme, kms, kme, &
178 ips, ipe, jps, jpe, kps, kpe, &
179 its, ite, jts, jte, kts, kte
180 INTEGER , INTENT(IN ) :: ijds, ijde
181 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone, relax_zone
182
183 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: ru, &
184 rv, &
185 ph, &
186 w, &
187 t
188 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu , &
189 mut
190 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: ru_tendf, &
191 rv_tendf, &
192 ph_tendf, &
193 rw_tendf, &
194 t_tendf
195 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: mu_tend
196 REAL , DIMENSION( spec_bdy_width) , INTENT(IN ) :: fcx, gcx
197
198 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN ) :: u_b, &
199 v_b, &
200 ph_b, &
201 w_b, &
202 t_b, &
203 u_bt, &
204 v_bt, &
205 ph_bt, &
206 w_bt, &
207 t_bt
208
209 REAL, DIMENSION( ijds:ijde , 1:1 , spec_bdy_width, 4 ), INTENT(IN ) :: mu_b, &
210 mu_bt
211 REAL, INTENT(IN ) :: dtbc
212
213 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: rfield
214 INTEGER :: i_start, i_end, j_start, j_end, i, j, k
215
216 CALL relax_bdytend ( ru, ru_tendf, &
217 u_b, u_bt, &
218 'u' , config_flags, &
219 spec_bdy_width, spec_zone, relax_zone, &
220 dtbc, fcx, gcx, &
221 ijds, ijde, & ! min/max(id,jd)
222 ids,ide, jds,jde, kds,kde, & ! domain dims
223 ims,ime, jms,jme, kms,kme, & ! memory dims
224 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
225 its,ite, jts,jte, kts,kte )
226 CALL relax_bdytend ( rv, rv_tendf, &
227 v_b, v_bt, &
228 'v' , config_flags, &
229 spec_bdy_width, spec_zone, relax_zone, &
230 dtbc, fcx, gcx, &
231 ijds, ijde, & ! min/max(id,jd)
232 ids,ide, jds,jde, kds,kde, & ! domain dims
233 ims,ime, jms,jme, kms,kme, & ! memory dims
234 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
235 its,ite, jts,jte, kts,kte )
236
237 ! rfield will be calculated beyond tile limits because relax_bdytend
238 ! requires a 5-point stencil, and this avoids need for inter-tile/patch
239 ! communication here
240 i_start = max(its-1, ids)
241 i_end = min(ite+1, ide-1)
242 j_start = max(jts-1, jds)
243 j_end = min(jte+1, jde-1)
244
245 DO j=j_start,j_end
246 DO k=kts,kte
247 DO i=i_start,i_end
248 rfield(i,k,j) = ph(i,k,j)*mut(i,j)
249 ENDDO
250 ENDDO
251 ENDDO
252
253 CALL relax_bdytend ( rfield, ph_tendf, &
254 ph_b, ph_bt, &
255 'h' , config_flags, &
256 spec_bdy_width, spec_zone, relax_zone, &
257 dtbc, fcx, gcx, &
258 ijds, ijde, & ! min/max(id,jd)
259 ids,ide, jds,jde, kds,kde, & ! domain dims
260 ims,ime, jms,jme, kms,kme, & ! memory dims
261 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
262 its,ite, jts,jte, kts,kte )
263 DO j=j_start,j_end
264 DO k=kts,kte-1
265 DO i=i_start,i_end
266 rfield(i,k,j) = t(i,k,j)*mut(i,j)
267 ENDDO
268 ENDDO
269 ENDDO
270 CALL relax_bdytend ( rfield, t_tendf, &
271 t_b, t_bt, &
272 't' , config_flags, &
273 spec_bdy_width, spec_zone, relax_zone, &
274 dtbc, fcx, gcx, &
275 ijds, ijde, & ! min/max(id,jd)
276 ids,ide, jds,jde, kds,kde, & ! domain dims
277 ims,ime, jms,jme, kms,kme, & ! memory dims
278 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
279 its,ite, jts,jte, kts,kte )
280 CALL relax_bdytend ( mu, mu_tend, &
281 mu_b, mu_bt, &
282 'm' , config_flags, &
283 spec_bdy_width, spec_zone, relax_zone, &
284 dtbc, fcx, gcx, &
285 ijds, ijde, & ! min/max(id,jd)
286 ids,ide, jds,jde, 1 ,1 , & ! domain dims
287 ims,ime, jms,jme, 1 ,1 , & ! memory dims
288 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
289 its,ite, jts,jte, 1 ,1 )
290
291 IF( config_flags%nested) THEN
292
293 i_start = max(its-1, ids)
294 i_end = min(ite+1, ide-1)
295 j_start = max(jts-1, jds)
296 j_end = min(jte+1, jde-1)
297
298 DO j=j_start,j_end
299 DO k=kts,kte
300 DO i=i_start,i_end
301 rfield(i,k,j) = w(i,k,j)*mut(i,j)
302 ENDDO
303 ENDDO
304 ENDDO
305
306 CALL relax_bdytend ( rfield, rw_tendf, &
307 w_b, w_bt, &
308 'h' , config_flags, &
309 spec_bdy_width, spec_zone, relax_zone, &
310 dtbc, fcx, gcx, &
311 ijds, ijde, & ! min/max(id,jd)
312 ids,ide, jds,jde, kds,kde, & ! domain dims
313 ims,ime, jms,jme, kms,kme, & ! memory dims
314 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
315 its,ite, jts,jte, kts,kte )
316
317 END IF
318
319 END SUBROUTINE relax_bdy_dry
320 !------------------------------------------------------------------------
321 SUBROUTINE relax_bdy_scalar ( scalar_tend, &
322 scalar, mu, &
323 scalar_b, scalar_bt, &
324 spec_bdy_width, spec_zone, relax_zone, &
325 dtbc, fcx, gcx, &
326 config_flags, &
327 ijds, ijde, & ! min/max(id,jd)
328 ids,ide, jds,jde, kds,kde, & ! domain dims
329 ims,ime, jms,jme, kms,kme, & ! memory dims
330 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
331 its, ite, jts, jte, kts, kte)
332 IMPLICIT NONE
333
334 ! Input data.
335 TYPE( grid_config_rec_type ) config_flags
336
337 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
338 ims, ime, jms, jme, kms, kme, &
339 ips, ipe, jps, jpe, kps, kpe, &
340 its, ite, jts, jte, kts, kte
341 INTEGER , INTENT(IN ) :: ijds, ijde
342 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone, relax_zone
343
344 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: scalar
345 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu
346 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: scalar_tend
347 REAL , DIMENSION( spec_bdy_width) , INTENT(IN ) :: fcx, gcx
348
349 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN ) :: scalar_b, &
350 scalar_bt
351 REAL, INTENT(IN ) :: dtbc
352 !Local
353 INTEGER :: i,j,k, i_start, i_end, j_start, j_end
354 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: rscalar
355
356 ! rscalar will be calculated beyond tile limits because relax_bdytend
357 ! requires a 5-point stencil, and this avoids need for inter-tile/patch
358 ! communication here
359 i_start = max(its-1, ids)
360 i_end = min(ite+1, ide-1)
361 j_start = max(jts-1, jds)
362 j_end = min(jte+1, jde-1)
363
364 DO j=j_start,j_end
365 DO k=kts,min(kte,kde-1)
366 DO i=i_start,i_end
367 rscalar(i,k,j) = scalar(i,k,j)*mu(i,j)
368 ENDDO
369 ENDDO
370 ENDDO
371
372 CALL relax_bdytend (rscalar, scalar_tend, &
373 scalar_b, scalar_bt, &
374 'q' , config_flags, &
375 spec_bdy_width, spec_zone, relax_zone, &
376 dtbc, fcx, gcx, &
377 ijds, ijde, & ! min/max(id,jd)
378 ids,ide, jds,jde, kds,kde, & ! domain dims
379 ims,ime, jms,jme, kms,kme, & ! memory dims
380 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
381 its,ite, jts,jte, kts,kte )
382
383
384 END SUBROUTINE relax_bdy_scalar
385
386 !------------------------------------------------------------------------
387 SUBROUTINE spec_bdy_dry ( config_flags, &
388 ru_tend, rv_tend, ph_tend, t_tend, &
389 rw_tend, mu_tend, &
390 u_b, v_b, ph_b, t_b, &
391 w_b, mu_b, &
392 u_bt, v_bt, ph_bt, t_bt, &
393 w_bt, mu_bt, &
394 spec_bdy_width, spec_zone, &
395 ijds, ijde, & ! min/max(id,jd)
396 ids,ide, jds,jde, kds,kde, & ! domain dims
397 ims,ime, jms,jme, kms,kme, & ! memory dims
398 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
399 its, ite, jts, jte, kts, kte)
400 IMPLICIT NONE
401
402 ! Input data.
403 TYPE( grid_config_rec_type ) config_flags
404
405
406 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
407 ims, ime, jms, jme, kms, kme, &
408 ips, ipe, jps, jpe, kps, kpe, &
409 its, ite, jts, jte, kts, kte
410 INTEGER , INTENT(IN ) :: ijds, ijde
411 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
412
413 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT ) :: ru_tend, &
414 rv_tend, &
415 ph_tend, &
416 rw_tend, &
417 t_tend
418 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(OUT ) :: mu_tend
419 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN ) :: u_b, &
420 v_b, &
421 ph_b, &
422 w_b, &
423 t_b, &
424 u_bt, &
425 v_bt, &
426 ph_bt, &
427 w_bt, &
428 t_bt
429
430 REAL, DIMENSION( ijds:ijde , 1:1 , spec_bdy_width, 4 ), INTENT(IN ) :: mu_b, &
431 mu_bt
432
433 CALL spec_bdytend ( ru_tend, &
434 u_b, u_bt, &
435 'u' , config_flags, &
436 spec_bdy_width, spec_zone, &
437 ijds, ijde, & ! min/max(id,jd)
438 ids,ide, jds,jde, kds,kde, & ! domain dims
439 ims,ime, jms,jme, kms,kme, & ! memory dims
440 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
441 its,ite, jts,jte, kts,kte )
442 CALL spec_bdytend ( rv_tend, &
443 v_b, v_bt, &
444 'v' , config_flags, &
445 spec_bdy_width, spec_zone, &
446 ijds, ijde, & ! min/max(id,jd)
447 ids,ide, jds,jde, kds,kde, & ! domain dims
448 ims,ime, jms,jme, kms,kme, & ! memory dims
449 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
450 its,ite, jts,jte, kts,kte )
451 CALL spec_bdytend ( ph_tend, &
452 ph_b, ph_bt, &
453 'h' , config_flags, &
454 spec_bdy_width, spec_zone, &
455 ijds, ijde, & ! min/max(id,jd)
456 ids,ide, jds,jde, kds,kde, & ! domain dims
457 ims,ime, jms,jme, kms,kme, & ! memory dims
458 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
459 its,ite, jts,jte, kts,kte )
460 CALL spec_bdytend ( t_tend, &
461 t_b, t_bt, &
462 't' , config_flags, &
463 spec_bdy_width, spec_zone, &
464 ijds, ijde, & ! min/max(id,jd)
465 ids,ide, jds,jde, kds,kde, & ! domain dims
466 ims,ime, jms,jme, kms,kme, & ! memory dims
467 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
468 its,ite, jts,jte, kts,kte )
469 CALL spec_bdytend ( mu_tend, &
470 mu_b, mu_bt, &
471 'm' , config_flags, &
472 spec_bdy_width, spec_zone, &
473 ijds, ijde, & ! min/max(id,jd)
474 ids,ide, jds,jde, 1 ,1 , & ! domain dims
475 ims,ime, jms,jme, 1 ,1 , & ! memory dims
476 ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
477 its,ite, jts,jte, 1 ,1 )
478
479 if(config_flags%nested) &
480 CALL spec_bdytend ( rw_tend, &
481 w_b, w_bt, &
482 'h' , config_flags, &
483 spec_bdy_width, spec_zone, &
484 ijds, ijde, & ! min/max(id,jd)
485 ids,ide, jds,jde, kds,kde, & ! domain dims
486 ims,ime, jms,jme, kms,kme, & ! memory dims
487 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
488 its,ite, jts,jte, kts,kte )
489
490 END SUBROUTINE spec_bdy_dry
491
492 !------------------------------------------------------------------------
493 SUBROUTINE spec_bdy_scalar ( scalar_tend, &
494 scalar_b, scalar_bt, &
495 spec_bdy_width, spec_zone, &
496 config_flags, &
497 ijds, ijde, & ! min/max(id,jd)
498 ids,ide, jds,jde, kds,kde, & ! domain dims
499 ims,ime, jms,jme, kms,kme, & ! memory dims
500 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
501 its, ite, jts, jte, kts, kte)
502 IMPLICIT NONE
503
504 ! Input data.
505 TYPE( grid_config_rec_type ) config_flags
506
507
508 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
509 ims, ime, jms, jme, kms, kme, &
510 ips, ipe, jps, jpe, kps, kpe, &
511 its, ite, jts, jte, kts, kte
512 INTEGER , INTENT(IN ) :: ijds, ijde
513 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
514
515 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT ) :: scalar_tend
516 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN ) :: scalar_b, &
517 scalar_bt
518 !Local
519 INTEGER :: i,j,k
520
521
522 CALL spec_bdytend ( scalar_tend, &
523 scalar_b, scalar_bt, &
524 ! scalar_xbdy, scalar_ybdy, &
525 'q' , config_flags, &
526 spec_bdy_width, spec_zone, &
527 ijds, ijde, & ! min/max(id,jd)
528 ids,ide, jds,jde, kds,kde, & ! domain dims
529 ims,ime, jms,jme, kms,kme, & ! memory dims
530 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
531 its,ite, jts,jte, kts,kte )
532
533
534 END SUBROUTINE spec_bdy_scalar
535
536 !------------------------------------------------------------------------
537
538 SUBROUTINE set_phys_bc_dry_1( config_flags, u_1, u_2, v_1, v_2, &
539 rw_1, rw_2, w_1, w_2, &
540 t_1, t_2, tp_1, tp_2, pp, pip, &
541 ids,ide, jds,jde, kds,kde, &
542 ims,ime, jms,jme, kms,kme, &
543 ips,ipe, jps,jpe, kps,kpe, &
544 its,ite, jts,jte, kts,kte )
545
546 !
547 ! this is just a wraper to call the boundary condition routines
548 ! for each variable
549 !
550
551 IMPLICIT NONE
552
553 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
554 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
555 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
556 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
557
558 TYPE( grid_config_rec_type ) config_flags
559
560 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
561 u_1,u_2, v_1, v_2, rw_1, rw_2, w_1, w_2, &
562 t_1, t_2, tp_1, tp_2, pp, pip
563
564
565
566 CALL set_physical_bc3d( u_1 , 'u', config_flags, &
567 ids, ide, jds, jde, kds, kde, &
568 ims, ime, jms, jme, kms, kme, &
569 ips, ipe, jps, jpe, kps, kpe, &
570 its, ite, jts, jte, kts, kte )
571 CALL set_physical_bc3d( u_2 , 'u', config_flags, &
572 ids, ide, jds, jde, kds, kde, &
573 ims, ime, jms, jme, kms, kme, &
574 ips, ipe, jps, jpe, kps, kpe, &
575 its, ite, jts, jte, kts, kte )
576 CALL set_physical_bc3d( v_1 , 'v', config_flags, &
577 ids, ide, jds, jde, kds, kde, &
578 ims, ime, jms, jme, kms, kme, &
579 ips, ipe, jps, jpe, kps, kpe, &
580 its, ite, jts, jte, kts, kte )
581 CALL set_physical_bc3d( v_2 , 'v', config_flags, &
582 ids, ide, jds, jde, kds, kde, &
583 ims, ime, jms, jme, kms, kme, &
584 ips, ipe, jps, jpe, kps, kpe, &
585 its, ite, jts, jte, kts, kte )
586 CALL set_physical_bc3d( rw_1 , 'w', config_flags, &
587 ids, ide, jds, jde, kds, kde, &
588 ims, ime, jms, jme, kms, kme, &
589 ips, ipe, jps, jpe, kps, kpe, &
590 its, ite, jts, jte, kts, kte )
591 CALL set_physical_bc3d( rw_2 , 'w', config_flags, &
592 ids, ide, jds, jde, kds, kde, &
593 ims, ime, jms, jme, kms, kme, &
594 ips, ipe, jps, jpe, kps, kpe, &
595 its, ite, jts, jte, kts, kte )
596 CALL set_physical_bc3d( w_1 , 'w', config_flags, &
597 ids, ide, jds, jde, kds, kde, &
598 ims, ime, jms, jme, kms, kme, &
599 ips, ipe, jps, jpe, kps, kpe, &
600 its, ite, jts, jte, kts, kte )
601 CALL set_physical_bc3d( w_2 , 'w', config_flags, &
602 ids, ide, jds, jde, kds, kde, &
603 ims, ime, jms, jme, kms, kme, &
604 ips, ipe, jps, jpe, kps, kpe, &
605 its, ite, jts, jte, kts, kte )
606 CALL set_physical_bc3d( t_1, 'p', config_flags, &
607 ids, ide, jds, jde, kds, kde, &
608 ims, ime, jms, jme, kms, kme, &
609 ips, ipe, jps, jpe, kps, kpe, &
610 its, ite, jts, jte, kts, kte )
611 CALL set_physical_bc3d( t_2, 'p', config_flags, &
612 ids, ide, jds, jde, kds, kde, &
613 ims, ime, jms, jme, kms, kme, &
614 ips, ipe, jps, jpe, kps, kpe, &
615 its, ite, jts, jte, kts, kte )
616 CALL set_physical_bc3d( tp_1, 'p', config_flags, &
617 ids, ide, jds, jde, kds, kde, &
618 ims, ime, jms, jme, kms, kme, &
619 ips, ipe, jps, jpe, kps, kpe, &
620 its, ite, jts, jte, kts, kte )
621 CALL set_physical_bc3d( tp_2, 'p', config_flags, &
622 ids, ide, jds, jde, kds, kde, &
623 ims, ime, jms, jme, kms, kme, &
624 ips, ipe, jps, jpe, kps, kpe, &
625 its, ite, jts, jte, kts, kte )
626 CALL set_physical_bc3d( pp , 'p', config_flags, &
627 ids, ide, jds, jde, kds, kde, &
628 ims, ime, jms, jme, kms, kme, &
629 ips, ipe, jps, jpe, kps, kpe, &
630 its, ite, jts, jte, kts, kte )
631 CALL set_physical_bc3d( pip , 'p', config_flags, &
632 ids, ide, jds, jde, kds, kde, &
633 ims, ime, jms, jme, kms, kme, &
634 ips, ipe, jps, jpe, kps, kpe, &
635 its, ite, jts, jte, kts, kte )
636
637 END SUBROUTINE set_phys_bc_dry_1
638
639 !--------------------------------------------------------------
640
641 SUBROUTINE set_phys_bc_dry_2( config_flags, &
642 u_1, u_2, v_1, v_2, w_1, w_2, &
643 t_1, t_2, ph_1, ph_2, mu_1, mu_2, &
644 ids,ide, jds,jde, kds,kde, &
645 ims,ime, jms,jme, kms,kme, &
646 ips,ipe, jps,jpe, kps,kpe, &
647 its,ite, jts,jte, kts,kte )
648
649 !
650 ! this is just a wraper to call the boundary condition routines
651 ! for each variable
652 !
653
654 IMPLICIT NONE
655
656 TYPE( grid_config_rec_type ) config_flags
657
658 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
659 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
660 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
661 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
662
663 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
664 u_1, u_2, v_1, v_2, w_1, w_2, &
665 t_1, t_2, ph_1, ph_2
666
667 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
668 mu_1, mu_2
669
670
671 CALL set_physical_bc3d( u_1, 'U', config_flags, &
672 ids, ide, jds, jde, kds, kde, &
673 ims, ime, jms, jme, kms, kme, &
674 ips, ipe, jps, jpe, kps, kpe, &
675 its, ite, jts, jte, kts, kte )
676
677 CALL set_physical_bc3d( u_2, 'U', config_flags, &
678 ids, ide, jds, jde, kds, kde, &
679 ims, ime, jms, jme, kms, kme, &
680 ips, ipe, jps, jpe, kps, kpe, &
681 its, ite, jts, jte, kts, kte )
682
683 CALL set_physical_bc3d( v_1 , 'V', config_flags, &
684 ids, ide, jds, jde, kds, kde, &
685 ims, ime, jms, jme, kms, kme, &
686 ips, ipe, jps, jpe, kps, kpe, &
687 its, ite, jts, jte, kts, kte )
688 CALL set_physical_bc3d( v_2 , 'V', config_flags, &
689 ids, ide, jds, jde, kds, kde, &
690 ims, ime, jms, jme, kms, kme, &
691 ips, ipe, jps, jpe, kps, kpe, &
692 its, ite, jts, jte, kts, kte )
693
694 CALL set_physical_bc3d( w_1, 'w', config_flags, &
695 ids, ide, jds, jde, kds, kde, &
696 ims, ime, jms, jme, kms, kme, &
697 ips, ipe, jps, jpe, kps, kpe, &
698 its, ite, jts, jte, kts, kte )
699 CALL set_physical_bc3d( w_2, 'w', config_flags, &
700 ids, ide, jds, jde, kds, kde, &
701 ims, ime, jms, jme, kms, kme, &
702 ips, ipe, jps, jpe, kps, kpe, &
703 its, ite, jts, jte, kts, kte )
704
705 CALL set_physical_bc3d( t_1, 'p', config_flags, &
706 ids, ide, jds, jde, kds, kde, &
707 ims, ime, jms, jme, kms, kme, &
708 ips, ipe, jps, jpe, kps, kpe, &
709 its, ite, jts, jte, kts, kte )
710
711 CALL set_physical_bc3d( t_2, 'p', config_flags, &
712 ids, ide, jds, jde, kds, kde, &
713 ims, ime, jms, jme, kms, kme, &
714 ips, ipe, jps, jpe, kps, kpe, &
715 its, ite, jts, jte, kts, kte )
716
717 CALL set_physical_bc3d( ph_1 , 'w', config_flags, &
718 ids, ide, jds, jde, kds, kde, &
719 ims, ime, jms, jme, kms, kme, &
720 ips, ipe, jps, jpe, kps, kpe, &
721 its, ite, jts, jte, kts, kte )
722
723 CALL set_physical_bc3d( ph_2 , 'w', config_flags, &
724 ids, ide, jds, jde, kds, kde, &
725 ims, ime, jms, jme, kms, kme, &
726 ips, ipe, jps, jpe, kps, kpe, &
727 its, ite, jts, jte, kts, kte )
728
729 CALL set_physical_bc2d( mu_1, 't', config_flags, &
730 ids, ide, jds, jde, &
731 ims, ime, jms, jme, &
732 ips, ipe, jps, jpe, &
733 its, ite, jts, jte )
734
735 CALL set_physical_bc2d( mu_2, 't', config_flags, &
736 ids, ide, jds, jde, &
737 ims, ime, jms, jme, &
738 ips, ipe, jps, jpe, &
739 its, ite, jts, jte )
740
741 END SUBROUTINE set_phys_bc_dry_2
742
743 !------------------------------------------------------------------------
744
745 SUBROUTINE set_phys_bc_smallstep_1( config_flags, ru_1, du, rv_1, dv, &
746 ids,ide, jds,jde, kds,kde, &
747 ims,ime, jms,jme, kms,kme, &
748 ips,ipe, jps,jpe, kps,kpe, &
749 its,ite, jts,jte, kts,kte )
750
751 !
752 ! this is just a wraper to call the boundary condition routines
753 ! for each variable
754 !
755
756 IMPLICIT NONE
757
758 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
759 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
760 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
761 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
762
763 TYPE( grid_config_rec_type ) config_flags
764
765 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
766 ru_1,du, rv_1, dv
767
768 CALL set_physical_bc3d( ru_1 , 'u', 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, kde )
773 CALL set_physical_bc3d( du , 'u', 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, kde )
778 CALL set_physical_bc3d( rv_1 , 'v', 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, kde )
783 CALL set_physical_bc3d( dv , 'v', 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, kde )
788
789 END SUBROUTINE set_phys_bc_smallstep_1
790
791 !-------------------------------------------------------------------
792
793 SUBROUTINE rk_phys_bc_dry_1( config_flags, u, v, rw, w, &
794 muu, muv, mut, php, alt, p, &
795 ids,ide, jds,jde, kds,kde, &
796 ims,ime, jms,jme, kms,kme, &
797 ips,ipe, jps,jpe, kps,kpe, &
798 its,ite, jts,jte, kts,kte )
799
800 !
801 ! this is just a wraper to call the boundary condition routines
802 ! for each variable
803 !
804
805 IMPLICIT NONE
806
807 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
808 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
809 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
810 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
811
812 TYPE( grid_config_rec_type ) config_flags
813
814 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
815 INTENT(INOUT) :: u, v, rw, w, php, alt, p
816 REAL, DIMENSION( ims:ime, jms:jme ), &
817 INTENT(INOUT) :: muu, muv, mut
818
819 CALL set_physical_bc3d( u , 'u', config_flags, &
820 ids, ide, jds, jde, kds, kde, &
821 ims, ime, jms, jme, kms, kme, &
822 ips, ipe, jps, jpe, kps, kpe, &
823 its, ite, jts, jte, kts, kte )
824 CALL set_physical_bc3d( v , 'v', config_flags, &
825 ids, ide, jds, jde, kds, kde, &
826 ims, ime, jms, jme, kms, kme, &
827 ips, ipe, jps, jpe, kps, kpe, &
828 its, ite, jts, jte, kts, kte )
829 CALL set_physical_bc3d(rw , 'w', config_flags, &
830 ids, ide, jds, jde, kds, kde, &
831 ims, ime, jms, jme, kms, kme, &
832 ips, ipe, jps, jpe, kps, kpe, &
833 its, ite, jts, jte, kts, kte )
834 CALL set_physical_bc3d( w , 'w', config_flags, &
835 ids, ide, jds, jde, kds, kde, &
836 ims, ime, jms, jme, kms, kme, &
837 ips, ipe, jps, jpe, kps, kpe, &
838 its, ite, jts, jte, kts, kte )
839 CALL set_physical_bc3d( php , 'w', config_flags, &
840 ids, ide, jds, jde, kds, kde, &
841 ims, ime, jms, jme, kms, kme, &
842 ips, ipe, jps, jpe, kps, kpe, &
843 its, ite, jts, jte, kts, kte )
844 CALL set_physical_bc3d( alt, 't', 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 )
849
850 CALL set_physical_bc3d( p, 'p', 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
856 CALL set_physical_bc2d( muu, 'u', config_flags, &
857 ids, ide, jds, jde, &
858 ims, ime, jms, jme, &
859 ips, ipe, jps, jpe, &
860 its, ite, jts, jte )
861
862 CALL set_physical_bc2d( muv, 'v', config_flags, &
863 ids, ide, jds, jde, &
864 ims, ime, jms, jme, &
865 ips, ipe, jps, jpe, &
866 its, ite, jts, jte )
867
868 CALL set_physical_bc2d( mut, 't', config_flags, &
869 ids, ide, jds, jde, &
870 ims, ime, jms, jme, &
871 ips, ipe, jps, jpe, &
872 its, ite, jts, jte )
873
874 END SUBROUTINE rk_phys_bc_dry_1
875
876 !------------------------------------------------------------------------
877
878 SUBROUTINE rk_phys_bc_dry_2( config_flags, u, v, w, &
879 t, ph, mu, &
880 ids,ide, jds,jde, kds,kde, &
881 ims,ime, jms,jme, kms,kme, &
882 ips,ipe, jps,jpe, kps,kpe, &
883 its,ite, jts,jte, kts,kte )
884
885 !
886 ! this is just a wraper to call the boundary condition routines
887 ! for each variable
888 !
889
890 IMPLICIT NONE
891
892 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
893 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
894 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
895 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
896
897 TYPE( grid_config_rec_type ) config_flags
898
899 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
900 u, v, w, t, ph
901
902 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
903 mu
904
905 CALL set_physical_bc3d( u , 'U', config_flags, &
906 ids, ide, jds, jde, kds, kde, &
907 ims, ime, jms, jme, kms, kme, &
908 ips, ipe, jps, jpe, kps, kpe, &
909 its, ite, jts, jte, kts, kte )
910 CALL set_physical_bc3d( v , 'V', config_flags, &
911 ids, ide, jds, jde, kds, kde, &
912 ims, ime, jms, jme, kms, kme, &
913 ips, ipe, jps, jpe, kps, kpe, &
914 its, ite, jts, jte, kts, kte )
915 CALL set_physical_bc3d( w , 'w', config_flags, &
916 ids, ide, jds, jde, kds, kde, &
917 ims, ime, jms, jme, kms, kme, &
918 ips, ipe, jps, jpe, kps, kpe, &
919 its, ite, jts, jte, kts, kte )
920 CALL set_physical_bc3d( t, 'p', config_flags, &
921 ids, ide, jds, jde, kds, kde, &
922 ims, ime, jms, jme, kms, kme, &
923 ips, ipe, jps, jpe, kps, kpe, &
924 its, ite, jts, jte, kts, kte )
925 CALL set_physical_bc3d( ph , 'w', config_flags, &
926 ids, ide, jds, jde, kds, kde, &
927 ims, ime, jms, jme, kms, kme, &
928 ips, ipe, jps, jpe, kps, kpe, &
929 its, ite, jts, jte, kts, kte )
930
931 CALL set_physical_bc2d( mu, 't', config_flags, &
932 ids, ide, jds, jde, &
933 ims, ime, jms, jme, &
934 ips, ipe, jps, jpe, &
935 its, ite, jts, jte )
936
937 END SUBROUTINE rk_phys_bc_dry_2
938
939 !---------------------------------------------------------------------
940
941 SUBROUTINE set_w_surface( config_flags, &
942 w, ht, u, v, cf1, cf2, cf3, rdx, rdy, msft, &
943 ids, ide, jds, jde, kds, kde, &
944 ips, ipe, jps, jpe, kps, kpe, &
945 its, ite, jts, jte, kts, kte, &
946 ims, ime, jms, jme, kms, kme )
947 implicit none
948
949 TYPE( grid_config_rec_type ) config_flags
950
951 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
952 ims, ime, jms, jme, kms, kme, &
953 its, ite, jts, jte, kts, kte, &
954 ips, ipe, jps, jpe, kps, kpe
955
956 REAL :: cf1, cf2, cf3, rdx, rdy
957
958
959 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , &
960 INTENT(IN ) :: u, &
961 v
962
963 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , &
964 INTENT(INOUT) :: w
965
966 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: ht, msft
967
968 INTEGER :: i,j
969 INTEGER :: ip1,im1,jp1,jm1
970
971 ! set kinematic lower boundary condition on W
972
973 DO j = jts,min(jte,jde-1)
974 jm1 = max(j-1,jds)
975 jp1 = min(j+1,jde-1)
976 DO i = its,min(ite,ide-1)
977 im1 = max(i-1,ids)
978 ip1 = min(i+1,ide-1)
979
980 w(i,1,j)= msft(i,j)*( &
981 .5*rdy*( &
982 (ht(i,jp1)-ht(i,j )) &
983 *(cf1*v(i,1,j+1)+cf2*v(i,2,j+1)+cf3*v(i,3,j+1)) &
984 +(ht(i,j )-ht(i,jm1)) &
985 *(cf1*v(i,1,j )+cf2*v(i,2,j )+cf3*v(i,3,j )) ) &
986 +.5*rdx*( &
987 (ht(ip1,j)-ht(i,j )) &
988 *(cf1*u(i+1,1,j)+cf2*u(i+1,2,j)+cf3*u(i+1,3,j)) &
989 +(ht(i ,j)-ht(im1,j)) &
990 *(cf1*u(i ,1,j)+cf2*u(i ,2,j)+cf3*u(i ,3,j)) ) &
991 )
992 ENDDO
993 ENDDO
994
995 END SUBROUTINE set_w_surface
996
997 END MODULE module_bc_em