Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_BNDRY_COND.F @ 3094

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

Rev	Line
[2759]	1	!-----------------------------------------------------------------------
	2	!
	3	!NCEP_MESO:MODEL_LAYER: BOUNDARY CONDITION UPDATES
	4	!
	5	!-----------------------------------------------------------------------
	6	!
	7	#include "nmm_loop_basemacros.h"
	8	#include "nmm_loop_macros.h"
	9	!
	10	!-----------------------------------------------------------------------
	11	!
	12	MODULE MODULE_BNDRY_COND
	13	!
	14	!-----------------------------------------------------------------------
	15	USE MODULE_STATE_DESCRIPTION
	16	USE MODULE_MODEL_CONSTANTS
	17	!-----------------------------------------------------------------------
	18	REAL :: D06666=0.06666666
	19	!-----------------------------------------------------------------------
	20	!
	21	CONTAINS
	22	!
	23	!***********************************************************************
	24	SUBROUTINE BOCOH(GRIDID,NTSD,DT0,NEST,NBC,NBOCO,LAST_TIME,TSPH &
	25	& ,LB,ETA1,ETA2,PDTOP,PT,RES &
	26	& ,PD_BXS, PD_BXE, PD_BYS, PD_BYE &
	27	& ,T_BXS, T_BXE, T_BYS, T_BYE &
	28	& ,Q_BXS, Q_BXE, Q_BYS, Q_BYE &
	29	& ,U_BXS, U_BXE, U_BYS, U_BYE &
	30	& ,V_BXS, V_BXE, V_BYS, V_BYE &
	31	& ,Q2_BXS, Q2_BXE, Q2_BYS, Q2_BYE &
	32	& ,CWM_BXS, CWM_BXE, CWM_BYS, CWM_BYE &
	33	& ,PD_BTXS, PD_BTXE, PD_BTYS, PD_BTYE &
	34	& ,T_BTXS, T_BTXE, T_BTYS, T_BTYE &
	35	& ,Q_BTXS, Q_BTXE, Q_BTYS, Q_BTYE &
	36	& ,U_BTXS, U_BTXE, U_BTYS, U_BTYE &
	37	& ,V_BTXS, V_BTXE, V_BTYS, V_BTYE &
	38	& ,Q2_BTXS, Q2_BTXE, Q2_BTYS, Q2_BTYE &
	39	& ,CWM_BTXS, CWM_BTXE, CWM_BTYS, CWM_BTYE &
	40	& ,PD,T,Q,Q2,CWM,PINT &
	41	& ,MOIST,N_MOIST,SCALAR,N_SCALAR &
	42	#ifdef WRF_CHEM
	43	& ,CHEM,NUMG,CONFIG_FLAGS &
	44	#endif
	45	& ,SPEC_BDY_WIDTH,Z &
	46	& ,IHE,IHW,IVE,IVW &
	47	& ,IDS,IDE,JDS,JDE,KDS,KDE &
	48	& ,IMS,IME,JMS,JME,KMS,KME &
	49	& ,ITS,ITE,JTS,JTE,KTS,KTE)
	50	!***********************************************************************
	51	!$$$ SUBPROGRAM DOCUMENTATION BLOCK
	52	! . . .
	53	! SUBPROGRAM: BOCOH UPDATE MASS POINTS ON BOUNDARY
	54	! PRGRMMR: JANJIC ORG: W/NP22 DATE: 94-03-08
	55	!
	56	! ABSTRACT:
	57	! TEMPERATURE, SPECIFIC HUMIDITY, AND SURFACE PRESSURE
	58	! ARE UPDATED ON THE DOMAIN BOUNDARY BY APPLYING THE
	59	! PRE-COMPUTED TENDENCIES AT EACH TIME STEP.
	60	!
	61	! PROGRAM HISTORY LOG:
	62	! 87-??-?? MESINGER - ORIGINATOR
	63	! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D in HORIZONTAL
	64	! 96-12-13 BLACK - FINAL MODIFICATION FOR NESTED RUNS
	65	! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
	66	! 00-01-06 BLACK - MODIFIED FOR JANJIC NONHYDROSTATIC CODE
	67	! 00-09-14 BLACK - MODIFIED FOR DIRECT ACCESS READ
	68	! 01-03-12 BLACK - CONVERTED TO WRF STRUCTURE
	69	! 02-08-29 MICHALAKES - CHANGED II=I-MY_IS_GLB+1 TO II=I
	70	! ADDED CONDITIONAL COMPILATION AROUND MPI
	71	! CONVERT INDEXING FROM LOCAL TO GLOBAL
	72	! 02-09-06 WOLFE - MORE CONVERSION TO GLOBAL INDEXING
	73	! 04-11-18 BLACK - THREADED
	74	! 05-12-19 BLACK - CONVERTED FROM IKJ TO IJK
	75	! 06-06-02 GOPAL - MODIFICATIONS FOR NESTING
	76	! 07-11-14 PYLE - UPDATED FOR NEW WRF BOUNDARY FILE STRUCTURE
	77	!
	78	! USAGE: CALL BOCOH FROM SUBROUTINE SOLVE_NMM
	79	! INPUT ARGUMENT LIST:
	80	!
	81	! NOTE THAT IDE AND JDE INSIDE ROUTINE SHOULD BE PASSED IN
	82	! AS WHAT WRF CONSIDERS THE UNSTAGGERED GRID DIMENSIONS; THAT
	83	! IS, 1 LESS THAN THE IDE AND JDE SET BY WRF FRAMEWORK, JM
	84	!
	85	! OUTPUT ARGUMENT LIST:
	86	!
	87	! OUTPUT FILES:
	88	! NONE
	89	!
	90	! SUBPROGRAMS CALLED:
	91	!
	92	! UNIQUE: NONE
	93	!
	94	! LIBRARY: NONE
	95	!
	96	! ATTRIBUTES:
	97	! LANGUAGE: FORTRAN 90
	98	! MACHINE : IBM
	99	!$$$
	100	!***********************************************************************
	101	!-----------------------------------------------------------------------
	102	#ifdef WRF_CHEM
	103	USE MODULE_INPUT_CHEM_DATA
	104	#endif
	105	!-----------------------------------------------------------------------
	106	!
	107	IMPLICIT NONE
	108	!
	109	!-----------------------------------------------------------------------
	110	LOGICAL,INTENT(IN) :: NEST
	111	!
	112	INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
	113	& ,IMS,IME,JMS,JME,KMS,KME &
	114	& ,ITS,ITE,JTS,JTE,KTS,KTE
	115	INTEGER,INTENT(IN) :: SPEC_BDY_WIDTH
	116	INTEGER,INTENT(IN) :: N_MOIST, N_SCALAR
	117	#ifdef WRF_CHEM
	118	INTEGER,INTENT(IN) :: NUMG
	119	#endif
	120	!
	121	INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
	122	!
	123	INTEGER,INTENT(IN) :: GRIDID
	124	INTEGER,INTENT(IN) :: LB,NBC,NTSD
	125	LOGICAL,INTENT(IN) :: LAST_TIME
	126	INTEGER,INTENT(INOUT) :: NBOCO
	127	!
	128	REAL,INTENT(IN) :: DT0,PDTOP,PT,TSPH
	129	!
	130	REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA1,ETA2
	131	!
	132	REAL,DIMENSION(IMS:IME,1,SPEC_BDY_WIDTH) &
	133	& ,INTENT(INOUT) :: PD_BYS, PD_BYE &
	134	& ,PD_BTYS,PD_BTYE
	135	!
	136	REAL,DIMENSION(IMS:IME,KMS:KME,SPEC_BDY_WIDTH) &
	137	& ,INTENT(INOUT) :: T_BYS, T_BYE &
	138	& ,U_BYS, U_BYE &
	139	& ,V_BYS, V_BYE &
	140	& ,Q_BYS, Q_BYE &
	141	& ,Q2_BYS, Q2_BYE &
	142	& ,CWM_BYS, CWM_BYE &
	143	& ,T_BTYS, T_BTYE &
	144	& ,U_BTYS, U_BTYE &
	145	& ,V_BTYS, V_BTYE &
	146	& ,Q_BTYS, Q_BTYE &
	147	& ,Q2_BTYS, Q2_BTYE &
	148	& ,CWM_BTYS, CWM_BTYE
	149
	150	REAL,DIMENSION(JMS:JME,1,SPEC_BDY_WIDTH) &
	151	& ,INTENT(INOUT) :: PD_BXS, PD_BXE &
	152	& ,PD_BTXS,PD_BTXE
	153
	154	REAL,DIMENSION(JMS:JME,KMS:KME,SPEC_BDY_WIDTH) &
	155	& ,INTENT(INOUT) :: T_BXS, T_BXE &
	156	& ,U_BXS, U_BXE &
	157	& ,V_BXS, V_BXE &
	158	& ,Q_BXS, Q_BXE &
	159	& ,Q2_BXS, Q2_BXE &
	160	& ,CWM_BXS, CWM_BXE &
	161	& ,T_BTXS, T_BTXE &
	162	& ,U_BTXS, U_BTXE &
	163	& ,V_BTXS, V_BTXE &
	164	& ,Q_BTXS, Q_BTXE &
	165	& ,Q2_BTXS, Q2_BTXE &
	166	& ,CWM_BTXS, CWM_BTXE
	167
	168	!
	169	REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: RES
	170	REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: PD
	171	!
	172	REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: CWM &
	173	& ,PINT,Q &
	174	& ,Q2,T,Z
	175	!
	176	REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME,NUM_MOIST) &
	177	& ,INTENT(INOUT) :: MOIST
	178	REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME,NUM_SCALAR) &
	179	& ,INTENT(INOUT) :: SCALAR
	180	!
	181	#ifdef WRF_CHEM
	182	REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,NUM_CHEM) &
	183	& ,INTENT(INOUT) :: CHEM
	184	TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
	185	#endif
	186	!
	187	!-----------------------------------------------------------------------
	188	!
	189	!*** LOCAL VARIABLES
	190	!
	191	INTEGER :: I,IB,IBDY,II,IIM,IM,IRTN,ISIZ1,ISIZ2 &
	192	& ,J,JB,JJ,JJM,JM,K,KK,N,NN,NREC,NUMGAS,NV,REC
	193	INTEGER :: MY_IS_GLB,MY_JS_GLB,MY_IE_GLB,MY_JE_GLB
	194	INTEGER :: I_M,ILPAD1,IRPAD1,JBPAD1,JTPAD1
	195	!
	196	REAL :: BCHR,CONVFAC,CWK,DT,PLYR,RRI
	197	!
	198	LOGICAL :: E_BDY,W_BDY,N_BDY,S_BDY
	199	!-----------------------------------------------------------------------
	200	!***********************************************************************
	201	!-----------------------------------------------------------------------
	202	!
	203	#ifdef WRF_CHEM
	204	!*** DETERMINE THE INDEX OF THE LAST GAS SPECIES
	205	NUMGAS=P_HO2
	206	NUMGAS=NUMG
	207	! NUMGAS = GET_LAST_GAS(CONFIG_FLAGS%CHEM_OPT)
	208	!
	209	#endif
	210	IM=IDE-IDS+1
	211	JM=JDE-JDS+1
	212	IIM=IM
	213	JJM=JM
	214	!
	215	ISIZ1=2*LB
	216	ISIZ2=2LB(KME-KMS)
	217	!
	218	W_BDY=(ITS==IDS)
	219	E_BDY=(ITE==IDE)
	220	S_BDY=(JTS==JDS)
	221	N_BDY=(JTE==JDE)
	222	!
	223	ILPAD1=1
	224	IF(W_BDY)ILPAD1=0
	225	IRPAD1=1
	226	IF(E_BDY)IRPAD1=0
	227	JBPAD1=1
	228	IF(S_BDY)JBPAD1=0
	229	JTPAD1=1
	230	IF(N_BDY)JTPAD1=0
	231	!
	232	MY_IS_GLB=ITS
	233	MY_IE_GLB=ITE
	234	MY_JS_GLB=JTS
	235	MY_JE_GLB=JTE
	236	!
	237	DT=DT0
	238	!
	239	!-----------------------------------------------------------------------
	240	!*** SOUTH AND NORTH BOUNDARIES
	241	!-----------------------------------------------------------------------
	242	!
	243	!*** USE IBDY=1 FOR SOUTH; 2 FOR NORTH
	244	!
	245	DO IBDY=1,2
	246	!
	247	!*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
	248	!
	249	IF(S_BDY.AND.IBDY==1) THEN
	250	JB=1 ! Which cell in from boundary
	251	JJ=1 ! Which cell in the domain
	252
	253	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	254	PD_BYS(I,1,JB)=PD_BYS(I,1,JB)+PD_BTYS(I,1,JB)*DT
	255	PD(I,JJ)=PD_BYS(I,1,JB)
	256	ENDDO
	257
	258	!$omp parallel do &
	259	!$omp& private(i,k)
	260	DO K=KTS,KTE
	261	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	262	T_BYS(I,K,JB)=T_BYS(I,K,JB)+T_BTYS(I,K,JB)*DT
	263	Q_BYS(I,K,JB)=Q_BYS(I,K,JB)+Q_BTYS(I,K,JB)*DT
	264	Q2_BYS(I,K,JB)=Q2_BYS(I,K,JB)+Q2_BTYS(I,K,JB)*DT
	265	CWM_BYS(I,K,JB)=CWM_BYS(I,K,JB)+CWM_BTYS(I,K,JB)*DT
	266	!
	267	T(I,JJ,K)=T_BYS(I,K,JB)
	268	Q(I,JJ,K)=Q_BYS(I,K,JB)
	269	Q2(I,JJ,K)=Q2_BYS(I,K,JB)
	270	CWM(I,JJ,K)=CWM_BYS(I,K,JB)
	271	PINT(I,JJ,K)=ETA1(K)*PDTOP &
	272	& +ETA2(K)PD(I,JJ)RES(I,JJ)+PT
	273	ENDDO
	274	ENDDO
	275
	276	ELSEIF(N_BDY.AND.IBDY==2) THEN
	277	JB=1 ! Which cell in from boundary
	278	JJ=JJM ! Which cell in the domain
	279
	280	!
	281	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	282	PD_BYE(I,1,JB)=PD_BYE(I,1,JB)+PD_BTYE(I,1,JB)*DT
	283	PD(I,JJ)=PD_BYE(I,1,JB)
	284	ENDDO
	285	!
	286	!$omp parallel do &
	287	!$omp& private(i,k)
	288	DO K=KTS,KTE
	289	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	290	T_BYE(I,K,JB)=T_BYE(I,K,JB)+T_BTYE(I,K,JB)*DT
	291	Q_BYE(I,K,JB)=Q_BYE(I,K,JB)+Q_BTYE(I,K,JB)*DT
	292	Q2_BYE(I,K,JB)=Q2_BYE(I,K,JB)+Q2_BTYE(I,K,JB)*DT
	293	CWM_BYE(I,K,JB)=CWM_BYE(I,K,JB)+CWM_BTYE(I,K,JB)*DT
	294	!
	295	T(I,JJ,K)=T_BYE(I,K,JB)
	296	Q(I,JJ,K)=Q_BYE(I,K,JB)
	297	Q2(I,JJ,K)=Q2_BYE(I,K,JB)
	298	CWM(I,JJ,K)=CWM_BYE(I,K,JB)
	299	PINT(I,JJ,K)=ETA1(K)*PDTOP &
	300	& +ETA2(K)PD(I,JJ)RES(I,JJ)+PT
	301	ENDDO
	302	ENDDO
	303
	304	! ENDIF ! for N/S boundaries
	305
	306	!
	307	DO I_M=1,N_MOIST
	308	IF(I_M==P_QV)THEN
	309	!$omp parallel do &
	310	!$omp& private(i,k)
	311	DO K=KTS,KTE
	312	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	313	MOIST(I,JJ,K,I_M)=Q(I,JJ,K)/(1.-Q(I,JJ,K))
	314	ENDDO
	315	ENDDO
	316	ELSE
	317	!$omp parallel do &
	318	!$omp& private(i,k)
	319	DO K=KTS,KTE
	320	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	321	MOIST(I,JJ,K,I_M)=0.
	322	ENDDO
	323	ENDDO
	324	ENDIF
	325	ENDDO
	326	DO I_M=2,N_SCALAR
	327	!$omp parallel do &
	328	!$omp& private(i,k)
	329	DO K=KTS,KTE
	330	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	331	SCALAR(I,JJ,K,I_M)=0.
	332	ENDDO
	333	ENDDO
	334	ENDDO
	335	#ifdef WRF_CHEM
	336	!$omp parallel do &
	337	!$omp& private(i,k,nv)
	338	DO NV=2,NUMG
	339	DO K=KTS,KTE
	340	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	341	CALL BDY_CHEM_VALUE (CHEM(I,K,JJ,NV),Z(I,JJ,K),NV,NUMG)
	342	ENDDO
	343	ENDDO
	344	ENDDO
	345	!$omp parallel do &
	346	!$omp& private(i,k,nv)
	347	DO NV=NUMG+1,NUM_CHEM
	348	DO K=KTS,KTE
	349	KK=MIN(K+1,KTE)
	350	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	351	PLYR=(PINT(I,JJ,K)+PINT(I,JJ,KK))*0.5
	352	RRI=R_DT(I,JJ,K)(1.+.608*Q(I,JJ,K))/PLYR
	353	CONVFAC=PLYR/RGASUNIV/T(I,JJ,K)
	354	CALL BDY_CHEM_VALUE_SORGAM (CHEM(I,K,JJ,NV),Z(I,JJ,K),NV, &
	355	CONFIG_FLAGS,RRI,CONVFAC,G)
	356	ENDDO
	357	ENDDO
	358	ENDDO
	359	#endif
	360	ENDIF
	361	ENDDO
	362	!
	363	!-----------------------------------------------------------------------
	364	!*** WEST AND EAST BOUNDARIES
	365	!-----------------------------------------------------------------------
	366	!
	367	!*** USE IBDY=1 FOR WEST; 2 FOR EAST.
	368	!
	369	DO IBDY=1,2
	370	!
	371	!*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
	372	!
	373	IF(W_BDY.AND.IBDY==1) THEN
	374	IB=1 ! Which cell in from boundary
	375	II=1 ! Which cell in the domain
	376	!
	377	DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
	378	IF(MOD(J,2)==1)THEN
	379	PD_BXS(J,1,IB)=PD_BXS(J,1,IB)+PD_BTXS(J,1,IB)*DT
	380	PD(II,J)=PD_BXS(J,1,IB)
	381	ENDIF
	382	ENDDO
	383	!
	384	!$omp parallel do &
	385	!$omp& private(j,k)
	386	DO K=KTS,KTE
	387	DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
	388	!
	389	IF(MOD(J,2)==1)THEN
	390	T_BXS(J,K,IB)=T_BXS(J,K,IB)+T_BTXS(J,K,IB)*DT
	391	Q_BXS(J,K,IB)=Q_BXS(J,K,IB)+Q_BTXS(J,K,IB)*DT
	392	Q2_BXS(J,K,IB)=Q2_BXS(J,K,IB)+Q2_BTXS(J,K,IB)*DT
	393	CWM_BXS(J,K,IB)=CWM_BXS(J,K,IB)+CWM_BTXS(J,K,IB)*DT
	394	!
	395	T(II,J,K)=T_BXS(J,K,IB)
	396	Q(II,J,K)=Q_BXS(J,K,IB)
	397	Q2(II,J,K)=Q2_BXS(J,K,IB)
	398	CWM(II,J,K)=CWM_BXS(J,K,IB)
	399	PINT(II,J,K)=ETA1(K)*PDTOP &
	400	& +ETA2(K)PD(II,J)RES(II,J)+PT
	401	ENDIF
	402	!
	403	ENDDO
	404	ENDDO
	405
	406	ELSEIF(E_BDY.AND.IBDY==2) THEN
	407	IB=1 ! Which cell in from boundary
	408	II=IIM ! Which cell in the domain
	409
	410	DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
	411	IF(MOD(J,2)==1)THEN
	412	PD_BXE(J,1,IB)=PD_BXE(J,1,IB)+PD_BTXE(J,1,IB)*DT
	413	PD(II,J)=PD_BXE(J,1,IB)
	414	ENDIF
	415	ENDDO
	416	!
	417	!$omp parallel do &
	418	!$omp& private(j,k)
	419	DO K=KTS,KTE
	420	DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
	421	!
	422	IF(MOD(J,2)==1)THEN
	423	T_BXE(J,K,IB)=T_BXE(J,K,IB)+T_BTXE(J,K,IB)*DT
	424	Q_BXE(J,K,IB)=Q_BXE(J,K,IB)+Q_BTXE(J,K,IB)*DT
	425	Q2_BXE(J,K,IB)=Q2_BXE(J,K,IB)+Q2_BTXE(J,K,IB)*DT
	426	CWM_BXE(J,K,IB)=CWM_BXE(J,K,IB)+CWM_BTXE(J,K,IB)*DT
	427	!
	428	T(II,J,K)=T_BXE(J,K,IB)
	429	Q(II,J,K)=Q_BXE(J,K,IB)
	430	Q2(II,J,K)=Q2_BXE(J,K,IB)
	431	CWM(II,J,K)=CWM_BXE(J,K,IB)
	432	PINT(II,J,K)=ETA1(K)*PDTOP &
	433	& +ETA2(K)PD(II,J)RES(II,J)+PT
	434	ENDIF
	435	!
	436	ENDDO
	437	ENDDO
	438	!
	439	! ENDIF ! for W/E boundaries
	440	!
	441	DO I_M=1,N_MOIST
	442	IF(I_M==P_QV)THEN
	443	!$omp parallel do &
	444	!$omp& private(j,k)
	445	DO K=KTS,KTE
	446	DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
	447	IF(MOD(J,2)==1)THEN
	448	MOIST(II,J,K,I_M)=Q(II,J,K)/(1.-Q(II,J,K))
	449	ENDIF
	450	ENDDO
	451	ENDDO
	452	!
	453	ELSE
	454	!$omp parallel do &
	455	!$omp& private(j,k)
	456	DO K=KTS,KTE
	457	DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
	458	IF(MOD(J,2)==1)THEN
	459	MOIST(II,J,K,I_M)=0.
	460	ENDIF
	461	ENDDO
	462	ENDDO
	463	!
	464	ENDIF
	465	ENDDO
	466	!
	467	DO I_M=2,N_SCALAR
	468	!$omp parallel do &
	469	!$omp& private(j,k)
	470	DO K=KTS,KTE
	471	DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
	472	IF(MOD(J,2)==1)THEN
	473	SCALAR(II,J,K,I_M)=0.
	474	ENDIF
	475	ENDDO
	476	ENDDO
	477	ENDDO
	478	!
	479	#ifdef WRF_CHEM
	480	!$omp parallel do &
	481	!$omp& private(nv,j,k)
	482	DO K=KTS,KTE
	483	KK=MIN(K+1,KTE)
	484	DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
	485	IF(MOD(J,2)==1)THEN
	486	DO NV=2,NUMG
	487	CALL BDY_CHEM_VALUE (CHEM(II,K,J,NV),Z(II,J,K),NV,NUMG)
	488	ENDDO
	489	!$omp parallel do &
	490	!$omp& private(nv)
	491	DO NV=NUMG+1,NUM_CHEM
	492	PLYR=(PINT(II,J,K)+PINT(II,J,KK))*0.5
	493	RRI=R_DT(II,J,K)(1.+P608*Q(II,J,K))/PLYR
	494	CONVFAC=PLYR/RGASUNIV/T(II,J,K)
	495	CALL BDY_CHEM_VALUE_SORGAM (CHEM(II,K,J,NV),Z(II,J,K),NV, &
	496	& CONFIG_FLAGS,RRI,CONVFAC,G)
	497	ENDDO
	498	ENDIF
	499	ENDDO
	500	ENDDO
	501
	502	#endif
	503	ENDIF
	504	ENDDO
	505	!
	506	!-----------------------------------------------------------------------
	507	!*** SPACE INTERPOLATION OF PD THEN REMAINING MASS VARIABLES
	508	!*** AT INNER BOUNDARY
	509	!-----------------------------------------------------------------------
	510	!
	511	!*** ONE ROW NORTH OF SOUTHERN BOUNDARY
	512	!
	513	IF(S_BDY)THEN
	514	DO I=MYIS,MYIE1
	515	PD(I,2)=0.25*(PD(I,1)+PD(I+1,1)+PD(I,3)+PD(I+1,3))
	516	ENDDO
	517	ENDIF
	518	!
	519	!*** ONE ROW SOUTH OF NORTHERN BOUNDARY
	520	!
	521	IF(N_BDY)THEN
	522	DO I=MYIS,MYIE1
	523	CWK=PD(I,JJM-1)
	524	PD(I,JJM-1)=0.25*(PD(I,JJM-2)+PD(I+1,JJM-2) &
	525	& +PD(I,JJM)+PD(I+1,JJM))
	526	!
	527	!*** NESTING TEST
	528	!
	529	IF(I<=IDE-1.AND.ABS(CWK-PD(I,JJM-1))>=300.)THEN
	530	WRITE(0,*)'PSEUDO HYDROSTATIC IMBALANCE AT THE NORTHERN BOUNDARY AT',I,JJM-1,'GRID #',GRIDID
	531	WRITE(0,*)' ',CWK/100.
	532	WRITE(0,*)PD(I,JJM)/100.,' ',PD(I+1,JJM)/100.
	533	WRITE(0,*)' ',PD(I,JJM-1)/100.
	534	WRITE(0,*)PD(I,JJM-2)/100.,' ',PD(I+1,JJM-2)/100.
	535	WRITE(0,*)
	536	ENDIF
	537
	538	ENDDO
	539	ENDIF
	540	!
	541	!*** ONE ROW EAST OF WESTERN BOUNDARY
	542	!
	543	IF(W_BDY)THEN
	544	DO J=4,JM-3,2
	545	!
	546	IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
	547	& .AND.J<=MY_JE_GLB+JTPAD1)THEN
	548	CWK=PD(1,J)
	549	JJ=J
	550	PD(1,JJ)=0.25*(PD(1,JJ-1)+PD(2,JJ-1)+PD(1,JJ+1)+PD(2,JJ+1))
	551	!
	552	!*** NESTING TEST
	553	!
	554	IF(ABS(CWK-PD(1,JJ))>300.)THEN
	555	WRITE(0,*)'PSEUDO HYDROSTATIC IMBALANCE AT THE WESTERN BOUNDARY AT',J,1,'GRID #',GRIDID
	556	WRITE(0,*)' ',CWK/100.
	557	WRITE(0,*)PD(1,JJ+1)/100.,' ',PD(2,JJ+1)/100.
	558	WRITE(0,*)' ',PD(1,JJ)/100.
	559	WRITE(0,*)PD(1,JJ-1)/100,' ',PD(2,JJ-1)/100.
	560	WRITE(0,*)
	561	ENDIF
	562
	563	ENDIF
	564	!
	565	ENDDO
	566	ENDIF
	567	!
	568	!*** ONE ROW WEST OF EASTERN BOUNDARY
	569	!
	570	IF(E_BDY)THEN
	571	DO J=4,JM-3,2
	572	!
	573	IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
	574	& .AND.J<=MY_JE_GLB+JTPAD1)THEN
	575	JJ=J
	576	PD(IIM-1,JJ)=0.25*(PD(IIM-1,JJ-1)+PD(IIM,JJ-1) &
	577	& +PD(IIM-1,JJ+1)+PD(IIM,JJ+1))
	578	ENDIF
	579	!
	580	ENDDO
	581	ENDIF
	582	!
	583	!-----------------------------------------------------------------------
	584	!
	585	!$omp parallel do &
	586	!$omp& private(i,j,jj,k)
	587	DO 200 K=KTS,KTE
	588	!
	589	!-----------------------------------------------------------------------
	590	!
	591	!*** ONE ROW NORTH OF SOUTHERN BOUNDARY
	592	!
	593	IF(S_BDY)THEN
	594	DO I=MYIS,MYIE1
	595	T(I,2,K)=(T(I,1,K)+T(I+1,1,K)+T(I,3,K)+T(I+1,3,K))*0.25
	596	Q(I,2,K)=(Q(I,1,K)+Q(I+1,1,K)+Q(I,3,K)+Q(I+1,3,K))*0.25
	597	Q2(I,2,K)=(Q2(I,1,K)+Q2(I+1,1,K)+Q2(I,3,K)+Q2(I+1,3,K))*0.25
	598	CWM(I,2,K)=(CWM(I,1,K)+CWM(I+1,1,K)+CWM(I,3,K)+CWM(I+1,3,K)) &
	599	& *0.25
	600	PINT(I,2,K)=ETA1(K)PDTOP+ETA2(K)PD(I,2)*RES(I,2)+PT
	601	ENDDO
	602	!
	603	DO I_M=1,N_MOIST
	604	IF(I_M==P_QV)THEN
	605	DO I=MYIS,MYIE1
	606	MOIST(I,2,K,I_M)=Q(I,2,K)/(1.-Q(I,2,K))
	607	ENDDO
	608	ELSE
	609	DO I=MYIS,MYIE1
	610	MOIST(I,2,K,I_M)=(MOIST(I,1,K,I_M) &
	611	& +MOIST(I+1,1,K,I_M) &
	612	& +MOIST(I,3,K,I_M) &
	613	& +MOIST(I+1,3,K,I_M))*0.25
	614	ENDDO
	615	ENDIF
	616	ENDDO
	617	!
	618	DO I_M=2,N_SCALAR
	619	DO I=MYIS,MYIE1
	620	SCALAR(I,2,K,I_M)=(SCALAR(I,1,K,I_M) &
	621	& +SCALAR(I+1,1,K,I_M) &
	622	& +SCALAR(I,3,K,I_M) &
	623	& +SCALAR(I+1,3,K,I_M))*0.25
	624	ENDDO
	625	ENDDO
	626	!
	627	ENDIF
	628	!
	629	!*** ONE ROW SOUTH OF NORTHERN BOUNDARY
	630	!
	631	IF(N_BDY)THEN
	632	DO I=MYIS,MYIE1
	633	T(I,JJM-1,K)=(T(I,JJM-2,K)+T(I+1,JJM-2,K) &
	634	& +T(I,JJM,K)+T(I+1,JJM,K)) &
	635	& *0.25
	636	Q(I,JJM-1,K)=(Q(I,JJM-2,K)+Q(I+1,JJM-2,K) &
	637	& +Q(I,JJM,K)+Q(I+1,JJM,K)) &
	638	& *0.25
	639	Q2(I,JJM-1,K)=(Q2(I,JJM-2,K)+Q2(I+1,JJM-2,K) &
	640	& +Q2(I,JJM,K)+Q2(I+1,JJM,K)) &
	641	& *0.25
	642	CWM(I,JJM-1,K)=(CWM(I,JJM-2,K)+CWM(I+1,JJM-2,K) &
	643	& +CWM(I,JJM,K)+CWM(I+1,JJM,K)) &
	644	& *0.25
	645	PINT(I,JJM-1,K)=ETA1(K)*PDTOP &
	646	& +ETA2(K)PD(I,JJM-1)RES(I,JJM-1)+PT
	647	ENDDO
	648	!
	649	DO I_M=1,N_MOIST
	650	IF(I_M==P_QV)THEN
	651	DO I=MYIS,MYIE1
	652	MOIST(I,JJM-1,K,I_M)=Q(I,JJM-1,K)/(1.-Q(I,JJM-1,K))
	653	ENDDO
	654	ELSE
	655	DO I=MYIS,MYIE1
	656	MOIST(I,JJM-1,K,I_M)=(MOIST(I,JJM-2,K,I_M) &
	657	& +MOIST(I+1,JJM-2,K,I_M) &
	658	& +MOIST(I,JJM,K,I_M) &
	659	& +MOIST(I+1,JJM,K,I_M))*0.25
	660	ENDDO
	661
	662	ENDIF
	663	ENDDO
	664	!
	665	DO I_M=2,N_SCALAR
	666	DO I=MYIS,MYIE1
	667	SCALAR(I,JJM-1,K,I_M)=(SCALAR(I,JJM-2,K,I_M) &
	668	& +SCALAR(I+1,JJM-2,K,I_M) &
	669	& +SCALAR(I,JJM,K,I_M) &
	670	& +SCALAR(I+1,JJM,K,I_M))*0.25
	671	ENDDO
	672	ENDDO
	673	!
	674	ENDIF
	675	!
	676	!*** ONE ROW EAST OF WESTERN BOUNDARY
	677	!
	678	IF(W_BDY)THEN
	679	DO J=4,JM-3,2
	680	!
	681	IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
	682	& .AND.J<=MY_JE_GLB+JTPAD1)THEN
	683	JJ=J
	684	T(1,JJ,K)=(T(1,JJ-1,K)+T(2,JJ-1,K) &
	685	& +T(1,JJ+1,K)+T(2,JJ+1,K)) &
	686	& *0.25
	687	Q(1,JJ,K)=(Q(1,JJ-1,K)+Q(2,JJ-1,K) &
	688	& +Q(1,JJ+1,K)+Q(2,JJ+1,K)) &
	689	& *0.25
	690	Q2(1,JJ,K)=(Q2(1,JJ-1,K)+Q2(2,JJ-1,K) &
	691	& +Q2(1,JJ+1,K)+Q2(2,JJ+1,K)) &
	692	& *0.25
	693	CWM(1,JJ,K)=(CWM(1,JJ-1,K)+CWM(2,JJ-1,K) &
	694	& +CWM(1,JJ+1,K)+CWM(2,JJ+1,K)) &
	695	& *0.25
	696	PINT(1,JJ,K)=ETA1(K)*PDTOP &
	697	& +ETA2(K)PD(1,JJ)RES(1,JJ)+PT
	698	!
	699	DO I_M=1,N_MOIST
	700	IF(I_M==P_QV)THEN
	701	MOIST(1,JJ,K,I_M)=Q(1,JJ,K)/(1.-Q(1,JJ,K))
	702	ELSE
	703	MOIST(1,JJ,K,I_M)=(MOIST(1,JJ-1,K,I_M) &
	704	& +MOIST(2,JJ-1,K,I_M) &
	705	& +MOIST(1,JJ+1,K,I_M) &
	706	& +MOIST(2,JJ+1,K,I_M))*0.25
	707	ENDIF
	708	ENDDO
	709	!
	710	DO I_M=2,N_SCALAR
	711	SCALAR(1,JJ,K,I_M)=(SCALAR(1,JJ-1,K,I_M) &
	712	& +SCALAR(2,JJ-1,K,I_M) &
	713	& +SCALAR(1,JJ+1,K,I_M) &
	714	& +SCALAR(2,JJ+1,K,I_M))*0.25
	715	ENDDO
	716	!
	717	ENDIF
	718	!
	719	ENDDO
	720	!
	721	ENDIF
	722	!
	723	!*** ONE ROW WEST OF EASTERN BOUNDARY
	724	!
	725	IF(E_BDY)THEN
	726	DO J=4,JM-3,2
	727	!
	728	IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
	729	& .AND.J<=MY_JE_GLB+JTPAD1)THEN
	730	JJ=J
	731	T(IIM-1,JJ,K)=(T(IIM-1,JJ-1,K)+T(IIM,JJ-1,K) &
	732	& +T(IIM-1,JJ+1,K)+T(IIM,JJ+1,K)) &
	733	& *0.25
	734	Q(IIM-1,JJ,K)=(Q(IIM-1,JJ-1,K)+Q(IIM,JJ-1,K) &
	735	& +Q(IIM-1,JJ+1,K)+Q(IIM,JJ+1,K)) &
	736	& *0.25
	737	Q2(IIM-1,JJ,K)=(Q2(IIM-1,JJ-1,K)+Q2(IIM,JJ-1,K) &
	738	& +Q2(IIM-1,JJ+1,K)+Q2(IIM,JJ+1,K)) &
	739	& *0.25
	740	CWM(IIM-1,JJ,K)=(CWM(IIM-1,JJ-1,K)+CWM(IIM,JJ-1,K) &
	741	& +CWM(IIM-1,JJ+1,K)+CWM(IIM,JJ+1,K)) &
	742	& *0.25
	743	PINT(IIM-1,JJ,K)=ETA1(K)*PDTOP &
	744	& +ETA2(K)PD(IIM-1,JJ)RES(IIM-1,JJ)+PT
	745	!
	746	DO I_M=1,N_MOIST
	747	IF(I_M==P_QV)THEN
	748	MOIST(IIM-1,JJ,K,I_M)=Q(IIM-1,JJ,K)/(1.-Q(IIM-1,JJ,K))
	749	ELSE
	750	MOIST(IIM-1,JJ,K,I_M)=(MOIST(IIM-1,JJ-1,K,I_M) &
	751	& +MOIST(IIM,JJ-1,K,I_M) &
	752	& +MOIST(IIM-1,JJ+1,K,I_M) &
	753	& +MOIST(IIM,JJ+1,K,I_M))*0.25
	754	ENDIF
	755	ENDDO
	756	!
	757	DO I_M=2,N_SCALAR
	758	SCALAR(IIM-1,JJ,K,I_M)=(SCALAR(IIM-1,JJ-1,K,I_M) &
	759	& +SCALAR(IIM,JJ-1,K,I_M) &
	760	& +SCALAR(IIM-1,JJ+1,K,I_M) &
	761	& +SCALAR(IIM,JJ+1,K,I_M))*0.25
	762	ENDDO
	763	!
	764	ENDIF
	765	!
	766	ENDDO
	767	ENDIF
	768	!-----------------------------------------------------------------------
	769	!
	770	200 CONTINUE
	771	!
	772	!-----------------------------------------------------------------------
	773	END SUBROUTINE BOCOH
	774	!-----------------------------------------------------------------------
	775	!***********************************************************************
	776	!-----------------------------------------------------------------------
	777	SUBROUTINE BOCOV(GRIDID,NTSD,DT,LB &
	778	& ,U_BXS,U_BXE,U_BYS,U_BYE &
	779	& ,V_BXS,V_BXE,V_BYS,V_BYE &
	780	& ,U_BTXS,U_BTXE,U_BTYS,U_BTYE &
	781	& ,V_BTXS,V_BTXE,V_BTYS,V_BTYE &
	782	& ,U,V &
	783	& ,SPEC_BDY_WIDTH &
	784	& ,IHE,IHW,IVE,IVW &
	785	& ,IDS,IDE,JDS,JDE,KDS,KDE &
	786	& ,IMS,IME,JMS,JME,KMS,KME &
	787	& ,ITS,ITE,JTS,JTE,KTS,KTE)
	788	!***********************************************************************
	789	!$$$ SUBPROGRAM DOCUMENTATION BLOCK
	790	! . . .
	791	! SUBPROGRAM: BOCOV UPDATE WIND POINTS ON BOUNDARY
	792	! PRGRMMR: JANJIC ORG: W/NP22 DATE: 94-03-08
	793	!
	794	! ABSTRACT:
	795	! U AND V COMPONENTS OF THE WIND ARE UPDATED ON THE
	796	! DOMAIN BOUNDARY BY APPLYING THE PRE-COMPUTED
	797	! TENDENCIES AT EACH TIME STEP. AN EXTRAPOLATION FROM
	798	! INSIDE THE DOMAIN IS USED FOR THE COMPONENT TANGENTIAL
	799	! TO THE BOUNDARY IF THE NORMAL COMPONENT IS OUTWARD.
	800	!
	801	! PROGRAM HISTORY LOG:
	802	! 87-??-?? MESINGER - ORIGINATOR
	803	! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
	804	! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
	805	! 01-03-13 BLACK - CONVERTED TO WRF STRUCTURE
	806	! 02-09-06 WOLFE - MORE CONVERSION TO GLOBAL INDEXING
	807	! 04-11-23 BLACK - THREADED
	808	! 05-12-19 BLACK - CONVERTED FROM IKJ TO IJK
	809	! 06-06-02 GOPAL - MODIFICATIONS FOR NESTING
	810	!
	811	! USAGE: CALL BOCOH FROM SUBROUTINE SOLVE_NMM
	812	! INPUT ARGUMENT LIST:
	813	!
	814	! NOTE THAT IDE AND JDE INSIDE ROUTINE SHOULD BE PASSED IN
	815	! AS WHAT WRF CONSIDERS THE UNSTAGGERED GRID DIMENSIONS; THAT
	816	! IS, 1 LESS THAN THE IDE AND JDE SET BY WRF FRAMEWORK, JM
	817	!
	818	! OUTPUT ARGUMENT LIST:
	819	!
	820	! OUTPUT FILES:
	821	! NONE
	822	!
	823	! SUBPROGRAMS CALLED:
	824	!
	825	! UNIQUE: NONE
	826	!
	827	! LIBRARY: NONE
	828	!
	829	! ATTRIBUTES:
	830	! LANGUAGE: FORTRAN 90
	831	! MACHINE : IBM
	832	!$$$
	833	!***********************************************************************
	834	!-----------------------------------------------------------------------
	835	!
	836	IMPLICIT NONE
	837	!
	838	!-----------------------------------------------------------------------
	839	INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
	840	& ,IMS,IME,JMS,JME,KMS,KME &
	841	& ,ITS,ITE,JTS,JTE,KTS,KTE
	842	INTEGER,INTENT(IN) :: SPEC_BDY_WIDTH
	843	!
	844	INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
	845	!
	846	INTEGER,INTENT(IN) :: GRIDID
	847	INTEGER,INTENT(IN) :: LB,NTSD
	848	!
	849	REAL,INTENT(IN) :: DT
	850	!
	851	REAL,DIMENSION(IMS:IME,KMS:KME,SPEC_BDY_WIDTH),INTENT(INOUT) :: &
	852	& U_BYS,U_BYE,V_BYS,V_BYE &
	853	& ,U_BTYS,U_BTYE &
	854	& ,V_BTYS,V_BTYE
	855
	856	REAL,DIMENSION(JMS:JME,KMS:KME,SPEC_BDY_WIDTH),INTENT(INOUT) :: &
	857	& U_BXS,U_BXE,V_BXS,V_BXE &
	858	& ,U_BTXS,U_BTXE &
	859	& ,V_BTXS,V_BTXE
	860	!
	861	REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: U,V
	862	!-----------------------------------------------------------------------
	863	!
	864	!*** LOCAL VARIABLES
	865	!
	866	INTEGER :: I,II,IIM,IM,J,JJ,JJM,JM,K,N
	867	INTEGER :: MY_IS_GLB, MY_JS_GLB,MY_IE_GLB,MY_JE_GLB
	868	INTEGER :: IBDY,JB,IB
	869	INTEGER :: ILPAD1,IRPAD1,JBPAD1,JTPAD1
	870	LOGICAL :: E_BDY,W_BDY,N_BDY,S_BDY
	871	!-----------------------------------------------------------------------
	872	!***********************************************************************
	873	!-----------------------------------------------------------------------
	874	!
	875	!-----------------------------------------------------------------------
	876	!*** TIME INTERPOLATION OF U AND V AT THE OUTER BOUNDARY
	877	!-----------------------------------------------------------------------
	878	!
	879	IM=IDE-IDS+1
	880	JM=JDE-JDS+1
	881	IIM=IM
	882	JJM=JM
	883	!
	884	W_BDY=(ITS==IDS)
	885	E_BDY=(ITE==IDE)
	886	S_BDY=(JTS==JDS)
	887	N_BDY=(JTE==JDE)
	888	!
	889	ILPAD1=1
	890	IF(ITS==IDS)ILPAD1=0
	891	IRPAD1=1
	892	IF(ITE==IDE)ILPAD1=0
	893	JBPAD1=1
	894	IF(JTS==JDS)JBPAD1=0
	895	JTPAD1=1
	896	IF(JTE==JDE)JTPAD1=0
	897	!
	898	MY_IS_GLB=ITS
	899	MY_IE_GLB=ITE
	900	MY_JS_GLB=JTS
	901	MY_JE_GLB=JTE
	902	!
	903	!-----------------------------------------------------------------------
	904	!*** SOUTH AND NORTH BOUNDARIES
	905	!*** USE IBDY=1 FOR SOUTH; 2 FOR NORTH.
	906	!-----------------------------------------------------------------------
	907	!
	908	DO IBDY=1,2
	909	!
	910	!*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
	911	!
	912	IF(S_BDY.AND.IBDY==1) THEN
	913	!
	914	JB=1 ! Which cell in from Boundary
	915	JJ=1 ! Which cell in the Domain
	916	!
	917	!$omp parallel do &
	918	!$omp& private(i,k)
	919	DO K=KTS,KTE
	920	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	921	U_BYS(I,K,JB)=U_BYS(I,K,JB)+U_BTYS(I,K,JB)*DT
	922	V_BYS(I,K,JB)=V_BYS(I,K,JB)+V_BTYS(I,K,JB)*DT
	923	U(I,JJ,K)=U_BYS(I,K,JB)
	924	V(I,JJ,K)=V_BYS(I,K,JB)
	925	ENDDO
	926	ENDDO
	927	!
	928
	929	ELSEIF(N_BDY.AND.IBDY==2) THEN
	930	JB=1 ! Which cell in from Boundary
	931	JJ=JJM ! Which cell in the Domain
	932
	933	!$omp parallel do &
	934	!$omp& private(i,k)
	935	DO K=KTS,KTE
	936	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	937	U_BYE(I,K,JB)=U_BYE(I,K,JB)+U_BTYE(I,K,JB)*DT
	938	V_BYE(I,K,JB)=V_BYE(I,K,JB)+V_BTYE(I,K,JB)*DT
	939	U(I,JJ,K)=U_BYE(I,K,JB)
	940	V(I,JJ,K)=V_BYE(I,K,JB)
	941	ENDDO
	942	ENDDO
	943
	944
	945	ENDIF
	946	ENDDO
	947
	948	!
	949	!-----------------------------------------------------------------------
	950	!*** WEST AND EAST BOUNDARIES
	951	!*** USE IBDY=1 FOR WEST; 2 FOR EAST.
	952	!-----------------------------------------------------------------------
	953	!
	954	DO IBDY=1,2
	955	!
	956	!*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
	957	!
	958	IF(W_BDY.AND.IBDY==1) THEN
	959	IB=1 ! Which cell in from boundary
	960	II=1 ! Which cell in the domain
	961	!
	962	!$omp parallel do &
	963	!$omp& private(j,k)
	964	DO K=KTS,KTE
	965	DO J=MAX(JTS-1,JDS+2-1),MIN(JTE+1,JDE-1)
	966	IF(MOD(J,2)==0)THEN
	967	U_BXS(J,K,IB)=U_BXS(J,K,IB)+U_BTXS(J,K,IB)*DT
	968	V_BXS(J,K,IB)=V_BXS(J,K,IB)+V_BTXS(J,K,IB)*DT
	969	U(II,J,K)=U_BXS(J,K,IB)
	970	V(II,J,K)=V_BXS(J,K,IB)
	971	ENDIF
	972	ENDDO
	973	ENDDO
	974
	975	ELSEIF (E_BDY.AND.IBDY==2) THEN
	976	IB=1 ! Which cell in from boundary
	977	II=IIM ! Which cell in the domain
	978
	979	!$omp parallel do &
	980	!$omp& private(j,k)
	981	DO K=KTS,KTE
	982	DO J=MAX(JTS-1,JDS+2-1),MIN(JTE+1,JDE-1)
	983	IF(MOD(J,2)==0)THEN
	984	U_BXE(J,K,IB)=U_BXE(J,K,IB)+U_BTXE(J,K,IB)*DT
	985	V_BXE(J,K,IB)=V_BXE(J,K,IB)+V_BTXE(J,K,IB)*DT
	986	U(II,J,K)=U_BXE(J,K,IB)
	987	V(II,J,K)=V_BXE(J,K,IB)
	988	ENDIF
	989	ENDDO
	990	ENDDO
	991
	992	!
	993	ENDIF
	994
	995
	996
	997	ENDDO
	998
	999	!
	1000	!-----------------------------------------------------------------------
	1001	!*** EXTRAPOLATION OF TANGENTIAL VELOCITY AT OUTFLOW POINTS
	1002	!*** BASED ON SOME DISCUSSIONS WITH ZAVISA, AND MY EXPERIMENTS
	1003	!*** ON GRAVITY PULSE FOR NESTED DOMAIN.
	1004	!-----------------------------------------------------------------------
	1005	!
	1006	IF(GRIDID/=1)GO TO 201
	1007	!
	1008	!-----------------------------------------------------------------------
	1009	!
	1010	!$omp parallel do &
	1011	!$omp& private(i,j,jj,k)
	1012	DO 200 K=KTS,KTE
	1013	!
	1014	!-----------------------------------------------------------------------
	1015	!
	1016	!*** SOUTHERN BOUNDARY
	1017	!
	1018	IF(S_BDY)THEN
	1019	DO I=MYIS1_P1,MYIE2_P1
	1020	IF(V(I,1,K)<0.)U(I,1,K)=2.*U(I,3,K)-U(I,5,K)
	1021	ENDDO
	1022	ENDIF
	1023	!
	1024	!*** NORTHERN BOUNDARY
	1025	!
	1026	IF(N_BDY)THEN
	1027	DO I=MYIS1_P1,MYIE2_P1
	1028	IF(V(I,JJM,K)>0.) &
	1029	& U(I,JJM,K)=2.*U(I,JJM-2,K)-U(I,JJM-4,K)
	1030	ENDDO
	1031	ENDIF
	1032	!
	1033	!*** WESTERN BOUNDARY
	1034	!
	1035	DO J=4,JM-3,2
	1036	IF(W_BDY)THEN
	1037	!
	1038	IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
	1039	& .AND.J<=MY_JE_GLB+JTPAD1)THEN
	1040	JJ=J
	1041	IF(U(1,JJ,K)<0.) &
	1042	& V(1,JJ,K)=2.*V(2,JJ,K)-V(3,JJ,K)
	1043	ENDIF
	1044	!
	1045	ENDIF
	1046	ENDDO
	1047	!
	1048	!*** EASTERN BOUNDARY
	1049	!
	1050	DO J=4,JM-3,2
	1051	IF(E_BDY)THEN
	1052	!
	1053	IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
	1054	& .AND.J<=MY_JE_GLB+JTPAD1)THEN
	1055	JJ=J
	1056	IF(U(IIM,JJ,K)>0.) &
	1057	& V(IIM,JJ,K)=2.*V(IIM-1,JJ,K)-V(IIM-2,JJ,K)
	1058	ENDIF
	1059	!
	1060	ENDIF
	1061	ENDDO
	1062	!-----------------------------------------------------------------------
	1063	!
	1064	200 CONTINUE
	1065
	1066	201 CONTINUE
	1067	!
	1068	!-----------------------------------------------------------------------
	1069	!
	1070	!-----------------------------------------------------------------------
	1071	!*** SPACE INTERPOLATION OF U AND V AT THE INNER BOUNDARY
	1072	!-----------------------------------------------------------------------
	1073	!
	1074	!-----------------------------------------------------------------------
	1075	!
	1076	!$omp parallel do &
	1077	!$omp& private(i,j,jj,k)
	1078	DO 300 K=KTS,KTE
	1079	!
	1080	!-----------------------------------------------------------------------
	1081	!
	1082	!*** SOUTHWEST CORNER
	1083	!
	1084	IF(S_BDY.AND.W_BDY)THEN
	1085	U(2,2,K)=D06666(4.(U(1,1,K)+U(2,1,K)+U(2,3,K)) &
	1086	& + U(1,2,K)+U(1,4,K)+U(2,4,K))
	1087	V(2,2,K)=D06666(4.(V(1,1,K)+V(2,1,K)+V(2,3,K)) &
	1088	& +V(1,2,K)+V(1,4,K)+V(2,4,K))
	1089	ENDIF
	1090	!
	1091	!*** SOUTHEAST CORNER
	1092	!
	1093	IF(S_BDY.AND.E_BDY)THEN
	1094	U(IIM-1,2,K)=D06666(4.(U(IIM-2,1,K)+U(IIM-1,1,K) &
	1095	& +U(IIM-2,3,K)) &
	1096	& +U(IIM,2,K)+U(IIM,4,K)+U(IIM-1,4,K))
	1097	V(IIM-1,2,K)=D06666(4.(V(IIM-2,1,K)+V(IIM-1,1,K) &
	1098	& +V(IIM-2,3,K)) &
	1099	& +V(IIM,2,K)+V(IIM,4,K)+V(IIM-1,4,K))
	1100	ENDIF
	1101	!
	1102	!*** NORTHWEST CORNER
	1103	!
	1104	IF(N_BDY.AND.W_BDY)THEN
	1105	U(2,JJM-1,K)=D06666(4.(U(1,JJM,K)+U(2,JJM,K)+U(2,JJM-2,K)) &
	1106	& +U(1,JJM-1,K)+U(1,JJM-3,K) &
	1107	& +U(2,JJM-3,K))
	1108	V(2,JJM-1,K)=D06666(4.(V(1,JJM,K)+V(2,JJM,K)+V(2,JJM-2,K)) &
	1109	& +V(1,JJM-1,K)+V(1,JJM-3,K) &
	1110	& +V(2,JJM-3,K))
	1111	ENDIF
	1112	!
	1113	!*** NORTHEAST CORNER
	1114	!
	1115	IF(N_BDY.AND.E_BDY)THEN
	1116	U(IIM-1,JJM-1,K)= &
	1117	& D06666(4.(U(IIM-2,JJM,K)+U(IIM-1,JJM,K)+U(IIM-2,JJM-2,K)) &
	1118	& +U(IIM,JJM-1,K)+U(IIM,JJM-3,K)+U(IIM-1,JJM-3,K))
	1119	V(IIM-1,JJM-1,K)= &
	1120	& D06666(4.(V(IIM-2,JJM,K)+V(IIM-1,JJM,K)+V(IIM-2,JJM-2,K)) &
	1121	& +V(IIM,JJM-1,K)+V(IIM,JJM-3,K)+V(IIM-1,JJM-3,K))
	1122	ENDIF
	1123	!
	1124	!-----------------------------------------------------------------------
	1125	!*** SPACE INTERPOLATION OF U AND V AT THE INNER BOUNDARY
	1126	!-----------------------------------------------------------------------
	1127	!
	1128	!*** ONE ROW NORTH OF SOUTHERN BOUNDARY
	1129	!
	1130	IF(S_BDY)THEN
	1131	DO I=MYIS2,MYIE2
	1132	U(I,2,K)=(U(I-1,1,K)+U(I,1,K)+U(I-1,3,K)+U(I,3,K))*0.25
	1133	V(I,2,K)=(V(I-1,1,K)+V(I,1,K)+V(I-1,3,K)+V(I,3,K))*0.25
	1134	ENDDO
	1135	ENDIF
	1136	!
	1137	!*** ONE ROW SOUTH OF NORTHERN BOUNDARY
	1138	!
	1139	IF(N_BDY)THEN
	1140	DO I=MYIS2,MYIE2
	1141	U(I,JJM-1,K)=(U(I-1,JJM-2,K)+U(I,JJM-2,K) &
	1142	& +U(I-1,JJM,K)+U(I,JJM,K))*0.25
	1143	V(I,JJM-1,K)=(V(I-1,JJM-2,K)+V(I,JJM-2,K) &
	1144	& +V(I-1,JJM,K)+V(I,JJM,K))*0.25
	1145	ENDDO
	1146	ENDIF
	1147	!
	1148	!*** ONE ROW EAST OF WESTERN BOUNDARY
	1149	!
	1150	DO J=3,JM-2,2
	1151	IF(W_BDY)THEN
	1152	IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
	1153	& .AND.J<=MY_JE_GLB+JTPAD1)THEN
	1154	JJ=J
	1155	U(1,JJ,K)=(U(1,JJ-1,K)+U(2,JJ-1,K) &
	1156	& +U(1,JJ+1,K)+U(2,JJ+1,K))*0.25
	1157	V(1,JJ,K)=(V(1,JJ-1,K)+V(2,JJ-1,K) &
	1158	& +V(1,JJ+1,K)+V(2,JJ+1,K))*0.25
	1159
	1160
	1161	ENDIF
	1162	ENDIF
	1163	ENDDO
	1164	!
	1165	!*** ONE ROW WEST OF EASTERN BOUNDARY
	1166	!
	1167	IF(E_BDY)THEN
	1168	DO J=3,JM-2,2
	1169	IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1 &
	1170	& .AND.J<=MY_JE_GLB+JTPAD1)THEN
	1171	JJ=J
	1172	U(IIM-1,JJ,K)=0.25*(U(IIM-1,JJ-1,K)+U(IIM,JJ-1,K) &
	1173	& +U(IIM-1,JJ+1,K)+U(IIM,JJ+1,K))
	1174	V(IIM-1,JJ,K)=0.25*(V(IIM-1,JJ-1,K)+V(IIM,JJ-1,K) &
	1175	& +V(IIM-1,JJ+1,K)+V(IIM,JJ+1,K))
	1176	ENDIF
	1177	ENDDO
	1178	ENDIF
	1179	!-----------------------------------------------------------------------
	1180	!
	1181	300 CONTINUE
	1182	!
	1183	!-----------------------------------------------------------------------
	1184	!
	1185	END SUBROUTINE BOCOV
	1186	!
	1187	!-----------------------------------------------------------------------
	1188	!
	1189	END MODULE MODULE_BNDRY_COND
	1190	!
	1191	!-----------------------------------------------------------------------

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

Download in other formats:

Original Format