Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_bc_em.F @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 60.0 KB

Line
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	#ifdef LMDZ1
51	INTEGER :: im2,km2,jm2
52
53	im2 = config_flags%i_check_point
54	jm2 = config_flags%j_check_point
55	km2 = config_flags%k_check_point
56
57	PRINT *,' module_bc_em: inside'
58	PRINT *,' variable in: ',variable_in
59	PRINT *,' save: ',ph_save(im2,km2,jm2), ' field: ', field(im2,1,jm2), &
60	' field_tend: ',field_tend(im2,1,jm2),' mu_tend: ',mu_tend(im2,jm2), &
61	' muts: ',muts(im2,jm2),' dt: ',dt,' spec_zone: ',spec_zone
62	#endif
63
64	periodic_x = config_flags%periodic_x
65
66	variable = variable_in
67
68	IF (variable == 'U') variable = 'u'
69	IF (variable == 'V') variable = 'v'
70	IF (variable == 'M') variable = 'm'
71	IF (variable == 'H') variable = 'h'
72
73	ibs = ids
74	ibe = ide-1
75	itf = min(ite,ide-1)
76	jbs = jds
77	jbe = jde-1
78	jtf = min(jte,jde-1)
79	ktf = kde-1
80	IF (variable == 'u') ibe = ide
81	IF (variable == 'u') itf = min(ite,ide)
82	IF (variable == 'v') jbe = jde
83	IF (variable == 'v') jtf = min(jte,jde)
84	IF (variable == 'm') ktf = kte
85	IF (variable == 'h') ktf = kte
86
87	IF (jts - jbs .lt. spec_zone) THEN
88	! Y-start boundary
89	DO j = jts, min(jtf,jbs+spec_zone-1)
90	b_dist = j - jbs
91	b_limit = b_dist
92	IF(periodic_x)b_limit = 0
93	DO k = kts, ktf
94	DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
95
96	mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
97
98	field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
99	dt*field_tend(i,k,j)/muts(i,j) + &
100	ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
101
102	ENDDO
103	ENDDO
104	ENDDO
105	ENDIF
106	#ifdef LMDZ1
107	PRINT *,' module_bc_em: after Y-start boundary'
108	PRINT *,' variable in: ',variable_in
109	PRINT *,' save: ',ph_save(im2,km2,jm2), ' field: ', field(im2,1,jm2), &
110	' field_tend: ',field_tend(im2,1,jm2),' mu_tend: ',mu_tend(im2,jm2), &
111	' muts: ',muts(im2,jm2),' dt: ',dt,' spec_zone: ',spec_zone
112	#endif
113	IF (jbe - jtf .lt. spec_zone) THEN
114	! Y-end boundary
115	DO j = max(jts,jbe-spec_zone+1), jtf
116	b_dist = jbe - j
117	b_limit = b_dist
118	IF(periodic_x)b_limit = 0
119	DO k = kts, ktf
120	DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit)
121
122	mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
123
124	field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
125	dt*field_tend(i,k,j)/muts(i,j) + &
126	ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
127
128	ENDDO
129	ENDDO
130	ENDDO
131	ENDIF
132	#ifdef LMDZ1
133	PRINT *,' module_bc_em: after Y-end boundary'
134	PRINT *,' variable in: ',variable_in
135	PRINT *,' save: ',ph_save(im2,km2,jm2), ' field: ', field(im2,1,jm2), &
136	' field_tend: ',field_tend(im2,1,jm2),' mu_tend: ',mu_tend(im2,jm2), &
137	' muts: ',muts(im2,jm2),' dt: ',dt,' spec_zone: ',spec_zone
138	#endif
139
140	IF(.NOT.periodic_x)THEN
141	IF (its - ibs .lt. spec_zone) THEN
142	! X-start boundary
143	DO i = its, min(itf,ibs+spec_zone-1)
144	b_dist = i - ibs
145	DO k = kts, ktf
146	DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
147
148	mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
149
150	field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
151	dt*field_tend(i,k,j)/muts(i,j) + &
152	ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
153
154	ENDDO
155	ENDDO
156	ENDDO
157	ENDIF
158	#ifdef LMDZ1
159	PRINT *,' module_bc_em: after NOT periodic_x'
160	PRINT *,' variable in: ',variable_in
161	PRINT *,' save: ',ph_save(im2,km2,jm2), ' field: ', field(im2,1,jm2), &
162	' field_tend: ',field_tend(im2,1,jm2),' mu_tend: ',mu_tend(im2,jm2), &
163	' muts: ',muts(im2,jm2),' dt: ',dt,' spec_zone: ',spec_zone
164	#endif
165	IF (ibe - itf .lt. spec_zone) THEN
166	! X-end boundary
167	DO i = max(its,ibe-spec_zone+1), itf
168	b_dist = ibe - i
169	DO k = kts, ktf
170	DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1)
171
172	mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j)
173
174	field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + &
175	dt*field_tend(i,k,j)/muts(i,j) + &
176	ph_save(i,k,j)*(mu_old(i,j)/muts(i,j) - 1.)
177
178	ENDDO
179	ENDDO
180	ENDDO
181	ENDIF
182	ENDIF
183	#ifdef LMDZ1
184	PRINT *,' module_bc_em: after X-end boundary'
185	PRINT *,' variable in: ',variable_in
186	PRINT *,' save: ',ph_save(im2,km2,jm2), ' field: ', field(im2,1,jm2), &
187	' field_tend: ',field_tend(im2,1,jm2),' mu_tend: ',mu_tend(im2,jm2), &
188	' muts: ',muts(im2,jm2),' dt: ',dt,' spec_zone: ',spec_zone
189	#endif
190
191	END SUBROUTINE spec_bdyupdate_ph
192
193	!------------------------------------------------------------------------
194
195	SUBROUTINE relax_bdy_dry ( config_flags, &
196	ru_tendf, rv_tendf, ph_tendf, t_tendf, &
197	rw_tendf, mu_tend, &
198	ru, rv, ph, t, &
199	w, mu, mut, &
200	u_bxs,u_bxe,u_bys,u_bye, &
201	v_bxs,v_bxe,v_bys,v_bye, &
202	ph_bxs,ph_bxe,ph_bys,ph_bye, &
203	t_bxs,t_bxe,t_bys,t_bye, &
204	w_bxs,w_bxe,w_bys,w_bye, &
205	mu_bxs,mu_bxe,mu_bys,mu_bye, &
206	u_btxs,u_btxe,u_btys,u_btye, &
207	v_btxs,v_btxe,v_btys,v_btye, &
208	ph_btxs,ph_btxe,ph_btys,ph_btye, &
209	t_btxs,t_btxe,t_btys,t_btye, &
210	w_btxs,w_btxe,w_btys,w_btye, &
211	mu_btxs,mu_btxe,mu_btys,mu_btye, &
212	spec_bdy_width, spec_zone, relax_zone, &
213	dtbc, fcx, gcx, &
214	ids,ide, jds,jde, kds,kde, & ! domain dims
215	ims,ime, jms,jme, kms,kme, & ! memory dims
216	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
217	its, ite, jts, jte, kts, kte)
218	IMPLICIT NONE
219
220	! Input data.
221	TYPE( grid_config_rec_type ) config_flags
222
223	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
224	ims, ime, jms, jme, kms, kme, &
225	ips, ipe, jps, jpe, kps, kpe, &
226	its, ite, jts, jte, kts, kte
227	INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone, relax_zone
228
229	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: ru, &
230	rv, &
231	ph, &
232	w, &
233	t
234	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu , &
235	mut
236	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: ru_tendf, &
237	rv_tendf, &
238	ph_tendf, &
239	rw_tendf, &
240	t_tendf
241	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: mu_tend
242	REAL , DIMENSION( spec_bdy_width) , INTENT(IN ) :: fcx, gcx
243
244	REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bxs,u_bxe, &
245	v_bxs,v_bxe, &
246	ph_bxs,ph_bxe, &
247	w_bxs,w_bxe, &
248	t_bxs,t_bxe, &
249	u_btxs,u_btxe, &
250	v_btxs,v_btxe, &
251	ph_btxs,ph_btxe, &
252	w_btxs,w_btxe, &
253	t_btxs,t_btxe
254
255	REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bys,u_bye, &
256	v_bys,v_bye, &
257	ph_bys,ph_bye, &
258	w_bys,w_bye, &
259	t_bys,t_bye, &
260	u_btys,u_btye, &
261	v_btys,v_btye, &
262	ph_btys,ph_btye, &
263	w_btys,w_btye, &
264	t_btys,t_btye
265
266
267	REAL, DIMENSION( jms:jme , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bxs,mu_bxe, &
268	mu_btxs,mu_btxe
269
270	REAL, DIMENSION( ims:ime , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bys,mu_bye, &
271	mu_btys,mu_btye
272	REAL, INTENT(IN ) :: dtbc
273
274	! changed to tile dimensions, 20090923, JM
275	REAL , DIMENSION( its-1:ite+1 , kts:kte, jts-1:jte+1 ) :: rfield
276	INTEGER :: i_start, i_end, j_start, j_end, i, j, k
277
278	CALL relax_bdytend ( ru, ru_tendf, &
279	u_bxs,u_bxe,u_bys,u_bye,u_btxs,u_btxe,u_btys,u_btye, &
280	'u' , config_flags, &
281	spec_bdy_width, spec_zone, relax_zone, &
282	dtbc, fcx, gcx, &
283	ids,ide, jds,jde, kds,kde, & ! domain dims
284	ims,ime, jms,jme, kms,kme, & ! memory dims
285	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
286	its,ite, jts,jte, kts,kte )
287	CALL relax_bdytend ( rv, rv_tendf, &
288	v_bxs,v_bxe,v_bys,v_bye,v_btxs,v_btxe,v_btys,v_btye, &
289	'v' , config_flags, &
290	spec_bdy_width, spec_zone, relax_zone, &
291	dtbc, fcx, gcx, &
292	ids,ide, jds,jde, kds,kde, & ! domain dims
293	ims,ime, jms,jme, kms,kme, & ! memory dims
294	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
295	its,ite, jts,jte, kts,kte )
296
297	! rfield will be calculated beyond tile limits because relax_bdytend
298	! requires a 5-point stencil, and this avoids need for inter-tile/patch
299	! communication here
300	i_start = max(its-1, ids)
301	i_end = min(ite+1, ide-1)
302	j_start = max(jts-1, jds)
303	j_end = min(jte+1, jde-1)
304
305	DO j=j_start,j_end
306	DO k=kts,kte
307	DO i=i_start,i_end
308	rfield(i,k,j) = ph(i,k,j)*mut(i,j)
309	ENDDO
310	ENDDO
311	ENDDO
312	CALL relax_bdytend_tile ( rfield, ph_tendf, &
313	ph_bxs,ph_bxe,ph_bys,ph_bye, ph_btxs,ph_btxe,ph_btys,ph_btye, &
314	'h' , config_flags, &
315	spec_bdy_width, spec_zone, relax_zone, &
316	dtbc, fcx, gcx, &
317	ids,ide, jds,jde, kds,kde, & ! domain dims
318	ims,ime, jms,jme, kms,kme, & ! memory dims
319	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
320	its,ite, jts,jte, kts,kte, &
321	its-1, ite+1, jts-1,jte+1,kts,kte ) ! dims of first argument
322	DO j=j_start,j_end
323	DO k=kts,kte-1
324	DO i=i_start,i_end
325	rfield(i,k,j) = t(i,k,j)*mut(i,j)
326	ENDDO
327	ENDDO
328	ENDDO
329	CALL relax_bdytend_tile ( rfield, t_tendf, &
330	t_bxs,t_bxe,t_bys,t_bye, t_btxs,t_btxe,t_btys,t_btye, &
331	't' , config_flags, &
332	spec_bdy_width, spec_zone, relax_zone, &
333	dtbc, fcx, gcx, &
334	ids,ide, jds,jde, kds,kde, & ! domain dims
335	ims,ime, jms,jme, kms,kme, & ! memory dims
336	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
337	its,ite, jts,jte, kts,kte, &
338	its-1, ite+1, jts-1,jte+1,kts,kte ) ! dims of first argument
339	CALL relax_bdytend ( mu, mu_tend, &
340	mu_bxs,mu_bxe,mu_bys,mu_bye, mu_btxs,mu_btxe,mu_btys,mu_btye, &
341	'm' , config_flags, &
342	spec_bdy_width, spec_zone, relax_zone, &
343	dtbc, fcx, gcx, &
344	ids,ide, jds,jde, 1 ,1 , & ! domain dims
345	ims,ime, jms,jme, 1 ,1 , & ! memory dims
346	ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
347	its,ite, jts,jte, 1 ,1 )
348
349	IF( config_flags%nested) THEN
350
351	i_start = max(its-1, ids)
352	i_end = min(ite+1, ide-1)
353	j_start = max(jts-1, jds)
354	j_end = min(jte+1, jde-1)
355
356	DO j=j_start,j_end
357	DO k=kts,kte
358	DO i=i_start,i_end
359	rfield(i,k,j) = w(i,k,j)*mut(i,j)
360	ENDDO
361	ENDDO
362	ENDDO
363
364	CALL relax_bdytend_tile ( rfield, rw_tendf, &
365	w_bxs,w_bxe,w_bys,w_bye, w_btxs,w_btxe,w_btys,w_btye, &
366	'h' , config_flags, &
367	spec_bdy_width, spec_zone, relax_zone, &
368	dtbc, fcx, gcx, &
369	ids,ide, jds,jde, kds,kde, & ! domain dims
370	ims,ime, jms,jme, kms,kme, & ! memory dims
371	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
372	its,ite, jts,jte, kts,kte, &
373	its-1, ite+1, jts-1,jte+1,kts,kte ) ! dims of first argument
374
375	END IF
376
377	END SUBROUTINE relax_bdy_dry
378	!------------------------------------------------------------------------
379	SUBROUTINE relax_bdy_scalar ( scalar_tend, &
380	scalar, mu, &
381	scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, &
382	scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
383	spec_bdy_width, spec_zone, relax_zone, &
384	dtbc, fcx, gcx, &
385	config_flags, &
386	ids,ide, jds,jde, kds,kde, & ! domain dims
387	ims,ime, jms,jme, kms,kme, & ! memory dims
388	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
389	its, ite, jts, jte, kts, kte)
390	IMPLICIT NONE
391
392	! Input data.
393	TYPE( grid_config_rec_type ) config_flags
394
395	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
396	ims, ime, jms, jme, kms, kme, &
397	ips, ipe, jps, jpe, kps, kpe, &
398	its, ite, jts, jte, kts, kte
399	INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone, relax_zone
400
401	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: scalar
402	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu
403	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: scalar_tend
404	REAL , DIMENSION( spec_bdy_width) , INTENT(IN ) :: fcx, gcx
405
406	REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bxs,scalar_bxe, &
407	scalar_btxs,scalar_btxe
408	REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bys,scalar_bye, &
409	scalar_btys,scalar_btye
410	REAL, INTENT(IN ) :: dtbc
411	!Local
412	INTEGER :: i,j,k, i_start, i_end, j_start, j_end
413	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: rscalar
414
415	! rscalar will be calculated beyond tile limits because relax_bdytend
416	! requires a 5-point stencil, and this avoids need for inter-tile/patch
417	! communication here
418	i_start = max(its-1, ids)
419	i_end = min(ite+1, ide-1)
420	j_start = max(jts-1, jds)
421	j_end = min(jte+1, jde-1)
422
423	DO j=j_start,j_end
424	DO k=kts,min(kte,kde-1)
425	DO i=i_start,i_end
426	rscalar(i,k,j) = scalar(i,k,j)*mu(i,j)
427	ENDDO
428	ENDDO
429	ENDDO
430
431	CALL relax_bdytend (rscalar, scalar_tend, &
432	scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
433	'q' , config_flags, &
434	spec_bdy_width, spec_zone, relax_zone, &
435	dtbc, fcx, gcx, &
436	ids,ide, jds,jde, kds,kde, & ! domain dims
437	ims,ime, jms,jme, kms,kme, & ! memory dims
438	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
439	its,ite, jts,jte, kts,kte )
440
441
442	END SUBROUTINE relax_bdy_scalar
443
444	!------------------------------------------------------------------------
445	SUBROUTINE spec_bdy_dry ( config_flags, &
446	ru_tend, rv_tend, ph_tend, t_tend, &
447	rw_tend, mu_tend, &
448	u_bxs,u_bxe,u_bys,u_bye, &
449	v_bxs,v_bxe,v_bys,v_bye, &
450	ph_bxs,ph_bxe,ph_bys,ph_bye, &
451	t_bxs,t_bxe,t_bys,t_bye, &
452	w_bxs,w_bxe,w_bys,w_bye, &
453	mu_bxs,mu_bxe,mu_bys,mu_bye, &
454	u_btxs,u_btxe,u_btys,u_btye, &
455	v_btxs,v_btxe,v_btys,v_btye, &
456	ph_btxs,ph_btxe,ph_btys,ph_btye, &
457	t_btxs,t_btxe,t_btys,t_btye, &
458	w_btxs,w_btxe,w_btys,w_btye, &
459	mu_btxs,mu_btxe,mu_btys,mu_btye, &
460	spec_bdy_width, spec_zone, &
461	ids,ide, jds,jde, kds,kde, & ! domain dims
462	ims,ime, jms,jme, kms,kme, & ! memory dims
463	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
464	its, ite, jts, jte, kts, kte)
465	IMPLICIT NONE
466
467	! Input data.
468	TYPE( grid_config_rec_type ) config_flags
469
470
471	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
472	ims, ime, jms, jme, kms, kme, &
473	ips, ipe, jps, jpe, kps, kpe, &
474	its, ite, jts, jte, kts, kte
475	INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
476
477	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT ) :: ru_tend, &
478	rv_tend, &
479	ph_tend, &
480	rw_tend, &
481	t_tend
482	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(OUT ) :: mu_tend
483
484	REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bxs,u_bxe, &
485	v_bxs,v_bxe, &
486	ph_bxs,ph_bxe, &
487	w_bxs,w_bxe, &
488	t_bxs,t_bxe, &
489	u_btxs,u_btxe, &
490	v_btxs,v_btxe, &
491	ph_btxs,ph_btxe, &
492	w_btxs,w_btxe, &
493	t_btxs,t_btxe
494
495	REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bys,u_bye, &
496	v_bys,v_bye, &
497	ph_bys,ph_bye, &
498	w_bys,w_bye, &
499	t_bys,t_bye, &
500	u_btys,u_btye, &
501	v_btys,v_btye, &
502	ph_btys,ph_btye, &
503	w_btys,w_btye, &
504	t_btys,t_btye
505
506	REAL, DIMENSION( jms:jme , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bxs,mu_bxe, &
507	mu_btxs,mu_btxe
508
509	REAL, DIMENSION( ims:ime , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bys,mu_bye, &
510	mu_btys,mu_btye
511	CALL spec_bdytend ( ru_tend, &
512	u_bxs,u_bxe,u_bys,u_bye, u_btxs,u_btxe,u_btys,u_btye, &
513	'u' , config_flags, &
514	spec_bdy_width, spec_zone, &
515	ids,ide, jds,jde, kds,kde, & ! domain dims
516	ims,ime, jms,jme, kms,kme, & ! memory dims
517	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
518	its,ite, jts,jte, kts,kte )
519	CALL spec_bdytend ( rv_tend, &
520	v_bxs,v_bxe,v_bys,v_bye, v_btxs,v_btxe,v_btys,v_btye, &
521	'v' , config_flags, &
522	spec_bdy_width, spec_zone, &
523	ids,ide, jds,jde, kds,kde, & ! domain dims
524	ims,ime, jms,jme, kms,kme, & ! memory dims
525	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
526	its,ite, jts,jte, kts,kte )
527	CALL spec_bdytend ( ph_tend, &
528	ph_bxs,ph_bxe,ph_bys,ph_bye, ph_btxs,ph_btxe,ph_btys,ph_btye, &
529	'h' , config_flags, &
530	spec_bdy_width, spec_zone, &
531	ids,ide, jds,jde, kds,kde, & ! domain dims
532	ims,ime, jms,jme, kms,kme, & ! memory dims
533	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
534	its,ite, jts,jte, kts,kte )
535	CALL spec_bdytend ( t_tend, &
536	t_bxs,t_bxe,t_bys,t_bye, t_btxs,t_btxe,t_btys,t_btye, &
537	't' , config_flags, &
538	spec_bdy_width, spec_zone, &
539	ids,ide, jds,jde, kds,kde, & ! domain dims
540	ims,ime, jms,jme, kms,kme, & ! memory dims
541	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
542	its,ite, jts,jte, kts,kte )
543	CALL spec_bdytend ( mu_tend, &
544	mu_bxs,mu_bxe,mu_bys,mu_bye, mu_btxs,mu_btxe,mu_btys,mu_btye, &
545	'm' , config_flags, &
546	spec_bdy_width, spec_zone, &
547	ids,ide, jds,jde, 1 ,1 , & ! domain dims
548	ims,ime, jms,jme, 1 ,1 , & ! memory dims
549	ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
550	its,ite, jts,jte, 1 ,1 )
551
552	if(config_flags%nested) &
553	CALL spec_bdytend ( rw_tend, &
554	w_bxs,w_bxe,w_bys,w_bye, w_btxs,w_btxe,w_btys,w_btye, &
555	'h' , config_flags, &
556	spec_bdy_width, spec_zone, &
557	ids,ide, jds,jde, kds,kde, & ! domain dims
558	ims,ime, jms,jme, kms,kme, & ! memory dims
559	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
560	its,ite, jts,jte, kts,kte )
561
562	END SUBROUTINE spec_bdy_dry
563
564	!------------------------------------------------------------------------
565	SUBROUTINE spec_bdy_scalar ( scalar_tend, &
566	scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, &
567	scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
568	spec_bdy_width, spec_zone, &
569	config_flags, &
570	ids,ide, jds,jde, kds,kde, & ! domain dims
571	ims,ime, jms,jme, kms,kme, & ! memory dims
572	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
573	its, ite, jts, jte, kts, kte)
574	IMPLICIT NONE
575
576	! Input data.
577	TYPE( grid_config_rec_type ) config_flags
578
579
580	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
581	ims, ime, jms, jme, kms, kme, &
582	ips, ipe, jps, jpe, kps, kpe, &
583	its, ite, jts, jte, kts, kte
584	INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
585
586	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT ) :: scalar_tend
587
588	REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bxs,scalar_bxe, &
589	scalar_btxs,scalar_btxe
590
591	REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bys,scalar_bye, &
592	scalar_btys,scalar_btye
593
594	!Local
595	INTEGER :: i,j,k
596
597
598	CALL spec_bdytend ( scalar_tend, &
599	scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
600	'q' , config_flags, &
601	spec_bdy_width, spec_zone, &
602	ids,ide, jds,jde, kds,kde, & ! domain dims
603	ims,ime, jms,jme, kms,kme, & ! memory dims
604	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
605	its,ite, jts,jte, kts,kte )
606
607
608	END SUBROUTINE spec_bdy_scalar
609
610	!------------------------------------------------------------------------
611
612	SUBROUTINE set_phys_bc_dry_1( config_flags, u_1, u_2, v_1, v_2, &
613	rw_1, rw_2, w_1, w_2, &
614	t_1, t_2, tp_1, tp_2, pp, pip, &
615	ids,ide, jds,jde, kds,kde, &
616	ims,ime, jms,jme, kms,kme, &
617	ips,ipe, jps,jpe, kps,kpe, &
618	its,ite, jts,jte, kts,kte )
619
620	!
621	! this is just a wraper to call the boundary condition routines
622	! for each variable
623	!
624
625	IMPLICIT NONE
626
627	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
628	INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
629	INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
630	INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
631
632	TYPE( grid_config_rec_type ) config_flags
633
634	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
635	u_1,u_2, v_1, v_2, rw_1, rw_2, w_1, w_2, &
636	t_1, t_2, tp_1, tp_2, pp, pip
637
638
639
640	CALL set_physical_bc3d( u_1 , 'u', config_flags, &
641	ids, ide, jds, jde, kds, kde, &
642	ims, ime, jms, jme, kms, kme, &
643	ips, ipe, jps, jpe, kps, kpe, &
644	its, ite, jts, jte, kts, kte )
645	CALL set_physical_bc3d( u_2 , 'u', config_flags, &
646	ids, ide, jds, jde, kds, kde, &
647	ims, ime, jms, jme, kms, kme, &
648	ips, ipe, jps, jpe, kps, kpe, &
649	its, ite, jts, jte, kts, kte )
650	CALL set_physical_bc3d( v_1 , 'v', config_flags, &
651	ids, ide, jds, jde, kds, kde, &
652	ims, ime, jms, jme, kms, kme, &
653	ips, ipe, jps, jpe, kps, kpe, &
654	its, ite, jts, jte, kts, kte )
655	CALL set_physical_bc3d( v_2 , 'v', config_flags, &
656	ids, ide, jds, jde, kds, kde, &
657	ims, ime, jms, jme, kms, kme, &
658	ips, ipe, jps, jpe, kps, kpe, &
659	its, ite, jts, jte, kts, kte )
660	CALL set_physical_bc3d( rw_1 , 'w', config_flags, &
661	ids, ide, jds, jde, kds, kde, &
662	ims, ime, jms, jme, kms, kme, &
663	ips, ipe, jps, jpe, kps, kpe, &
664	its, ite, jts, jte, kts, kte )
665	CALL set_physical_bc3d( rw_2 , 'w', config_flags, &
666	ids, ide, jds, jde, kds, kde, &
667	ims, ime, jms, jme, kms, kme, &
668	ips, ipe, jps, jpe, kps, kpe, &
669	its, ite, jts, jte, kts, kte )
670	CALL set_physical_bc3d( w_1 , 'w', config_flags, &
671	ids, ide, jds, jde, kds, kde, &
672	ims, ime, jms, jme, kms, kme, &
673	ips, ipe, jps, jpe, kps, kpe, &
674	its, ite, jts, jte, kts, kte )
675	CALL set_physical_bc3d( w_2 , 'w', config_flags, &
676	ids, ide, jds, jde, kds, kde, &
677	ims, ime, jms, jme, kms, kme, &
678	ips, ipe, jps, jpe, kps, kpe, &
679	its, ite, jts, jte, kts, kte )
680	CALL set_physical_bc3d( t_1, 'p', config_flags, &
681	ids, ide, jds, jde, kds, kde, &
682	ims, ime, jms, jme, kms, kme, &
683	ips, ipe, jps, jpe, kps, kpe, &
684	its, ite, jts, jte, kts, kte )
685	CALL set_physical_bc3d( t_2, 'p', config_flags, &
686	ids, ide, jds, jde, kds, kde, &
687	ims, ime, jms, jme, kms, kme, &
688	ips, ipe, jps, jpe, kps, kpe, &
689	its, ite, jts, jte, kts, kte )
690	CALL set_physical_bc3d( tp_1, 'p', config_flags, &
691	ids, ide, jds, jde, kds, kde, &
692	ims, ime, jms, jme, kms, kme, &
693	ips, ipe, jps, jpe, kps, kpe, &
694	its, ite, jts, jte, kts, kte )
695	CALL set_physical_bc3d( tp_2, 'p', config_flags, &
696	ids, ide, jds, jde, kds, kde, &
697	ims, ime, jms, jme, kms, kme, &
698	ips, ipe, jps, jpe, kps, kpe, &
699	its, ite, jts, jte, kts, kte )
700	CALL set_physical_bc3d( pp , 'p', config_flags, &
701	ids, ide, jds, jde, kds, kde, &
702	ims, ime, jms, jme, kms, kme, &
703	ips, ipe, jps, jpe, kps, kpe, &
704	its, ite, jts, jte, kts, kte )
705	CALL set_physical_bc3d( pip , '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	END SUBROUTINE set_phys_bc_dry_1
712
713	!--------------------------------------------------------------
714
715	SUBROUTINE set_phys_bc_dry_2( config_flags, &
716	u_1, u_2, v_1, v_2, w_1, w_2, &
717	t_1, t_2, ph_1, ph_2, mu_1, mu_2, &
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	!
724	! this is just a wraper to call the boundary condition routines
725	! for each variable
726	!
727
728	IMPLICIT NONE
729
730	TYPE( grid_config_rec_type ) config_flags
731
732	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
733	INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
734	INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
735	INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
736
737	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
738	u_1, u_2, v_1, v_2, w_1, w_2, &
739	t_1, t_2, ph_1, ph_2
740
741	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
742	mu_1, mu_2
743
744
745	CALL set_physical_bc3d( u_1, 'U', config_flags, &
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	CALL set_physical_bc3d( u_2, 'U', config_flags, &
752	ids, ide, jds, jde, kds, kde, &
753	ims, ime, jms, jme, kms, kme, &
754	ips, ipe, jps, jpe, kps, kpe, &
755	its, ite, jts, jte, kts, kte )
756
757	CALL set_physical_bc3d( v_1 , 'V', config_flags, &
758	ids, ide, jds, jde, kds, kde, &
759	ims, ime, jms, jme, kms, kme, &
760	ips, ipe, jps, jpe, kps, kpe, &
761	its, ite, jts, jte, kts, kte )
762	CALL set_physical_bc3d( v_2 , 'V', config_flags, &
763	ids, ide, jds, jde, kds, kde, &
764	ims, ime, jms, jme, kms, kme, &
765	ips, ipe, jps, jpe, kps, kpe, &
766	its, ite, jts, jte, kts, kte )
767
768	CALL set_physical_bc3d( w_1, '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( w_2, 'w', 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
779	CALL set_physical_bc3d( t_1, 'p', config_flags, &
780	ids, ide, jds, jde, kds, kde, &
781	ims, ime, jms, jme, kms, kme, &
782	ips, ipe, jps, jpe, kps, kpe, &
783	its, ite, jts, jte, kts, kte )
784
785	CALL set_physical_bc3d( t_2, 'p', config_flags, &
786	ids, ide, jds, jde, kds, kde, &
787	ims, ime, jms, jme, kms, kme, &
788	ips, ipe, jps, jpe, kps, kpe, &
789	its, ite, jts, jte, kts, kte )
790
791	CALL set_physical_bc3d( ph_1 , 'w', config_flags, &
792	ids, ide, jds, jde, kds, kde, &
793	ims, ime, jms, jme, kms, kme, &
794	ips, ipe, jps, jpe, kps, kpe, &
795	its, ite, jts, jte, kts, kte )
796
797	CALL set_physical_bc3d( ph_2 , 'w', config_flags, &
798	ids, ide, jds, jde, kds, kde, &
799	ims, ime, jms, jme, kms, kme, &
800	ips, ipe, jps, jpe, kps, kpe, &
801	its, ite, jts, jte, kts, kte )
802
803	CALL set_physical_bc2d( mu_1, 't', config_flags, &
804	ids, ide, jds, jde, &
805	ims, ime, jms, jme, &
806	ips, ipe, jps, jpe, &
807	its, ite, jts, jte )
808
809	CALL set_physical_bc2d( mu_2, 't', config_flags, &
810	ids, ide, jds, jde, &
811	ims, ime, jms, jme, &
812	ips, ipe, jps, jpe, &
813	its, ite, jts, jte )
814
815	END SUBROUTINE set_phys_bc_dry_2
816
817	!------------------------------------------------------------------------
818
819	SUBROUTINE set_phys_bc_smallstep_1( config_flags, ru_1, du, rv_1, dv, &
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
825	!
826	! this is just a wraper to call the boundary condition routines
827	! for each variable
828	!
829
830	IMPLICIT NONE
831
832	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
833	INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
834	INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
835	INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
836
837	TYPE( grid_config_rec_type ) config_flags
838
839	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
840	ru_1,du, rv_1, dv
841
842	CALL set_physical_bc3d( ru_1 , 'u', config_flags, &
843	ids, ide, jds, jde, kds, kde, &
844	ims, ime, jms, jme, kms, kme, &
845	ips, ipe, jps, jpe, kps, kpe, &
846	its, ite, jts, jte, kts, kde )
847	CALL set_physical_bc3d( du , 'u', config_flags, &
848	ids, ide, jds, jde, kds, kde, &
849	ims, ime, jms, jme, kms, kme, &
850	ips, ipe, jps, jpe, kps, kpe, &
851	its, ite, jts, jte, kts, kde )
852	CALL set_physical_bc3d( rv_1 , 'v', config_flags, &
853	ids, ide, jds, jde, kds, kde, &
854	ims, ime, jms, jme, kms, kme, &
855	ips, ipe, jps, jpe, kps, kpe, &
856	its, ite, jts, jte, kts, kde )
857	CALL set_physical_bc3d( dv , 'v', config_flags, &
858	ids, ide, jds, jde, kds, kde, &
859	ims, ime, jms, jme, kms, kme, &
860	ips, ipe, jps, jpe, kps, kpe, &
861	its, ite, jts, jte, kts, kde )
862
863	END SUBROUTINE set_phys_bc_smallstep_1
864
865	!-------------------------------------------------------------------
866
867	SUBROUTINE rk_phys_bc_dry_1( config_flags, u, v, rw, w, &
868	muu, muv, mut, php, alt, p, &
869	ids,ide, jds,jde, kds,kde, &
870	ims,ime, jms,jme, kms,kme, &
871	ips,ipe, jps,jpe, kps,kpe, &
872	its,ite, jts,jte, kts,kte )
873
874	!
875	! this is just a wraper to call the boundary condition routines
876	! for each variable
877	!
878
879	IMPLICIT NONE
880
881	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
882	INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
883	INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
884	INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
885
886	TYPE( grid_config_rec_type ) config_flags
887
888	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
889	INTENT(INOUT) :: u, v, rw, w, php, alt, p
890	REAL, DIMENSION( ims:ime, jms:jme ), &
891	INTENT(INOUT) :: muu, muv, mut
892
893	CALL set_physical_bc3d( u , 'u', config_flags, &
894	ids, ide, jds, jde, kds, kde, &
895	ims, ime, jms, jme, kms, kme, &
896	ips, ipe, jps, jpe, kps, kpe, &
897	its, ite, jts, jte, kts, kte )
898	CALL set_physical_bc3d( v , 'v', config_flags, &
899	ids, ide, jds, jde, kds, kde, &
900	ims, ime, jms, jme, kms, kme, &
901	ips, ipe, jps, jpe, kps, kpe, &
902	its, ite, jts, jte, kts, kte )
903	CALL set_physical_bc3d(rw , 'w', config_flags, &
904	ids, ide, jds, jde, kds, kde, &
905	ims, ime, jms, jme, kms, kme, &
906	ips, ipe, jps, jpe, kps, kpe, &
907	its, ite, jts, jte, kts, kte )
908	CALL set_physical_bc3d( w , 'w', config_flags, &
909	ids, ide, jds, jde, kds, kde, &
910	ims, ime, jms, jme, kms, kme, &
911	ips, ipe, jps, jpe, kps, kpe, &
912	its, ite, jts, jte, kts, kte )
913	CALL set_physical_bc3d( php , 'w', config_flags, &
914	ids, ide, jds, jde, kds, kde, &
915	ims, ime, jms, jme, kms, kme, &
916	ips, ipe, jps, jpe, kps, kpe, &
917	its, ite, jts, jte, kts, kte )
918	CALL set_physical_bc3d( alt, 't', config_flags, &
919	ids, ide, jds, jde, kds, kde, &
920	ims, ime, jms, jme, kms, kme, &
921	ips, ipe, jps, jpe, kps, kpe, &
922	its, ite, jts, jte, kts, kte )
923
924	CALL set_physical_bc3d( p, 'p', config_flags, &
925	ids, ide, jds, jde, kds, kde, &
926	ims, ime, jms, jme, kms, kme, &
927	ips, ipe, jps, jpe, kps, kpe, &
928	its, ite, jts, jte, kts, kte )
929
930	CALL set_physical_bc2d( muu, 'u', config_flags, &
931	ids, ide, jds, jde, &
932	ims, ime, jms, jme, &
933	ips, ipe, jps, jpe, &
934	its, ite, jts, jte )
935
936	CALL set_physical_bc2d( muv, 'v', config_flags, &
937	ids, ide, jds, jde, &
938	ims, ime, jms, jme, &
939	ips, ipe, jps, jpe, &
940	its, ite, jts, jte )
941
942	CALL set_physical_bc2d( mut, 't', config_flags, &
943	ids, ide, jds, jde, &
944	ims, ime, jms, jme, &
945	ips, ipe, jps, jpe, &
946	its, ite, jts, jte )
947
948	END SUBROUTINE rk_phys_bc_dry_1
949
950	!------------------------------------------------------------------------
951
952	SUBROUTINE rk_phys_bc_dry_2( config_flags, u, v, w, &
953	t, ph, mu, &
954	ids,ide, jds,jde, kds,kde, &
955	ims,ime, jms,jme, kms,kme, &
956	ips,ipe, jps,jpe, kps,kpe, &
957	its,ite, jts,jte, kts,kte )
958
959	!
960	! this is just a wraper to call the boundary condition routines
961	! for each variable
962	!
963
964	IMPLICIT NONE
965
966	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
967	INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
968	INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
969	INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
970
971	TYPE( grid_config_rec_type ) config_flags
972
973	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
974	u, v, w, t, ph
975
976	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
977	mu
978
979	CALL set_physical_bc3d( u , 'U', config_flags, &
980	ids, ide, jds, jde, kds, kde, &
981	ims, ime, jms, jme, kms, kme, &
982	ips, ipe, jps, jpe, kps, kpe, &
983	its, ite, jts, jte, kts, kte )
984	CALL set_physical_bc3d( v , 'V', config_flags, &
985	ids, ide, jds, jde, kds, kde, &
986	ims, ime, jms, jme, kms, kme, &
987	ips, ipe, jps, jpe, kps, kpe, &
988	its, ite, jts, jte, kts, kte )
989	CALL set_physical_bc3d( w , 'w', config_flags, &
990	ids, ide, jds, jde, kds, kde, &
991	ims, ime, jms, jme, kms, kme, &
992	ips, ipe, jps, jpe, kps, kpe, &
993	its, ite, jts, jte, kts, kte )
994	CALL set_physical_bc3d( t, 'p', config_flags, &
995	ids, ide, jds, jde, kds, kde, &
996	ims, ime, jms, jme, kms, kme, &
997	ips, ipe, jps, jpe, kps, kpe, &
998	its, ite, jts, jte, kts, kte )
999	CALL set_physical_bc3d( ph , 'w', config_flags, &
1000	ids, ide, jds, jde, kds, kde, &
1001	ims, ime, jms, jme, kms, kme, &
1002	ips, ipe, jps, jpe, kps, kpe, &
1003	its, ite, jts, jte, kts, kte )
1004
1005	CALL set_physical_bc2d( mu, 't', config_flags, &
1006	ids, ide, jds, jde, &
1007	ims, ime, jms, jme, &
1008	ips, ipe, jps, jpe, &
1009	its, ite, jts, jte )
1010
1011	END SUBROUTINE rk_phys_bc_dry_2
1012
1013	!---------------------------------------------------------------------
1014
1015	SUBROUTINE zero_bdytend ( &
1016	u_btxs,u_btxe,u_btys,u_btye, &
1017	v_btxs,v_btxe,v_btys,v_btye, &
1018	ph_btxs,ph_btxe,ph_btys,ph_btye, &
1019	t_btxs,t_btxe,t_btys,t_btye, &
1020	w_btxs,w_btxe,w_btys,w_btye, &
1021	mu_btxs,mu_btxe,mu_btys,mu_btye, &
1022	moist_btxs,moist_btxe, &
1023	moist_btys,moist_btye, &
1024	spec_bdy_width,n_moist, &
1025	ids,ide, jds,jde, kds,kde, & ! domain dims
1026	ims,ime, jms,jme, kms,kme, & ! memory dims
1027	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
1028	its,ite, jts,jte, kts,kte )
1029	IMPLICIT NONE
1030
1031	! Input data.
1032
1033	INTEGER , INTENT(IN ) :: spec_bdy_width, n_moist
1034
1035	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1036	ims, ime, jms, jme, kms, kme, &
1037	ips, ipe, jps, jpe, kps, kpe, &
1038	its, ite, jts, jte, kts, kte
1039
1040	REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(INOUT) :: u_btxs,u_btxe, &
1041	v_btxs,v_btxe, &
1042	ph_btxs,ph_btxe, &
1043	w_btxs,w_btxe, &
1044	t_btxs,t_btxe
1045
1046	REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(INOUT) :: u_btys,u_btye, &
1047	v_btys,v_btye, &
1048	ph_btys,ph_btye, &
1049	w_btys,w_btye, &
1050	t_btys,t_btye
1051
1052	REAL, DIMENSION( jms:jme , 1:1 , spec_bdy_width ), INTENT(INOUT) :: mu_btxs,mu_btxe
1053	REAL, DIMENSION( ims:ime , 1:1 , spec_bdy_width ), INTENT(INOUT) :: mu_btys,mu_btye
1054
1055	REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width , n_moist ), INTENT(INOUT) :: moist_btxs,moist_btxe
1056	REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width , n_moist ), INTENT(INOUT) :: moist_btys,moist_btye
1057
1058	! setting bdy tendencies to zero during DFI
1059
1060	CALL wrf_debug( 10, 'In zero_bdytend, setting bdy tendencies to 0 during DFI' )
1061	u_btxs = 0.
1062	u_btxe = 0.
1063	u_btys = 0.
1064	u_btye = 0.
1065	v_btxs = 0.
1066	v_btxe = 0.
1067	v_btys = 0.
1068	v_btye = 0.
1069	t_btxs = 0.
1070	t_btxe = 0.
1071	t_btys = 0.
1072	t_btye = 0.
1073	ph_btxs = 0.
1074	ph_btxe = 0.
1075	ph_btys = 0.
1076	ph_btye = 0.
1077	mu_btxs = 0.
1078	mu_btxe = 0.
1079	mu_btys = 0.
1080	mu_btye = 0.
1081	moist_btxs = 0.
1082	moist_btxe = 0.
1083	moist_btys = 0.
1084	moist_btye = 0.
1085
1086	! ENDIF
1087
1088	END SUBROUTINE zero_bdytend
1089
1090	!---------------------------------------------------------------------
1091
1092	SUBROUTINE set_w_surface( config_flags, znw, fill_w_flag, &
1093	w, ht, u, v, cf1, cf2, cf3, rdx, rdy, &
1094	msftx, msfty, &
1095	ids, ide, jds, jde, kds, kde, &
1096	ims, ime, jms, jme, kms, kme, &
1097	its, ite, jts, jte, kts, kte )
1098	implicit none
1099
1100	TYPE( grid_config_rec_type ) config_flags
1101
1102	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1103	ims, ime, jms, jme, kms, kme, &
1104	its, ite, jts, jte, kts, kte
1105
1106	REAL :: rdx, rdy, cf1, cf2, cf3
1107
1108	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , &
1109	INTENT(IN ) :: u, &
1110	v
1111
1112	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , &
1113	INTENT(INOUT) :: w
1114
1115	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: ht, &
1116	msftx, &
1117	msfty
1118	REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: znw
1119
1120	LOGICAL, INTENT(IN ) :: fill_w_flag
1121
1122
1123	INTEGER :: i,j,k
1124	INTEGER :: ip1,im1,jp1,jm1
1125	INTEGER :: ip1_limit,im1_limit,jp1_limit,jm1_limit
1126
1127	! set kinematic lower boundary condition on W
1128
1129	! Comments on directional map scale factors:
1130	! Chain rule: if Z=Z(X,Y) [true at the surface] then
1131	! dZ/dt = dZ/dX * dX/dt + dZ/dY * dY/dt, U=dX/dt, V=dY/dt
1132	! using capitals to denote actual values
1133	! in mapped values, u=U, v=V, z=Z, 1/dX=mx/dx, 1/dY=my/dy
1134	! => w = dz/dt = mx u dz/dx + my v dz/dy
1135	! [where dz/dx is just the surface height change between x
1136	! gridpoints, and dz/dy is the change between y gridpoints]
1137	! [NB - cf1, cf2 and cf3 do vertical weighting of u or v values
1138	! nearest the surface]
1139
1140	! get indices for points next to edge of domain
1141
1142	jm1_limit = jds ! No periodic BC's
1143	jp1_limit = jde-1
1144	im1_limit = ids
1145	ip1_limit = ide-1
1146
1147	IF ( config_flags%periodic_x ) THEN
1148	im1_limit = ids-1
1149	ip1_limit = ide
1150	ENDIF
1151
1152	IF ( config_flags%periodic_y ) THEN
1153	jm1_limit = jds-1
1154	jp1_limit = jde
1155	ENDIF
1156
1157	DO j = jts,min(jte,jde-1)
1158	jm1 = max(j-1, jm1_limit)
1159	jp1 = min(j+1, jp1_limit)
1160	DO i = its,min(ite,ide-1)
1161	im1 = max(i-1, im1_limit)
1162	ip1 = min(i+1, ip1_limit)
1163
1164	w(i,1,j)= msfty(i,j)* &
1165	.5rdy( &
1166	(ht(i,jp1)-ht(i,j )) &
1167	(cf1v(i,1,j+1)+cf2v(i,2,j+1)+cf3v(i,3,j+1)) &
1168	+(ht(i,j )-ht(i,jm1)) &
1169	(cf1v(i,1,j )+cf2v(i,2,j )+cf3v(i,3,j )) ) &
1170	+msftx(i,j)* &
1171	.5rdx( &
1172	(ht(ip1,j)-ht(i,j )) &
1173	(cf1u(i+1,1,j)+cf2u(i+1,2,j)+cf3u(i+1,3,j)) &
1174	+(ht(i ,j)-ht(im1,j)) &
1175	(cf1u(i ,1,j)+cf2u(i ,2,j)+cf3u(i ,3,j)) )
1176
1177	ENDDO
1178	ENDDO
1179
1180	! Fill the atmospheric w field with smoothly decaying values
1181	IF (fill_w_flag) THEN
1182	DO j = jts,min(jte,jde-1)
1183	DO k = kts+1,kte
1184	DO i = its,min(ite,ide-1)
1185	w(i,k,j) = w(i,1,j)znw(k)znw(k)
1186	ENDDO
1187	ENDDO
1188	ENDDO
1189	ENDIF
1190
1191	END SUBROUTINE set_w_surface
1192
1193	SUBROUTINE lbc_fcx_gcx ( fcx , gcx , spec_bdy_width , &
1194	spec_zone , relax_zone , dt , spec_exp , &
1195	specified , nested )
1196
1197	IMPLICIT NONE
1198
1199	INTEGER , INTENT(IN) :: spec_bdy_width , spec_zone , relax_zone
1200	REAL , INTENT(IN) :: dt , spec_exp
1201	LOGICAL , INTENT(IN) :: specified , nested
1202	REAL , DIMENSION(spec_bdy_width) :: fcx , gcx
1203
1204	! Local variables.
1205
1206	INTEGER :: loop
1207	REAL :: spongeweight
1208
1209	IF (specified) THEN
1210
1211	! Arrays for specified boundary conditions
1212
1213	DO loop = spec_zone + 1, spec_zone + relax_zone
1214	fcx(loop) = 0.1 / dt * (spec_zone + relax_zone - loop) / (relax_zone - 1)
1215	gcx(loop) = 1.0 / dt / 50. * (spec_zone + relax_zone - loop) / (relax_zone - 1)
1216	spongeweight=exp(-(loop-(spec_zone + 1))*spec_exp)
1217	fcx(loop) = fcx(loop)*spongeweight
1218	gcx(loop) = gcx(loop)*spongeweight
1219	ENDDO
1220
1221	ELSE IF (nested) THEN
1222
1223	! Arrays for specified boundary conditions
1224
1225	DO loop = spec_zone + 1, spec_zone + relax_zone
1226	fcx(loop) = 0.1 / dt * (spec_zone + relax_zone - loop) / (relax_zone - 1)
1227	gcx(loop) = 1.0 / dt / 50. * (spec_zone + relax_zone - loop) / (relax_zone - 1)
1228	! spongeweight=EXP(-(loop-2)/3.)
1229	! fcx(loop) = fcx(loop)*spongeweight
1230	! gcx(loop) = gcx(loop)*spongeweight
1231	! fcx(loop) = 0.
1232	! gcx(loop) = 0.
1233	ENDDO
1234
1235	ENDIF
1236
1237	END SUBROUTINE lbc_fcx_gcx
1238
1239	END MODULE module_bc_em

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format