Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_bc_em.F @ 3094

Last change on this file since 3094 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 53.8 KB

Rev	Line
[2759]	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_bxs,u_bxe,u_bys,u_bye, &
	161	v_bxs,v_bxe,v_bys,v_bye, &
	162	ph_bxs,ph_bxe,ph_bys,ph_bye, &
	163	t_bxs,t_bxe,t_bys,t_bye, &
	164	w_bxs,w_bxe,w_bys,w_bye, &
	165	mu_bxs,mu_bxe,mu_bys,mu_bye, &
	166	u_btxs,u_btxe,u_btys,u_btye, &
	167	v_btxs,v_btxe,v_btys,v_btye, &
	168	ph_btxs,ph_btxe,ph_btys,ph_btye, &
	169	t_btxs,t_btxe,t_btys,t_btye, &
	170	w_btxs,w_btxe,w_btys,w_btye, &
	171	mu_btxs,mu_btxe,mu_btys,mu_btye, &
	172	spec_bdy_width, spec_zone, relax_zone, &
	173	dtbc, fcx, gcx, &
	174	ids,ide, jds,jde, kds,kde, & ! domain dims
	175	ims,ime, jms,jme, kms,kme, & ! memory dims
	176	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	177	its, ite, jts, jte, kts, kte)
	178	IMPLICIT NONE
	179
	180	! Input data.
	181	TYPE( grid_config_rec_type ) config_flags
	182
	183	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	184	ims, ime, jms, jme, kms, kme, &
	185	ips, ipe, jps, jpe, kps, kpe, &
	186	its, ite, jts, jte, kts, kte
	187	INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone, relax_zone
	188
	189	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: ru, &
	190	rv, &
	191	ph, &
	192	w, &
	193	t
	194	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu , &
	195	mut
	196	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: ru_tendf, &
	197	rv_tendf, &
	198	ph_tendf, &
	199	rw_tendf, &
	200	t_tendf
	201	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: mu_tend
	202	REAL , DIMENSION( spec_bdy_width) , INTENT(IN ) :: fcx, gcx
	203
	204	REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bxs,u_bxe, &
	205	v_bxs,v_bxe, &
	206	ph_bxs,ph_bxe, &
	207	w_bxs,w_bxe, &
	208	t_bxs,t_bxe, &
	209	u_btxs,u_btxe, &
	210	v_btxs,v_btxe, &
	211	ph_btxs,ph_btxe, &
	212	w_btxs,w_btxe, &
	213	t_btxs,t_btxe
	214
	215	REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bys,u_bye, &
	216	v_bys,v_bye, &
	217	ph_bys,ph_bye, &
	218	w_bys,w_bye, &
	219	t_bys,t_bye, &
	220	u_btys,u_btye, &
	221	v_btys,v_btye, &
	222	ph_btys,ph_btye, &
	223	w_btys,w_btye, &
	224	t_btys,t_btye
	225
	226
	227	REAL, DIMENSION( jms:jme , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bxs,mu_bxe, &
	228	mu_btxs,mu_btxe
	229
	230	REAL, DIMENSION( ims:ime , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bys,mu_bye, &
	231	mu_btys,mu_btye
	232	REAL, INTENT(IN ) :: dtbc
	233
	234	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: rfield
	235	INTEGER :: i_start, i_end, j_start, j_end, i, j, k
	236
	237	CALL relax_bdytend ( ru, ru_tendf, &
	238	u_bxs,u_bxe,u_bys,u_bye,u_btxs,u_btxe,u_btys,u_btye, &
	239	'u' , config_flags, &
	240	spec_bdy_width, spec_zone, relax_zone, &
	241	dtbc, fcx, gcx, &
	242	ids,ide, jds,jde, kds,kde, & ! domain dims
	243	ims,ime, jms,jme, kms,kme, & ! memory dims
	244	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	245	its,ite, jts,jte, kts,kte )
	246	CALL relax_bdytend ( rv, rv_tendf, &
	247	v_bxs,v_bxe,v_bys,v_bye,v_btxs,v_btxe,v_btys,v_btye, &
	248	'v' , config_flags, &
	249	spec_bdy_width, spec_zone, relax_zone, &
	250	dtbc, fcx, gcx, &
	251	ids,ide, jds,jde, kds,kde, & ! domain dims
	252	ims,ime, jms,jme, kms,kme, & ! memory dims
	253	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	254	its,ite, jts,jte, kts,kte )
	255
	256	! rfield will be calculated beyond tile limits because relax_bdytend
	257	! requires a 5-point stencil, and this avoids need for inter-tile/patch
	258	! communication here
	259	i_start = max(its-1, ids)
	260	i_end = min(ite+1, ide-1)
	261	j_start = max(jts-1, jds)
	262	j_end = min(jte+1, jde-1)
	263
	264	DO j=j_start,j_end
	265	DO k=kts,kte
	266	DO i=i_start,i_end
	267	rfield(i,k,j) = ph(i,k,j)*mut(i,j)
	268	ENDDO
	269	ENDDO
	270	ENDDO
	271
	272	CALL relax_bdytend ( rfield, ph_tendf, &
	273	ph_bxs,ph_bxe,ph_bys,ph_bye, ph_btxs,ph_btxe,ph_btys,ph_btye, &
	274	'h' , config_flags, &
	275	spec_bdy_width, spec_zone, relax_zone, &
	276	dtbc, fcx, gcx, &
	277	ids,ide, jds,jde, kds,kde, & ! domain dims
	278	ims,ime, jms,jme, kms,kme, & ! memory dims
	279	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	280	its,ite, jts,jte, kts,kte )
	281	DO j=j_start,j_end
	282	DO k=kts,kte-1
	283	DO i=i_start,i_end
	284	rfield(i,k,j) = t(i,k,j)*mut(i,j)
	285	ENDDO
	286	ENDDO
	287	ENDDO
	288	CALL relax_bdytend ( rfield, t_tendf, &
	289	t_bxs,t_bxe,t_bys,t_bye, t_btxs,t_btxe,t_btys,t_btye, &
	290	't' , config_flags, &
	291	spec_bdy_width, spec_zone, relax_zone, &
	292	dtbc, fcx, gcx, &
	293	ids,ide, jds,jde, kds,kde, & ! domain dims
	294	ims,ime, jms,jme, kms,kme, & ! memory dims
	295	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	296	its,ite, jts,jte, kts,kte )
	297	CALL relax_bdytend ( mu, mu_tend, &
	298	mu_bxs,mu_bxe,mu_bys,mu_bye, mu_btxs,mu_btxe,mu_btys,mu_btye, &
	299	'm' , config_flags, &
	300	spec_bdy_width, spec_zone, relax_zone, &
	301	dtbc, fcx, gcx, &
	302	ids,ide, jds,jde, 1 ,1 , & ! domain dims
	303	ims,ime, jms,jme, 1 ,1 , & ! memory dims
	304	ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
	305	its,ite, jts,jte, 1 ,1 )
	306
	307	IF( config_flags%nested) THEN
	308
	309	i_start = max(its-1, ids)
	310	i_end = min(ite+1, ide-1)
	311	j_start = max(jts-1, jds)
	312	j_end = min(jte+1, jde-1)
	313
	314	DO j=j_start,j_end
	315	DO k=kts,kte
	316	DO i=i_start,i_end
	317	rfield(i,k,j) = w(i,k,j)*mut(i,j)
	318	ENDDO
	319	ENDDO
	320	ENDDO
	321
	322	CALL relax_bdytend ( rfield, rw_tendf, &
	323	w_bxs,w_bxe,w_bys,w_bye, w_btxs,w_btxe,w_btys,w_btye, &
	324	'h' , config_flags, &
	325	spec_bdy_width, spec_zone, relax_zone, &
	326	dtbc, fcx, gcx, &
	327	ids,ide, jds,jde, kds,kde, & ! domain dims
	328	ims,ime, jms,jme, kms,kme, & ! memory dims
	329	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	330	its,ite, jts,jte, kts,kte )
	331
	332	END IF
	333
	334	END SUBROUTINE relax_bdy_dry
	335	!------------------------------------------------------------------------
	336	SUBROUTINE relax_bdy_scalar ( scalar_tend, &
	337	scalar, mu, &
	338	scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, &
	339	scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
	340	spec_bdy_width, spec_zone, relax_zone, &
	341	dtbc, fcx, gcx, &
	342	config_flags, &
	343	ids,ide, jds,jde, kds,kde, & ! domain dims
	344	ims,ime, jms,jme, kms,kme, & ! memory dims
	345	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	346	its, ite, jts, jte, kts, kte)
	347	IMPLICIT NONE
	348
	349	! Input data.
	350	TYPE( grid_config_rec_type ) config_flags
	351
	352	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	353	ims, ime, jms, jme, kms, kme, &
	354	ips, ipe, jps, jpe, kps, kpe, &
	355	its, ite, jts, jte, kts, kte
	356	INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone, relax_zone
	357
	358	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: scalar
	359	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu
	360	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: scalar_tend
	361	REAL , DIMENSION( spec_bdy_width) , INTENT(IN ) :: fcx, gcx
	362
	363	REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bxs,scalar_bxe, &
	364	scalar_btxs,scalar_btxe
	365	REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bys,scalar_bye, &
	366	scalar_btys,scalar_btye
	367	REAL, INTENT(IN ) :: dtbc
	368	!Local
	369	INTEGER :: i,j,k, i_start, i_end, j_start, j_end
	370	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: rscalar
	371
	372	! rscalar will be calculated beyond tile limits because relax_bdytend
	373	! requires a 5-point stencil, and this avoids need for inter-tile/patch
	374	! communication here
	375	i_start = max(its-1, ids)
	376	i_end = min(ite+1, ide-1)
	377	j_start = max(jts-1, jds)
	378	j_end = min(jte+1, jde-1)
	379
	380	DO j=j_start,j_end
	381	DO k=kts,min(kte,kde-1)
	382	DO i=i_start,i_end
	383	rscalar(i,k,j) = scalar(i,k,j)*mu(i,j)
	384	ENDDO
	385	ENDDO
	386	ENDDO
	387
	388	CALL relax_bdytend (rscalar, scalar_tend, &
	389	scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
	390	'q' , config_flags, &
	391	spec_bdy_width, spec_zone, relax_zone, &
	392	dtbc, fcx, gcx, &
	393	ids,ide, jds,jde, kds,kde, & ! domain dims
	394	ims,ime, jms,jme, kms,kme, & ! memory dims
	395	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	396	its,ite, jts,jte, kts,kte )
	397
	398
	399	END SUBROUTINE relax_bdy_scalar
	400
	401	!------------------------------------------------------------------------
	402	SUBROUTINE spec_bdy_dry ( config_flags, &
	403	ru_tend, rv_tend, ph_tend, t_tend, &
	404	rw_tend, mu_tend, &
	405	u_bxs,u_bxe,u_bys,u_bye, &
	406	v_bxs,v_bxe,v_bys,v_bye, &
	407	ph_bxs,ph_bxe,ph_bys,ph_bye, &
	408	t_bxs,t_bxe,t_bys,t_bye, &
	409	w_bxs,w_bxe,w_bys,w_bye, &
	410	mu_bxs,mu_bxe,mu_bys,mu_bye, &
	411	u_btxs,u_btxe,u_btys,u_btye, &
	412	v_btxs,v_btxe,v_btys,v_btye, &
	413	ph_btxs,ph_btxe,ph_btys,ph_btye, &
	414	t_btxs,t_btxe,t_btys,t_btye, &
	415	w_btxs,w_btxe,w_btys,w_btye, &
	416	mu_btxs,mu_btxe,mu_btys,mu_btye, &
	417	spec_bdy_width, spec_zone, &
	418	ids,ide, jds,jde, kds,kde, & ! domain dims
	419	ims,ime, jms,jme, kms,kme, & ! memory dims
	420	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	421	its, ite, jts, jte, kts, kte)
	422	IMPLICIT NONE
	423
	424	! Input data.
	425	TYPE( grid_config_rec_type ) config_flags
	426
	427
	428	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	429	ims, ime, jms, jme, kms, kme, &
	430	ips, ipe, jps, jpe, kps, kpe, &
	431	its, ite, jts, jte, kts, kte
	432	INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
	433
	434	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT ) :: ru_tend, &
	435	rv_tend, &
	436	ph_tend, &
	437	rw_tend, &
	438	t_tend
	439	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(OUT ) :: mu_tend
	440
	441	REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bxs,u_bxe, &
	442	v_bxs,v_bxe, &
	443	ph_bxs,ph_bxe, &
	444	w_bxs,w_bxe, &
	445	t_bxs,t_bxe, &
	446	u_btxs,u_btxe, &
	447	v_btxs,v_btxe, &
	448	ph_btxs,ph_btxe, &
	449	w_btxs,w_btxe, &
	450	t_btxs,t_btxe
	451
	452	REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bys,u_bye, &
	453	v_bys,v_bye, &
	454	ph_bys,ph_bye, &
	455	w_bys,w_bye, &
	456	t_bys,t_bye, &
	457	u_btys,u_btye, &
	458	v_btys,v_btye, &
	459	ph_btys,ph_btye, &
	460	w_btys,w_btye, &
	461	t_btys,t_btye
	462
	463	REAL, DIMENSION( jms:jme , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bxs,mu_bxe, &
	464	mu_btxs,mu_btxe
	465
	466	REAL, DIMENSION( ims:ime , 1:1 , spec_bdy_width ), INTENT(IN ) :: mu_bys,mu_bye, &
	467	mu_btys,mu_btye
	468	CALL spec_bdytend ( ru_tend, &
	469	u_bxs,u_bxe,u_bys,u_bye, u_btxs,u_btxe,u_btys,u_btye, &
	470	'u' , config_flags, &
	471	spec_bdy_width, spec_zone, &
	472	ids,ide, jds,jde, kds,kde, & ! domain dims
	473	ims,ime, jms,jme, kms,kme, & ! memory dims
	474	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	475	its,ite, jts,jte, kts,kte )
	476	CALL spec_bdytend ( rv_tend, &
	477	v_bxs,v_bxe,v_bys,v_bye, v_btxs,v_btxe,v_btys,v_btye, &
	478	'v' , config_flags, &
	479	spec_bdy_width, spec_zone, &
	480	ids,ide, jds,jde, kds,kde, & ! domain dims
	481	ims,ime, jms,jme, kms,kme, & ! memory dims
	482	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	483	its,ite, jts,jte, kts,kte )
	484	CALL spec_bdytend ( ph_tend, &
	485	ph_bxs,ph_bxe,ph_bys,ph_bye, ph_btxs,ph_btxe,ph_btys,ph_btye, &
	486	'h' , config_flags, &
	487	spec_bdy_width, spec_zone, &
	488	ids,ide, jds,jde, kds,kde, & ! domain dims
	489	ims,ime, jms,jme, kms,kme, & ! memory dims
	490	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	491	its,ite, jts,jte, kts,kte )
	492	CALL spec_bdytend ( t_tend, &
	493	t_bxs,t_bxe,t_bys,t_bye, t_btxs,t_btxe,t_btys,t_btye, &
	494	't' , config_flags, &
	495	spec_bdy_width, spec_zone, &
	496	ids,ide, jds,jde, kds,kde, & ! domain dims
	497	ims,ime, jms,jme, kms,kme, & ! memory dims
	498	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	499	its,ite, jts,jte, kts,kte )
	500	CALL spec_bdytend ( mu_tend, &
	501	mu_bxs,mu_bxe,mu_bys,mu_bye, mu_btxs,mu_btxe,mu_btys,mu_btye, &
	502	'm' , config_flags, &
	503	spec_bdy_width, spec_zone, &
	504	ids,ide, jds,jde, 1 ,1 , & ! domain dims
	505	ims,ime, jms,jme, 1 ,1 , & ! memory dims
	506	ips,ipe, jps,jpe, 1 ,1 , & ! patch dims
	507	its,ite, jts,jte, 1 ,1 )
	508
	509	if(config_flags%nested) &
	510	CALL spec_bdytend ( rw_tend, &
	511	w_bxs,w_bxe,w_bys,w_bye, w_btxs,w_btxe,w_btys,w_btye, &
	512	'h' , config_flags, &
	513	spec_bdy_width, spec_zone, &
	514	ids,ide, jds,jde, kds,kde, & ! domain dims
	515	ims,ime, jms,jme, kms,kme, & ! memory dims
	516	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	517	its,ite, jts,jte, kts,kte )
	518
	519	END SUBROUTINE spec_bdy_dry
	520
	521	!------------------------------------------------------------------------
	522	SUBROUTINE spec_bdy_scalar ( scalar_tend, &
	523	scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, &
	524	scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
	525	spec_bdy_width, spec_zone, &
	526	config_flags, &
	527	ids,ide, jds,jde, kds,kde, & ! domain dims
	528	ims,ime, jms,jme, kms,kme, & ! memory dims
	529	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	530	its, ite, jts, jte, kts, kte)
	531	IMPLICIT NONE
	532
	533	! Input data.
	534	TYPE( grid_config_rec_type ) config_flags
	535
	536
	537	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	538	ims, ime, jms, jme, kms, kme, &
	539	ips, ipe, jps, jpe, kps, kpe, &
	540	its, ite, jts, jte, kts, kte
	541	INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
	542
	543	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT ) :: scalar_tend
	544
	545	REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bxs,scalar_bxe, &
	546	scalar_btxs,scalar_btxe
	547
	548	REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bys,scalar_bye, &
	549	scalar_btys,scalar_btye
	550
	551	!Local
	552	INTEGER :: i,j,k
	553
	554
	555	CALL spec_bdytend ( scalar_tend, &
	556	scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, &
	557	'q' , config_flags, &
	558	spec_bdy_width, spec_zone, &
	559	ids,ide, jds,jde, kds,kde, & ! domain dims
	560	ims,ime, jms,jme, kms,kme, & ! memory dims
	561	ips,ipe, jps,jpe, kps,kpe, & ! patch dims
	562	its,ite, jts,jte, kts,kte )
	563
	564
	565	END SUBROUTINE spec_bdy_scalar
	566
	567	!------------------------------------------------------------------------
	568
	569	SUBROUTINE set_phys_bc_dry_1( config_flags, u_1, u_2, v_1, v_2, &
	570	rw_1, rw_2, w_1, w_2, &
	571	t_1, t_2, tp_1, tp_2, pp, pip, &
	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
	577	!
	578	! this is just a wraper to call the boundary condition routines
	579	! for each variable
	580	!
	581
	582	IMPLICIT NONE
	583
	584	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
	585	INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
	586	INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
	587	INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
	588
	589	TYPE( grid_config_rec_type ) config_flags
	590
	591	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
	592	u_1,u_2, v_1, v_2, rw_1, rw_2, w_1, w_2, &
	593	t_1, t_2, tp_1, tp_2, pp, pip
	594
	595
	596
	597	CALL set_physical_bc3d( u_1 , 'u', config_flags, &
	598	ids, ide, jds, jde, kds, kde, &
	599	ims, ime, jms, jme, kms, kme, &
	600	ips, ipe, jps, jpe, kps, kpe, &
	601	its, ite, jts, jte, kts, kte )
	602	CALL set_physical_bc3d( u_2 , 'u', config_flags, &
	603	ids, ide, jds, jde, kds, kde, &
	604	ims, ime, jms, jme, kms, kme, &
	605	ips, ipe, jps, jpe, kps, kpe, &
	606	its, ite, jts, jte, kts, kte )
	607	CALL set_physical_bc3d( v_1 , 'v', config_flags, &
	608	ids, ide, jds, jde, kds, kde, &
	609	ims, ime, jms, jme, kms, kme, &
	610	ips, ipe, jps, jpe, kps, kpe, &
	611	its, ite, jts, jte, kts, kte )
	612	CALL set_physical_bc3d( v_2 , 'v', config_flags, &
	613	ids, ide, jds, jde, kds, kde, &
	614	ims, ime, jms, jme, kms, kme, &
	615	ips, ipe, jps, jpe, kps, kpe, &
	616	its, ite, jts, jte, kts, kte )
	617	CALL set_physical_bc3d( rw_1 , 'w', config_flags, &
	618	ids, ide, jds, jde, kds, kde, &
	619	ims, ime, jms, jme, kms, kme, &
	620	ips, ipe, jps, jpe, kps, kpe, &
	621	its, ite, jts, jte, kts, kte )
	622	CALL set_physical_bc3d( rw_2 , 'w', config_flags, &
	623	ids, ide, jds, jde, kds, kde, &
	624	ims, ime, jms, jme, kms, kme, &
	625	ips, ipe, jps, jpe, kps, kpe, &
	626	its, ite, jts, jte, kts, kte )
	627	CALL set_physical_bc3d( w_1 , 'w', config_flags, &
	628	ids, ide, jds, jde, kds, kde, &
	629	ims, ime, jms, jme, kms, kme, &
	630	ips, ipe, jps, jpe, kps, kpe, &
	631	its, ite, jts, jte, kts, kte )
	632	CALL set_physical_bc3d( w_2 , 'w', config_flags, &
	633	ids, ide, jds, jde, kds, kde, &
	634	ims, ime, jms, jme, kms, kme, &
	635	ips, ipe, jps, jpe, kps, kpe, &
	636	its, ite, jts, jte, kts, kte )
	637	CALL set_physical_bc3d( t_1, 'p', config_flags, &
	638	ids, ide, jds, jde, kds, kde, &
	639	ims, ime, jms, jme, kms, kme, &
	640	ips, ipe, jps, jpe, kps, kpe, &
	641	its, ite, jts, jte, kts, kte )
	642	CALL set_physical_bc3d( t_2, 'p', config_flags, &
	643	ids, ide, jds, jde, kds, kde, &
	644	ims, ime, jms, jme, kms, kme, &
	645	ips, ipe, jps, jpe, kps, kpe, &
	646	its, ite, jts, jte, kts, kte )
	647	CALL set_physical_bc3d( tp_1, 'p', config_flags, &
	648	ids, ide, jds, jde, kds, kde, &
	649	ims, ime, jms, jme, kms, kme, &
	650	ips, ipe, jps, jpe, kps, kpe, &
	651	its, ite, jts, jte, kts, kte )
	652	CALL set_physical_bc3d( tp_2, 'p', config_flags, &
	653	ids, ide, jds, jde, kds, kde, &
	654	ims, ime, jms, jme, kms, kme, &
	655	ips, ipe, jps, jpe, kps, kpe, &
	656	its, ite, jts, jte, kts, kte )
	657	CALL set_physical_bc3d( pp , 'p', config_flags, &
	658	ids, ide, jds, jde, kds, kde, &
	659	ims, ime, jms, jme, kms, kme, &
	660	ips, ipe, jps, jpe, kps, kpe, &
	661	its, ite, jts, jte, kts, kte )
	662	CALL set_physical_bc3d( pip , 'p', config_flags, &
	663	ids, ide, jds, jde, kds, kde, &
	664	ims, ime, jms, jme, kms, kme, &
	665	ips, ipe, jps, jpe, kps, kpe, &
	666	its, ite, jts, jte, kts, kte )
	667
	668	END SUBROUTINE set_phys_bc_dry_1
	669
	670	!--------------------------------------------------------------
	671
	672	SUBROUTINE set_phys_bc_dry_2( config_flags, &
	673	u_1, u_2, v_1, v_2, w_1, w_2, &
	674	t_1, t_2, ph_1, ph_2, mu_1, mu_2, &
	675	ids,ide, jds,jde, kds,kde, &
	676	ims,ime, jms,jme, kms,kme, &
	677	ips,ipe, jps,jpe, kps,kpe, &
	678	its,ite, jts,jte, kts,kte )
	679
	680	!
	681	! this is just a wraper to call the boundary condition routines
	682	! for each variable
	683	!
	684
	685	IMPLICIT NONE
	686
	687	TYPE( grid_config_rec_type ) config_flags
	688
	689	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
	690	INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
	691	INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
	692	INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
	693
	694	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
	695	u_1, u_2, v_1, v_2, w_1, w_2, &
	696	t_1, t_2, ph_1, ph_2
	697
	698	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
	699	mu_1, mu_2
	700
	701
	702	CALL set_physical_bc3d( u_1, 'U', config_flags, &
	703	ids, ide, jds, jde, kds, kde, &
	704	ims, ime, jms, jme, kms, kme, &
	705	ips, ipe, jps, jpe, kps, kpe, &
	706	its, ite, jts, jte, kts, kte )
	707
	708	CALL set_physical_bc3d( u_2, 'U', config_flags, &
	709	ids, ide, jds, jde, kds, kde, &
	710	ims, ime, jms, jme, kms, kme, &
	711	ips, ipe, jps, jpe, kps, kpe, &
	712	its, ite, jts, jte, kts, kte )
	713
	714	CALL set_physical_bc3d( v_1 , 'V', config_flags, &
	715	ids, ide, jds, jde, kds, kde, &
	716	ims, ime, jms, jme, kms, kme, &
	717	ips, ipe, jps, jpe, kps, kpe, &
	718	its, ite, jts, jte, kts, kte )
	719	CALL set_physical_bc3d( v_2 , 'V', config_flags, &
	720	ids, ide, jds, jde, kds, kde, &
	721	ims, ime, jms, jme, kms, kme, &
	722	ips, ipe, jps, jpe, kps, kpe, &
	723	its, ite, jts, jte, kts, kte )
	724
	725	CALL set_physical_bc3d( w_1, 'w', config_flags, &
	726	ids, ide, jds, jde, kds, kde, &
	727	ims, ime, jms, jme, kms, kme, &
	728	ips, ipe, jps, jpe, kps, kpe, &
	729	its, ite, jts, jte, kts, kte )
	730	CALL set_physical_bc3d( w_2, 'w', config_flags, &
	731	ids, ide, jds, jde, kds, kde, &
	732	ims, ime, jms, jme, kms, kme, &
	733	ips, ipe, jps, jpe, kps, kpe, &
	734	its, ite, jts, jte, kts, kte )
	735
	736	CALL set_physical_bc3d( t_1, 'p', config_flags, &
	737	ids, ide, jds, jde, kds, kde, &
	738	ims, ime, jms, jme, kms, kme, &
	739	ips, ipe, jps, jpe, kps, kpe, &
	740	its, ite, jts, jte, kts, kte )
	741
	742	CALL set_physical_bc3d( t_2, 'p', config_flags, &
	743	ids, ide, jds, jde, kds, kde, &
	744	ims, ime, jms, jme, kms, kme, &
	745	ips, ipe, jps, jpe, kps, kpe, &
	746	its, ite, jts, jte, kts, kte )
	747
	748	CALL set_physical_bc3d( ph_1 , 'w', config_flags, &
	749	ids, ide, jds, jde, kds, kde, &
	750	ims, ime, jms, jme, kms, kme, &
	751	ips, ipe, jps, jpe, kps, kpe, &
	752	its, ite, jts, jte, kts, kte )
	753
	754	CALL set_physical_bc3d( ph_2 , 'w', config_flags, &
	755	ids, ide, jds, jde, kds, kde, &
	756	ims, ime, jms, jme, kms, kme, &
	757	ips, ipe, jps, jpe, kps, kpe, &
	758	its, ite, jts, jte, kts, kte )
	759
	760	CALL set_physical_bc2d( mu_1, 't', config_flags, &
	761	ids, ide, jds, jde, &
	762	ims, ime, jms, jme, &
	763	ips, ipe, jps, jpe, &
	764	its, ite, jts, jte )
	765
	766	CALL set_physical_bc2d( mu_2, 't', config_flags, &
	767	ids, ide, jds, jde, &
	768	ims, ime, jms, jme, &
	769	ips, ipe, jps, jpe, &
	770	its, ite, jts, jte )
	771
	772	END SUBROUTINE set_phys_bc_dry_2
	773
	774	!------------------------------------------------------------------------
	775
	776	SUBROUTINE set_phys_bc_smallstep_1( config_flags, ru_1, du, rv_1, dv, &
	777	ids,ide, jds,jde, kds,kde, &
	778	ims,ime, jms,jme, kms,kme, &
	779	ips,ipe, jps,jpe, kps,kpe, &
	780	its,ite, jts,jte, kts,kte )
	781
	782	!
	783	! this is just a wraper to call the boundary condition routines
	784	! for each variable
	785	!
	786
	787	IMPLICIT NONE
	788
	789	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
	790	INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
	791	INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
	792	INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
	793
	794	TYPE( grid_config_rec_type ) config_flags
	795
	796	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
	797	ru_1,du, rv_1, dv
	798
	799	CALL set_physical_bc3d( ru_1 , 'u', config_flags, &
	800	ids, ide, jds, jde, kds, kde, &
	801	ims, ime, jms, jme, kms, kme, &
	802	ips, ipe, jps, jpe, kps, kpe, &
	803	its, ite, jts, jte, kts, kde )
	804	CALL set_physical_bc3d( du , 'u', config_flags, &
	805	ids, ide, jds, jde, kds, kde, &
	806	ims, ime, jms, jme, kms, kme, &
	807	ips, ipe, jps, jpe, kps, kpe, &
	808	its, ite, jts, jte, kts, kde )
	809	CALL set_physical_bc3d( rv_1 , 'v', config_flags, &
	810	ids, ide, jds, jde, kds, kde, &
	811	ims, ime, jms, jme, kms, kme, &
	812	ips, ipe, jps, jpe, kps, kpe, &
	813	its, ite, jts, jte, kts, kde )
	814	CALL set_physical_bc3d( dv , 'v', config_flags, &
	815	ids, ide, jds, jde, kds, kde, &
	816	ims, ime, jms, jme, kms, kme, &
	817	ips, ipe, jps, jpe, kps, kpe, &
	818	its, ite, jts, jte, kts, kde )
	819
	820	END SUBROUTINE set_phys_bc_smallstep_1
	821
	822	!-------------------------------------------------------------------
	823
	824	SUBROUTINE rk_phys_bc_dry_1( config_flags, u, v, rw, w, &
	825	muu, muv, mut, php, alt, p, &
	826	ids,ide, jds,jde, kds,kde, &
	827	ims,ime, jms,jme, kms,kme, &
	828	ips,ipe, jps,jpe, kps,kpe, &
	829	its,ite, jts,jte, kts,kte )
	830
	831	!
	832	! this is just a wraper to call the boundary condition routines
	833	! for each variable
	834	!
	835
	836	IMPLICIT NONE
	837
	838	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
	839	INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
	840	INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
	841	INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
	842
	843	TYPE( grid_config_rec_type ) config_flags
	844
	845	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
	846	INTENT(INOUT) :: u, v, rw, w, php, alt, p
	847	REAL, DIMENSION( ims:ime, jms:jme ), &
	848	INTENT(INOUT) :: muu, muv, mut
	849
	850	CALL set_physical_bc3d( u , 'u', config_flags, &
	851	ids, ide, jds, jde, kds, kde, &
	852	ims, ime, jms, jme, kms, kme, &
	853	ips, ipe, jps, jpe, kps, kpe, &
	854	its, ite, jts, jte, kts, kte )
	855	CALL set_physical_bc3d( v , 'v', config_flags, &
	856	ids, ide, jds, jde, kds, kde, &
	857	ims, ime, jms, jme, kms, kme, &
	858	ips, ipe, jps, jpe, kps, kpe, &
	859	its, ite, jts, jte, kts, kte )
	860	CALL set_physical_bc3d(rw , 'w', config_flags, &
	861	ids, ide, jds, jde, kds, kde, &
	862	ims, ime, jms, jme, kms, kme, &
	863	ips, ipe, jps, jpe, kps, kpe, &
	864	its, ite, jts, jte, kts, kte )
	865	CALL set_physical_bc3d( w , 'w', config_flags, &
	866	ids, ide, jds, jde, kds, kde, &
	867	ims, ime, jms, jme, kms, kme, &
	868	ips, ipe, jps, jpe, kps, kpe, &
	869	its, ite, jts, jte, kts, kte )
	870	CALL set_physical_bc3d( php , 'w', config_flags, &
	871	ids, ide, jds, jde, kds, kde, &
	872	ims, ime, jms, jme, kms, kme, &
	873	ips, ipe, jps, jpe, kps, kpe, &
	874	its, ite, jts, jte, kts, kte )
	875	CALL set_physical_bc3d( alt, 't', config_flags, &
	876	ids, ide, jds, jde, kds, kde, &
	877	ims, ime, jms, jme, kms, kme, &
	878	ips, ipe, jps, jpe, kps, kpe, &
	879	its, ite, jts, jte, kts, kte )
	880
	881	CALL set_physical_bc3d( p, 'p', config_flags, &
	882	ids, ide, jds, jde, kds, kde, &
	883	ims, ime, jms, jme, kms, kme, &
	884	ips, ipe, jps, jpe, kps, kpe, &
	885	its, ite, jts, jte, kts, kte )
	886
	887	CALL set_physical_bc2d( muu, 'u', config_flags, &
	888	ids, ide, jds, jde, &
	889	ims, ime, jms, jme, &
	890	ips, ipe, jps, jpe, &
	891	its, ite, jts, jte )
	892
	893	CALL set_physical_bc2d( muv, 'v', config_flags, &
	894	ids, ide, jds, jde, &
	895	ims, ime, jms, jme, &
	896	ips, ipe, jps, jpe, &
	897	its, ite, jts, jte )
	898
	899	CALL set_physical_bc2d( mut, 't', config_flags, &
	900	ids, ide, jds, jde, &
	901	ims, ime, jms, jme, &
	902	ips, ipe, jps, jpe, &
	903	its, ite, jts, jte )
	904
	905	END SUBROUTINE rk_phys_bc_dry_1
	906
	907	!------------------------------------------------------------------------
	908
	909	SUBROUTINE rk_phys_bc_dry_2( config_flags, u, v, w, &
	910	t, ph, mu, &
	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
	916	!
	917	! this is just a wraper to call the boundary condition routines
	918	! for each variable
	919	!
	920
	921	IMPLICIT NONE
	922
	923	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
	924	INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
	925	INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
	926	INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
	927
	928	TYPE( grid_config_rec_type ) config_flags
	929
	930	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: &
	931	u, v, w, t, ph
	932
	933	REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
	934	mu
	935
	936	CALL set_physical_bc3d( u , 'U', config_flags, &
	937	ids, ide, jds, jde, kds, kde, &
	938	ims, ime, jms, jme, kms, kme, &
	939	ips, ipe, jps, jpe, kps, kpe, &
	940	its, ite, jts, jte, kts, kte )
	941	CALL set_physical_bc3d( v , 'V', config_flags, &
	942	ids, ide, jds, jde, kds, kde, &
	943	ims, ime, jms, jme, kms, kme, &
	944	ips, ipe, jps, jpe, kps, kpe, &
	945	its, ite, jts, jte, kts, kte )
	946	CALL set_physical_bc3d( w , 'w', config_flags, &
	947	ids, ide, jds, jde, kds, kde, &
	948	ims, ime, jms, jme, kms, kme, &
	949	ips, ipe, jps, jpe, kps, kpe, &
	950	its, ite, jts, jte, kts, kte )
	951	CALL set_physical_bc3d( t, 'p', config_flags, &
	952	ids, ide, jds, jde, kds, kde, &
	953	ims, ime, jms, jme, kms, kme, &
	954	ips, ipe, jps, jpe, kps, kpe, &
	955	its, ite, jts, jte, kts, kte )
	956	CALL set_physical_bc3d( ph , 'w', config_flags, &
	957	ids, ide, jds, jde, kds, kde, &
	958	ims, ime, jms, jme, kms, kme, &
	959	ips, ipe, jps, jpe, kps, kpe, &
	960	its, ite, jts, jte, kts, kte )
	961
	962	CALL set_physical_bc2d( mu, 't', config_flags, &
	963	ids, ide, jds, jde, &
	964	ims, ime, jms, jme, &
	965	ips, ipe, jps, jpe, &
	966	its, ite, jts, jte )
	967
	968	END SUBROUTINE rk_phys_bc_dry_2
	969
	970	!---------------------------------------------------------------------
	971
	972	SUBROUTINE set_w_surface( config_flags, znw, &
	973	w, ht, u, v, cf1, cf2, cf3, rdx, rdy, &
	974	msftx, msfty, &
	975	ids, ide, jds, jde, kds, kde, &
	976	ips, ipe, jps, jpe, kps, kpe, &
	977	its, ite, jts, jte, kts, kte, &
	978	ims, ime, jms, jme, kms, kme )
	979	implicit none
	980
	981	TYPE( grid_config_rec_type ) config_flags
	982
	983	INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
	984	ims, ime, jms, jme, kms, kme, &
	985	its, ite, jts, jte, kts, kte, &
	986	ips, ipe, jps, jpe, kps, kpe
	987
	988	REAL :: rdx, rdy, cf1, cf2, cf3
	989
	990
	991	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , &
	992	INTENT(IN ) :: u, &
	993	v
	994
	995	REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , &
	996	INTENT(INOUT) :: w
	997
	998	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: ht, &
	999	msftx, &
	1000	msfty
	1001	REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: znw
	1002
	1003
	1004	INTEGER :: i,j,k
	1005	INTEGER :: ip1,im1,jp1,jm1
	1006
	1007	! set kinematic lower boundary condition on W
	1008
	1009	! Comments on directional map scale factors:
	1010	! Chain rule: if Z=Z(X,Y) [true at the surface] then
	1011	! dZ/dt = dZ/dX * dX/dt + dZ/dY * dY/dt, U=dX/dt, V=dY/dt
	1012	! using capitals to denote actual values
	1013	! in mapped values, u=U, v=V, z=Z, 1/dX=mx/dx, 1/dY=my/dy
	1014	! => w = dz/dt = mx u dz/dx + my v dz/dy
	1015	! [where dz/dx is just the surface height change between x
	1016	! gridpoints, and dz/dy is the change between y gridpoints]
	1017	! [NB - cf1, cf2 and cf3 do vertical weighting of u or v values
	1018	! nearest the surface]
	1019
	1020	DO j = jts,min(jte,jde-1)
	1021	jm1 = max(j-1,jds)
	1022	jp1 = min(j+1,jde-1)
	1023	DO i = its,min(ite,ide-1)
	1024	im1 = max(i-1,ids)
	1025	ip1 = min(i+1,ide-1)
	1026
	1027	w(i,1,j)= msfty(i,j)* &
	1028	.5rdy( &
	1029	(ht(i,jp1)-ht(i,j )) &
	1030	(cf1v(i,1,j+1)+cf2v(i,2,j+1)+cf3v(i,3,j+1)) &
	1031	+(ht(i,j )-ht(i,jm1)) &
	1032	(cf1v(i,1,j )+cf2v(i,2,j )+cf3v(i,3,j )) ) &
	1033	+msftx(i,j)* &
	1034	.5rdx( &
	1035	(ht(ip1,j)-ht(i,j )) &
	1036	(cf1u(i+1,1,j)+cf2u(i+1,2,j)+cf3u(i+1,3,j)) &
	1037	+(ht(i ,j)-ht(im1,j)) &
	1038	(cf1u(i ,1,j)+cf2u(i ,2,j)+cf3u(i ,3,j)) )
	1039
	1040	ENDDO
	1041	ENDDO
	1042
	1043	! Fill the atmospheric w field with smoothly decaying values
	1044
	1045	DO j = jts,min(jte,jde-1)
	1046	DO k = kts+1,kte
	1047	DO i = its,min(ite,ide-1)
	1048	w(i,k,j) = w(i,1,j)znw(k)znw(k)
	1049	ENDDO
	1050	ENDDO
	1051	ENDDO
	1052
	1053	END SUBROUTINE set_w_surface
	1054
	1055	SUBROUTINE lbc_fcx_gcx ( fcx , gcx , spec_bdy_width , &
	1056	spec_zone , relax_zone , dt , spec_exp , &
	1057	specified , nested )
	1058
	1059	IMPLICIT NONE
	1060
	1061	INTEGER , INTENT(IN) :: spec_bdy_width , spec_zone , relax_zone
	1062	REAL , INTENT(IN) :: dt , spec_exp
	1063	LOGICAL , INTENT(IN) :: specified , nested
	1064	REAL , DIMENSION(spec_bdy_width) :: fcx , gcx
	1065
	1066	! Local variables.
	1067
	1068	INTEGER :: loop
	1069	REAL :: spongeweight
	1070
	1071	IF (specified) THEN
	1072
	1073	! Arrays for specified boundary conditions
	1074
	1075	DO loop = spec_zone + 1, spec_zone + relax_zone
	1076	fcx(loop) = 0.1 / dt * (spec_zone + relax_zone - loop) / (relax_zone - 1)
	1077	gcx(loop) = 1.0 / dt / 50. * (spec_zone + relax_zone - loop) / (relax_zone - 1)
	1078	spongeweight=exp(-(loop-(spec_zone + 1))*spec_exp)
	1079	fcx(loop) = fcx(loop)*spongeweight
	1080	gcx(loop) = gcx(loop)*spongeweight
	1081	ENDDO
	1082
	1083	ELSE IF (nested) THEN
	1084
	1085	! Arrays for specified boundary conditions
	1086
	1087	DO loop = spec_zone + 1, spec_zone + relax_zone
	1088	fcx(loop) = 0.1 / dt * (spec_zone + relax_zone - loop) / (relax_zone - 1)
	1089	gcx(loop) = 1.0 / dt / 50. * (spec_zone + relax_zone - loop) / (relax_zone - 1)
	1090	! spongeweight=EXP(-(loop-2)/3.)
	1091	! fcx(loop) = fcx(loop)*spongeweight
	1092	! gcx(loop) = gcx(loop)*spongeweight
	1093	! fcx(loop) = 0.
	1094	! gcx(loop) = 0.
	1095	ENDDO
	1096
	1097	ENDIF
	1098
	1099	END SUBROUTINE lbc_fcx_gcx
	1100
	1101	END MODULE module_bc_em

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

Download in other formats:

Original Format