Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_bc_em.F @ 3026

Last change on this file since 3026 was 11, checked in by aslmd, 14 years ago
spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 48.1 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
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	.5rdy( &
982	(ht(i,jp1)-ht(i,j )) &
983	(cf1v(i,1,j+1)+cf2v(i,2,j+1)+cf3v(i,3,j+1)) &
984	+(ht(i,j )-ht(i,jm1)) &
985	(cf1v(i,1,j )+cf2v(i,2,j )+cf3v(i,3,j )) ) &
986	+.5rdx( &
987	(ht(ip1,j)-ht(i,j )) &
988	(cf1u(i+1,1,j)+cf2u(i+1,2,j)+cf3u(i+1,3,j)) &
989	+(ht(i ,j)-ht(im1,j)) &
990	(cf1u(i ,1,j)+cf2u(i ,2,j)+cf3u(i ,3,j)) ) &
991	)
992	ENDDO
993	ENDDO
994
995	END SUBROUTINE set_w_surface
996
997	END MODULE module_bc_em

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

Download in other formats:

Original Format