!----------------------------------------------------------------------- ! !NCEP_MESO:MODEL_LAYER: BOUNDARY CONDITION UPDATES ! !----------------------------------------------------------------------- ! #include "nmm_loop_basemacros.h" #include "nmm_loop_macros.h" ! !----------------------------------------------------------------------- ! MODULE MODULE_BNDRY_COND ! !----------------------------------------------------------------------- USE MODULE_STATE_DESCRIPTION USE MODULE_MODEL_CONSTANTS !----------------------------------------------------------------------- #ifdef DM_PARALLEL INCLUDE "mpif.h" #endif !----------------------------------------------------------------------- REAL :: D06666=0.06666666 !----------------------------------------------------------------------- ! CONTAINS ! !*********************************************************************** SUBROUTINE BOCOH(GRIDID,NTSD,DT0,NEST,NBC,NBOCO,LAST_TIME,TSPH & ! GRIDID ADDED BY GOPAL & ,LB,ETA1,ETA2,PDTOP,PT,RES,HTM & & ,PD_B,T_B,Q_B,U_B,V_B,Q2_B,CWM_B & & ,PD_BT,T_BT,Q_BT,U_BT,V_BT,Q2_BT,CWM_BT & & ,PD,T,Q,Q2,CWM,PINT,MOIST,N_MOIST,SCALAR,N_SCALAR & #ifdef WRF_CHEM & ,CHEM,NUM_CHE,CONFIG_FLAGS & #endif & ,IJDS,IJDE,SPEC_BDY_WIDTH,Z & ! min/max(id,jd) & ,IHE,IHW,IVE,IVW,INDX3_WRK & & ,IDS,IDE,JDS,JDE,KDS,KDE & & ,IMS,IME,JMS,JME,KMS,KME & & ,ITS,ITE,JTS,JTE,KTS,KTE) !*********************************************************************** !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! . . . ! SUBPROGRAM: BOCOH UPDATE MASS POINTS ON BOUNDARY ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 94-03-08 ! ! ABSTRACT: ! TEMPERATURE, SPECIFIC HUMIDITY, AND SURFACE PRESSURE ! ARE UPDATED ON THE DOMAIN BOUNDARY BY APPLYING THE ! PRE-COMPUTED TENDENCIES AT EACH TIME STEP. ! ! PROGRAM HISTORY LOG: ! 87-??-?? MESINGER - ORIGINATOR ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D in HORIZONTAL ! 96-12-13 BLACK - FINAL MODIFICATION FOR NESTED RUNS ! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY ! 00-01-06 BLACK - MODIFIED FOR JANJIC NONHYDROSTATIC CODE ! 00-09-14 BLACK - MODIFIED FOR DIRECT ACCESS READ ! 01-03-12 BLACK - CONVERTED TO WRF STRUCTURE ! 02-08-29 MICHALAKES - CHANGED II=I-MY_IS_GLB+1 TO II=I ! ADDED CONDITIONAL COMPILATION AROUND MPI ! CONVERT INDEXING FROM LOCAL TO GLOBAL ! 02-09-06 WOLFE - MORE CONVERSION TO GLOBAL INDEXING ! 04-11-18 BLACK - THREADED ! ! USAGE: CALL BOCOH FROM SUBROUTINE SOLVE_NMM ! INPUT ARGUMENT LIST: ! ! NOTE THAT IDE AND JDE INSIDE ROUTINE SHOULD BE PASSED IN ! AS WHAT WRF CONSIDERS THE UNSTAGGERED GRID DIMENSIONS; THAT ! IS, 1 LESS THAN THE IDE AND JDE SET BY WRF FRAMEWORK, JM ! ! OUTPUT ARGUMENT LIST: ! ! OUTPUT FILES: ! NONE ! ! SUBPROGRAMS CALLED: ! ! UNIQUE: NONE ! ! LIBRARY: NONE ! ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! MACHINE : IBM !$$$ !*********************************************************************** !----------------------------------------------------------------------- #ifdef WRF_CHEM USE MODULE_INPUT_CHEM_DATA #endif !----------------------------------------------------------------------- ! IMPLICIT NONE ! !----------------------------------------------------------------------- LOGICAL,INTENT(IN) :: NEST ! INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE & & ,IMS,IME,JMS,JME,KMS,KME & & ,ITS,ITE,JTS,JTE,KTS,KTE INTEGER,INTENT(IN) :: IJDS,IJDE,SPEC_BDY_WIDTH INTEGER,INTENT(IN) :: N_MOIST, N_SCALAR #ifdef WRF_CHEM INTEGER,INTENT(IN) :: NUM_CHE #endif ! INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW !----------------------------------------------------------------------- !!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! NMM_MAX_DIM is set in configure.wrf and must agree with the value of ! dimspec q in the Registry/Registry !!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !----------------------------------------------------------------------- INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK ! INTEGER,INTENT(IN) :: GRIDID INTEGER,INTENT(IN) :: LB,NBC,NTSD LOGICAL,INTENT(IN) :: LAST_TIME INTEGER,INTENT(INOUT) :: NBOCO ! REAL,INTENT(IN) :: DT0,PDTOP,PT,TSPH ! REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA1,ETA2 ! REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM ! REAL,DIMENSION(IJDS:IJDE,1,SPEC_BDY_WIDTH,4) & & ,INTENT(INOUT) :: PD_B,PD_BT ! REAL,DIMENSION(IJDS:IJDE,KMS:KME,SPEC_BDY_WIDTH,4) & & ,INTENT(INOUT) :: CWM_B,Q_B,Q2_B & & ,T_B,U_B,V_B REAL,DIMENSION(IJDS:IJDE,KMS:KME,SPEC_BDY_WIDTH,4) & & ,INTENT(INOUT) :: CWM_BT,Q_BT,Q2_BT & & ,T_BT,U_BT,V_BT ! REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: RES REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: PD ! REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: CWM & & ,PINT,Q & & ,Q2,T,Z REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,NUM_MOIST),INTENT(INOUT) :: MOIST REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,NUM_SCALAR),INTENT(INOUT) :: SCALAR #ifdef WRF_CHEM REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,1:NUM_CHEM),INTENT(INOUT) :: CHEM TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS #endif !----------------------------------------------------------------------- ! !*** LOCAL VARIABLES ! INTEGER :: BF,I,IB,IBDY,II,IIM,IM,IRTN,ISIZ1,ISIZ2 & & ,J,JB,JJ,JJM,JM,K,N,NN,NREC,REC,NV INTEGER :: MY_IS_GLB,MY_JS_GLB,MY_IE_GLB,MY_JE_GLB INTEGER :: I_M,ILPAD1,IRPAD1,JBPAD1,JTPAD1 ! LOGICAL :: E_BDY,W_BDY,N_BDY,S_BDY ! REAL :: BCHR,RHTM,SHTM,DT REAL :: CONVFAC,RRI,PLYR INTEGER KK,NUMGAS REAL :: CWK !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- ! #ifdef WRF_CHEM ! DETERMINE THE INDEX OF THE LAST GAS SPECIES NUMGAS=P_HO2 ! NUMGAS = GET_LAST_GAS(CONFIG_FLAGS%CHEM_OPT) #endif IM=IDE-IDS+1 JM=JDE-JDS+1 IIM=IM JJM=JM ! ISIZ1=2*LB ISIZ2=2*LB*(KME-KMS) ! W_BDY=(ITS==IDS) E_BDY=(ITE==IDE) S_BDY=(JTS==JDS) N_BDY=(JTE==JDE) ! ILPAD1=1 IF(W_BDY)ILPAD1=0 IRPAD1=1 IF(E_BDY)IRPAD1=0 JBPAD1=1 IF(S_BDY)JBPAD1=0 JTPAD1=1 IF(N_BDY)JTPAD1=0 ! MY_IS_GLB=ITS MY_IE_GLB=ITE MY_JS_GLB=JTS MY_JE_GLB=JTE ! DT=DT0 ! !----------------------------------------------------------------------- !*** SOUTH AND NORTH BOUNDARIES !----------------------------------------------------------------------- ! !*** USE IBDY=1 FOR SOUTH; 2 FOR NORTH ! DO IBDY=1,2 ! !*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY. ! IF((S_BDY.AND.IBDY==1).OR.(N_BDY.AND.IBDY==2))THEN ! IF(IBDY==1)THEN BF=P_YSB ! Which boundary (YSB=the boundary where Y is at its start) JB=1 ! Which cell in from boundary JJ=1 ! Which cell in the domain ELSE BF=P_YEB ! Which boundary (YEB=the boundary where Y is at its end) JB=1 ! Which cell in from boundary JJ=JJM ! Which cell in the domain ENDIF ! DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE) PD_B(I,1,JB,BF)=PD_B(I,1,JB,BF)+PD_BT(I,1,JB,BF)*DT PD(I,JJ)=PD_B(I,1,JB,BF) ENDDO ! !$omp parallel do & !$omp& private(i,k) DO K=KTS,KTE DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE) T_B(I,K,JB,BF)=T_B(I,K,JB,BF)+T_BT(I,K,JB,BF)*DT Q_B(I,K,JB,BF)=Q_B(I,K,JB,BF)+Q_BT(I,K,JB,BF)*DT Q2_B(I,K,JB,BF)=Q2_B(I,K,JB,BF)+Q2_BT(I,K,JB,BF)*DT CWM_B(I,K,JB,BF)=CWM_B(I,K,JB,BF)+CWM_BT(I,K,JB,BF)*DT T(I,K,JJ)=T_B(I,K,JB,BF) Q(I,K,JJ)=Q_B(I,K,JB,BF) Q2(I,K,JJ)=Q2_B(I,K,JB,BF) CWM(I,K,JJ)=CWM_B(I,K,JB,BF) PINT(I,K,JJ)=ETA1(K)*PDTOP & & +ETA2(K)*PD(I,JJ)*RES(I,JJ)+PT ENDDO ENDDO DO I_M=1,N_MOIST IF(I_M==P_QV)THEN !$omp parallel do & !$omp& private(i,k) DO K=KTS,KTE DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE) MOIST(I,K,JJ,I_M)=Q(I,K,JJ)/(1.-Q(I,K,JJ)) ENDDO ENDDO ELSE !$omp parallel do & !$omp& private(i,k) DO K=KTS,KTE DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE) MOIST(I,K,JJ,I_M)=0. ENDDO ENDDO ENDIF ENDDO DO I_M=2,N_SCALAR !$omp parallel do & !$omp& private(i,k) DO K=KTS,KTE DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE) SCALAR(I,K,JJ,I_M)=0. ENDDO ENDDO ENDDO #ifdef WRF_CHEM !$omp parallel do & !$omp& private(i,k,nv) DO NV=P_SO2,P_HO2 DO K=KTS,KTE DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE) CALL BDY_CHEM_VALUE (CHEM(I,K,JJ,NV), Z(I,K,JJ), NV,NUMGAS) ENDDO ENDDO ENDDO !$omp parallel do & !$omp& private(i,k,nv) DO NV=P_HO2+1,NUM_CHEM DO K=KTS,KTE KK=MIN(K+1,KTE) DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE) PLYR=(PINT(I,K,JJ)+PINT(I,KK,JJ))*0.5 RRI=R_D*T(I,K,JJ)*(1.+.608*Q(I,K,JJ))/PLYR CONVFAC=PLYR/RGASUNIV/T(I,K,JJ) CALL BDY_CHEM_VALUE_SORGAM (CHEM(I,K,JJ,NV), Z(I,K,JJ), NV, & CONFIG_FLAGS,RRI,CONVFAC,G) ENDDO ENDDO ENDDO #endif ENDIF ENDDO ! !----------------------------------------------------------------------- !*** WEST AND EAST BOUNDARIES !----------------------------------------------------------------------- ! !*** USE IBDY=1 FOR WEST; 2 FOR EAST. ! DO IBDY=1,2 ! !*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY. ! IF((W_BDY.AND.IBDY==1).OR.(E_BDY.AND.IBDY==2))THEN IF(IBDY==1)THEN BF=P_XSB ! Which boundary (XSB=the boundary where X is at its start) IB=1 ! Which cell in from boundary II=1 ! Which cell in the domain ELSE BF=P_XEB ! Which boundary (XEB=the boundary where X is at its end) IB=1 ! Which cell in from boundary II=IIM ! Which cell in the domain ENDIF ! DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2) IF(MOD(J,2)==1)THEN PD_B(J,1,IB,BF)=PD_B(J,1,IB,BF)+PD_BT(J,1,IB,BF)*DT PD(II,J)=PD_B(J,1,IB,BF) ENDIF ENDDO ! !$omp parallel do & !$omp& private(j,k) DO K=KTS,KTE DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2) ! IF(MOD(J,2)==1)THEN T_B(J,K,IB,BF)=T_B(J,K,IB,BF)+T_BT(J,K,IB,BF)*DT Q_B(J,K,IB,BF)=Q_B(J,K,IB,BF)+Q_BT(J,K,IB,BF)*DT Q2_B(J,K,IB,BF)=Q2_B(J,K,IB,BF)+Q2_BT(J,K,IB,BF)*DT CWM_B(J,K,IB,BF)=CWM_B(J,K,IB,BF)+CWM_BT(J,K,IB,BF)*DT T(II,K,J)=T_B(J,K,IB,BF) Q(II,K,J)=Q_B(J,K,IB,BF) Q2(II,K,J)=Q2_B(J,K,IB,BF) CWM(II,K,J)=CWM_B(J,K,IB,BF) PINT(II,K,J)=ETA1(K)*PDTOP & & +ETA2(K)*PD(II,J)*RES(II,J)+PT ENDIF ! ENDDO ENDDO ! DO I_M=1,N_MOIST IF(I_M==P_QV)THEN !$omp parallel do & !$omp& private(j,k) DO K=KTS,KTE DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2) IF(MOD(J,2)==1)THEN MOIST(II,K,J,I_M)=Q(II,K,J)/(1.-Q(II,K,J)) ENDIF ENDDO ENDDO ! ELSE !$omp parallel do & !$omp& private(j,k) DO K=KTS,KTE DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2) IF(MOD(J,2)==1)THEN MOIST(II,K,J,I_M)=0. ENDIF ENDDO ENDDO ! ENDIF ENDDO ! DO I_M=2,N_SCALAR !$omp parallel do & !$omp& private(j,k) DO K=KTS,KTE DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2) IF(MOD(J,2)==1)THEN SCALAR(II,K,J,I_M)=0. ENDIF ENDDO ENDDO ENDDO ! #ifdef WRF_CHEM !$omp parallel do & !$omp& private(nv,j,k) DO K=KTS,KTE DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2) IF(MOD(J,2)==1)THEN DO NV=P_SO2,P_HO2 CALL BDY_CHEM_VALUE (CHEM(II,K,J,NV), Z(II,K,J), NV,NUMGAS) ENDDO !$omp parallel do & !$omp& private(nv) DO NV=P_HO2+1,NUM_CHEM PLYR=(PINT(II,K,J)+PINT(II,KK,J))*0.5 RRI=R_D*T(II,K,J)*(1.+P608*Q(II,K,J))/PLYR CONVFAC=PLYR/RGASUNIV/T(II,K,J) CALL BDY_CHEM_VALUE_SORGAM (CHEM(II,K,J,NV), Z(II,K,J), NV, & & CONFIG_FLAGS,RRI,CONVFAC,G) ENDDO ENDIF ENDDO ENDDO #endif ENDIF ENDDO ! !----------------------------------------------------------------------- !*** SPACE INTERPOLATION OF PD THEN REMAINING MASS VARIABLES !*** AT INNER BOUNDARY !----------------------------------------------------------------------- ! !*** ONE ROW NORTH OF SOUTHERN BOUNDARY ! IF(S_BDY)THEN DO I=MYIS,MYIE1 SHTM=HTM(I,KTE,1)+HTM(I+1,KTE,1)+HTM(I,KTE,3)+HTM(I+1,KTE,3) PD(I,2)=(PD(I,1)*HTM(I,KTE,1)+PD(I+1,1)*HTM(I+1,KTE,1) & & +PD(I,3)*HTM(I,KTE,3)+PD(I+1,3)*HTM(I+1,KTE,3))/SHTM ENDDO ENDIF ! !*** ONE ROW SOUTH OF NORTHERN BOUNDARY ! IF(N_BDY)THEN DO I=MYIS,MYIE1 CWK=PD(I,JJM-1) SHTM=HTM(I,KTE,JJM-2)+HTM(I+1,KTE,JJM-2)+HTM(I,KTE,JJM) & & +HTM(I+1,KTE,JJM) PD(I,JJM-1)=(PD(I,JJM-2)*HTM(I,KTE,JJM-2) & & +PD(I+1,JJM-2)*HTM(I+1,KTE,JJM-2) & & +PD(I,JJM)*HTM(I,KTE,JJM) & & +PD(I+1,JJM)*HTM(I+1,KTE,JJM))/SHTM ! test. IF(I<=IDE-1.AND.ABS(CWK-PD(I,JJM-1))>=300.)THEN WRITE(0,*)'PSEUDO HYDROSTATIC IMBALANCE AT THE NORTHERN BOUNDARY AT',I,JJM-1,'GRID #',GRIDID WRITE(0,*)' ',CWK/100. WRITE(0,*)PD(I,JJM)/100.,' ',PD(I+1,JJM)/100. WRITE(0,*)' ',PD(I,JJM-1)/100. WRITE(0,*)PD(I,JJM-2)/100.,' ',PD(I+1,JJM-2)/100. WRITE(0,*) ENDIF ENDDO ENDIF ! !*** ONE ROW EAST OF WESTERN BOUNDARY ! IF(W_BDY)THEN DO J=4,JM-3,2 ! IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1 & & .AND.J<=MY_JE_GLB+JTPAD1)THEN CWK=PD(1,J) JJ=J SHTM=HTM(1,KTE,JJ-1)+HTM(2,KTE,JJ-1)+HTM(1,KTE,JJ+1) & & +HTM(2,KTE,JJ+1) PD(1,JJ)=(PD(1,JJ-1)*HTM(1,KTE,JJ-1) & & +PD(2,JJ-1)*HTM(2,KTE,JJ-1) & & +PD(1,JJ+1)*HTM(1,KTE,JJ+1) & & +PD(2,JJ+1)*HTM(2,KTE,JJ+1))/SHTM ! test. IF(ABS(CWK-PD(1,JJ))>300.)THEN WRITE(0,*)'PSEUDO HYDROSTATIC IMBALANCE AT THE WESTERN BOUNDARY AT',J,1,'GRID #',GRIDID WRITE(0,*)' ',CWK/100. WRITE(0,*)PD(1,JJ+1)/100.,' ',PD(2,JJ+1)/100. WRITE(0,*)' ',PD(1,JJ)/100. WRITE(0,*)PD(1,JJ-1)/100,' ',PD(2,JJ-1)/100. WRITE(0,*) ENDIF ENDIF ! ENDDO ENDIF ! !*** ONE ROW WEST OF EASTERN BOUNDARY ! IF(E_BDY)THEN DO J=4,JM-3,2 ! IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1 & & .AND.J<=MY_JE_GLB+JTPAD1)THEN JJ=J SHTM=HTM(IIM-1,KTE,JJ-1)+HTM(IIM,KTE,JJ-1) & & +HTM(IIM-1,KTE,JJ+1)+HTM(IIM,KTE,JJ+1) PD(IIM-1,JJ)=(PD(IIM-1,JJ-1)*HTM(IIM-1,KTE,JJ-1) & & +PD(IIM,JJ-1)*HTM(IIM,KTE,JJ-1) & & +PD(IIM-1,JJ+1)*HTM(IIM-1,KTE,JJ+1) & & +PD(IIM,JJ+1)*HTM(IIM,KTE,JJ+1))/SHTM ENDIF ! ENDDO ENDIF ! !----------------------------------------------------------------------- ! !$omp parallel do & !$omp& private(i,j,jj,k,rhtm) DO 200 K=KTS,KTE ! !----------------------------------------------------------------------- ! !*** ONE ROW NORTH OF SOUTHERN BOUNDARY ! IF(S_BDY)THEN DO I=MYIS,MYIE1 RHTM=1./(HTM(I,K,1)+HTM(I+1,K,1)+HTM(I,K,3)+HTM(I+1,K,3)) T(I,K,2)=(T(I,K,1)*HTM(I,K,1)+T(I+1,K,1)*HTM(I+1,K,1) & & +T(I,K,3)*HTM(I,K,3)+T(I+1,K,3)*HTM(I+1,K,3)) & & *RHTM Q(I,K,2)=(Q(I,K,1)*HTM(I,K,1)+Q(I+1,K,1)*HTM(I+1,K,1) & & +Q(I,K,3)*HTM(I,K,3)+Q(I+1,K,3)*HTM(I+1,K,3)) & & *RHTM Q2(I,K,2)=(Q2(I,K,1)*HTM(I,K,1)+Q2(I+1,K,1)*HTM(I+1,K,1) & & +Q2(I,K,3)*HTM(I,K,3)+Q2(I+1,K,3)*HTM(I+1,K,3)) & & *RHTM CWM(I,K,2)=(CWM(I,K,1)*HTM(I,K,1)+CWM(I+1,K,1)*HTM(I+1,K,1) & & +CWM(I,K,3)*HTM(I,K,3)+CWM(I+1,K,3)*HTM(I+1,K,3)) & & *RHTM PINT(I,K,2)=ETA1(K)*PDTOP+ETA2(K)*PD(I,2)*RES(I,2)+PT ENDDO DO I_M=1,N_MOIST IF(I_M==P_QV)THEN DO I=MYIS,MYIE1 MOIST(I,K,2,I_M)=Q(I,K,2)/(1.-Q(I,K,2)) ENDDO ELSE DO I=MYIS,MYIE1 MOIST(I,K,2,I_M)=(MOIST(I,K,1,I_M)*HTM(I,K,1) & & +MOIST(I+1,K,1,I_M)*HTM(I+1,K,1) & & +MOIST(I,K,3,I_M)*HTM(I,K,3) & & +MOIST(I+1,K,3,I_M)*HTM(I+1,K,3)) & & *RHTM ENDDO ENDIF ENDDO ! DO I_M=2,N_SCALAR DO I=MYIS,MYIE1 SCALAR(I,K,2,I_M)=(SCALAR(I,K,1,I_M)*HTM(I,K,1) & & +SCALAR(I+1,K,1,I_M)*HTM(I+1,K,1) & & +SCALAR(I,K,3,I_M)*HTM(I,K,3) & & +SCALAR(I+1,K,3,I_M)*HTM(I+1,K,3)) & & *RHTM ENDDO ENDDO ! ENDIF ! !*** ONE ROW SOUTH OF NORTHERN BOUNDARY ! IF(N_BDY)THEN DO I=MYIS,MYIE1 RHTM=1./(HTM(I,K,JJM-2)+HTM(I+1,K,JJM-2) & & +HTM(I,K,JJM)+HTM(I+1,K,JJM)) T(I,K,JJM-1)=(T(I,K,JJM-2)*HTM(I,K,JJM-2) & & +T(I+1,K,JJM-2)*HTM(I+1,K,JJM-2) & & +T(I,K,JJM)*HTM(I,K,JJM) & & +T(I+1,K,JJM)*HTM(I+1,K,JJM)) & & *RHTM Q(I,K,JJM-1)=(Q(I,K,JJM-2)*HTM(I,K,JJM-2) & & +Q(I+1,K,JJM-2)*HTM(I+1,K,JJM-2) & & +Q(I,K,JJM)*HTM(I,K,JJM) & & +Q(I+1,K,JJM)*HTM(I+1,K,JJM)) & & *RHTM Q2(I,K,JJM-1)=(Q2(I,K,JJM-2)*HTM(I,K,JJM-2) & & +Q2(I+1,K,JJM-2)*HTM(I+1,K,JJM-2) & & +Q2(I,K,JJM)*HTM(I,K,JJM) & & +Q2(I+1,K,JJM)*HTM(I+1,K,JJM)) & & *RHTM CWM(I,K,JJM-1)=(CWM(I,K,JJM-2)*HTM(I,K,JJM-2) & & +CWM(I+1,K,JJM-2)*HTM(I+1,K,JJM-2) & & +CWM(I,K,JJM)*HTM(I,K,JJM) & & +CWM(I+1,K,JJM)*HTM(I+1,K,JJM)) & & *RHTM PINT(I,K,JJM-1)=ETA1(K)*PDTOP & & +ETA2(K)*PD(I,JJM-1)*RES(I,JJM-1)+PT ENDDO DO I_M=1,N_MOIST IF(I_M==P_QV)THEN DO I=MYIS,MYIE1 MOIST(I,K,JJM-1,I_M)=Q(I,K,JJM-1)/(1.-Q(I,K,JJM-1)) ENDDO ELSE DO I=MYIS,MYIE1 MOIST(I,K,JJM-1,I_M)=(MOIST(I,K,JJM-2,I_M)*HTM(I,K,JJM-2) & & +MOIST(I+1,K,JJM-2,I_M)*HTM(I+1,K,JJM-2) & & +MOIST(I,K,JJM,I_M)*HTM(I,K,JJM) & & +MOIST(I+1,K,JJM,I_M)*HTM(I+1,K,JJM)) & & *RHTM ENDDO ENDIF ENDDO ! DO I_M=2,N_SCALAR DO I=MYIS,MYIE1 SCALAR(I,K,JJM-1,I_M)=(SCALAR(I,K,JJM-2,I_M)*HTM(I,K,JJM-2) & & +SCALAR(I+1,K,JJM-2,I_m)*HTM(I+1,K,JJM-2) & & +SCALAR(I,K,JJM,I_M)*HTM(I,K,JJM) & & +SCALAR(I+1,K,JJM,I_M)*HTM(I+1,K,JJM)) & & *RHTM ENDDO ENDDO ! ENDIF ! !*** ONE ROW EAST OF WESTERN BOUNDARY ! IF(W_BDY)THEN DO J=4,JM-3,2 ! IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1 & & .AND.J<=MY_JE_GLB+JTPAD1)THEN JJ=J RHTM=1./(HTM(1,K,JJ-1)+HTM(2,K,JJ-1) & & +HTM(1,K,JJ+1)+HTM(2,K,JJ+1)) T(1,K,JJ)=(T(1,K,JJ-1)*HTM(1,K,JJ-1) & & +T(2,K,JJ-1)*HTM(2,K,JJ-1) & & +T(1,K,JJ+1)*HTM(1,K,JJ+1) & & +T(2,K,JJ+1)*HTM(2,K,JJ+1)) & & *RHTM Q(1,K,JJ)=(Q(1,K,JJ-1)*HTM(1,K,JJ-1) & & +Q(2,K,JJ-1)*HTM(2,K,JJ-1) & & +Q(1,K,JJ+1)*HTM(1,K,JJ+1) & & +Q(2,K,JJ+1)*HTM(2,K,JJ+1)) & & *RHTM Q2(1,K,JJ)=(Q2(1,K,JJ-1)*HTM(1,K,JJ-1) & & +Q2(2,K,JJ-1)*HTM(2,K,JJ-1) & & +Q2(1,K,JJ+1)*HTM(1,K,JJ+1) & & +Q2(2,K,JJ+1)*HTM(2,K,JJ+1)) & & *RHTM CWM(1,K,JJ)=(CWM(1,K,JJ-1)*HTM(1,K,JJ-1) & & +CWM(2,K,JJ-1)*HTM(2,K,JJ-1) & & +CWM(1,K,JJ+1)*HTM(1,K,JJ+1) & & +CWM(2,K,JJ+1)*HTM(2,K,JJ+1)) & & *RHTM PINT(1,K,JJ)=ETA1(K)*PDTOP & & +ETA2(K)*PD(1,JJ)*RES(1,JJ)+PT DO I_M=1,N_MOIST IF(I_M==P_QV)THEN MOIST(1,K,JJ,I_M)=Q(1,K,JJ)/(1.-Q(1,K,JJ)) ELSE MOIST(1,K,JJ,I_M)=(MOIST(1,K,JJ-1,I_M)*HTM(1,K,JJ-1) & & +MOIST(2,K,JJ-1,I_M)*HTM(2,K,JJ-1) & & +MOIST(1,K,JJ+1,I_M)*HTM(1,K,JJ+1) & & +MOIST(2,K,JJ+1,I_M)*HTM(2,K,JJ+1)) & & *RHTM ENDIF ENDDO ! DO I_M=2,N_SCALAR SCALAR(1,K,JJ,I_M)=(SCALAR(1,K,JJ-1,I_M)*HTM(1,K,JJ-1) & & +SCALAR(2,K,JJ-1,I_M)*HTM(2,K,JJ-1) & & +SCALAR(1,K,JJ+1,I_M)*HTM(1,K,JJ+1) & & +SCALAR(2,K,JJ+1,I_M)*HTM(2,K,JJ+1)) & & *RHTM ENDDO ! ENDIF ! ENDDO ! ENDIF ! !*** ONE ROW WEST OF EASTERN BOUNDARY ! IF(E_BDY)THEN DO J=4,JM-3,2 ! IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1 & & .AND.J<=MY_JE_GLB+JTPAD1)THEN JJ=J RHTM=1./(HTM(IIM-1,K,JJ-1)+HTM(IIM,K,JJ-1) & & +HTM(IIM-1,K,JJ+1)+HTM(IIM,K,JJ+1)) T(IIM-1,K,JJ)=(T(IIM-1,K,JJ-1)*HTM(IIM-1,K,JJ-1) & & +T(IIM,K,JJ-1)*HTM(IIM,K,JJ-1) & & +T(IIM-1,K,JJ+1)*HTM(IIM-1,K,JJ+1) & & +T(IIM,K,JJ+1)*HTM(IIM,K,JJ+1)) & & *RHTM Q(IIM-1,K,JJ)=(Q(IIM-1,K,JJ-1)*HTM(IIM-1,K,JJ-1) & & +Q(IIM,K,JJ-1)*HTM(IIM,K,JJ-1) & & +Q(IIM-1,K,JJ+1)*HTM(IIM-1,K,JJ+1) & & +Q(IIM,K,JJ+1)*HTM(IIM,K,JJ+1)) & & *RHTM Q2(IIM-1,K,JJ)=(Q2(IIM-1,K,JJ-1)*HTM(IIM-1,K,JJ-1) & & +Q2(IIM,K,JJ-1)*HTM(IIM,K,JJ-1) & & +Q2(IIM-1,K,JJ+1)*HTM(IIM-1,K,JJ+1) & & +Q2(IIM,K,JJ+1)*HTM(IIM,K,JJ+1)) & & *RHTM CWM(IIM-1,K,JJ)=(CWM(IIM-1,K,JJ-1)*HTM(IIM-1,K,JJ-1) & & +CWM(IIM,K,JJ-1)*HTM(IIM,K,JJ-1) & & +CWM(IIM-1,K,JJ+1)*HTM(IIM-1,K,JJ+1) & & +CWM(IIM,K,JJ+1)*HTM(IIM,K,JJ+1)) & & *RHTM PINT(IIM-1,K,JJ)=ETA1(K)*PDTOP & & +ETA2(K)*PD(IIM-1,JJ)*RES(IIM-1,JJ)+PT ! DO I_M=1,N_MOIST IF(I_M==P_QV)THEN MOIST(IIM-1,K,JJ,I_M)=Q(IIM-1,K,JJ)/(1.-Q(IIM-1,K,JJ)) ELSE MOIST(IIM-1,K,JJ,I_M)=(MOIST(IIM-1,K,JJ-1,I_M)*HTM(IIM-1,K,JJ-1) & & +MOIST(IIM,K,JJ-1,I_M)*HTM(IIM,K,JJ-1) & & +MOIST(IIM-1,K,JJ+1,I_M)*HTM(IIM-1,K,JJ+1) & & +MOIST(IIM,K,JJ+1,I_M)*HTM(IIM,K,JJ+1)) & & *RHTM ENDIF ENDDO ! DO I_M=2,N_SCALAR SCALAR(IIM-1,K,JJ,I_M)=(SCALAR(IIM-1,K,JJ-1,I_M)*HTM(IIM-1,K,JJ-1) & & +SCALAR(IIM,K,JJ-1,I_M)*HTM(IIM,K,JJ-1) & & +SCALAR(IIM-1,K,JJ+1,I_M)*HTM(IIM-1,K,JJ+1) & & +SCALAR(IIM,K,JJ+1,I_M)*HTM(IIM,K,JJ+1)) & & *RHTM ENDDO ! ENDIF ! ENDDO ENDIF !----------------------------------------------------------------------- ! 200 CONTINUE ! !----------------------------------------------------------------------- END SUBROUTINE BOCOH !----------------------------------------------------------------------- !*********************************************************************** SUBROUTINE BOCOV(GRIDID,NTSD,DT,LB,VTM,U_B,V_B,U_BT,V_BT & ! GRIDID ADDED BY GOPAL & ,U,V & & ,IJDS,IJDE,SPEC_BDY_WIDTH & ! min/max(id,jd) & ,IHE,IHW,IVE,IVW,INDX3_WRK & & ,IDS,IDE,JDS,JDE,KDS,KDE & & ,IMS,IME,JMS,JME,KMS,KME & & ,ITS,ITE,JTS,JTE,KTS,KTE) !*********************************************************************** !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! . . . ! SUBPROGRAM: BOCOV UPDATE WIND POINTS ON BOUNDARY ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 94-03-08 ! ! ABSTRACT: ! U AND V COMPONENTS OF THE WIND ARE UPDATED ON THE ! DOMAIN BOUNDARY BY APPLYING THE PRE-COMPUTED ! TENDENCIES AT EACH TIME STEP. AN EXTRAPOLATION FROM ! INSIDE THE DOMAIN IS USED FOR THE COMPONENT TANGENTIAL ! TO THE BOUNDARY IF THE NORMAL COMPONENT IS OUTWARD. ! ! PROGRAM HISTORY LOG: ! 87-??-?? MESINGER - ORIGINATOR ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL ! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY ! 01-03-13 BLACK - CONVERTED TO WRF STRUCTURE ! 02-09-06 WOLFE - MORE CONVERSION TO GLOBAL INDEXING ! 04-11-23 BLACK - THREADED ! ! USAGE: CALL BOCOH FROM SUBROUTINE SOLVE_NMM ! INPUT ARGUMENT LIST: ! ! NOTE THAT IDE AND JDE INSIDE ROUTINE SHOULD BE PASSED IN ! AS WHAT WRF CONSIDERS THE UNSTAGGERED GRID DIMENSIONS; THAT ! IS, 1 LESS THAN THE IDE AND JDE SET BY WRF FRAMEWORK, JM ! ! OUTPUT ARGUMENT LIST: ! ! OUTPUT FILES: ! NONE ! ! SUBPROGRAMS CALLED: ! ! UNIQUE: NONE ! ! LIBRARY: NONE ! ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! MACHINE : IBM !$$$ !*********************************************************************** !----------------------------------------------------------------------- ! IMPLICIT NONE ! !----------------------------------------------------------------------- INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE & & ,IMS,IME,JMS,JME,KMS,KME & & ,ITS,ITE,JTS,JTE,KTS,KTE INTEGER,INTENT(IN) :: IJDS,IJDE,SPEC_BDY_WIDTH ! INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW !----------------------------------------------------------------------- !!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! NMM_MAX_DIM is set in configure.wrf and must agree with ! the value of dimspec q in the Registry/Registry !!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !----------------------------------------------------------------------- INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK ! INTEGER,INTENT(IN) :: GRIDID INTEGER,INTENT(IN) :: LB,NTSD ! REAL,INTENT(IN) :: DT ! REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: VTM ! REAL,DIMENSION(IJDS:IJDE,KMS:KME,SPEC_BDY_WIDTH,4),INTENT(INOUT) & & :: U_B,V_B,U_BT,V_BT ! REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: U,V !----------------------------------------------------------------------- ! !*** LOCAL VARIABLES ! INTEGER :: I,II,IIM,IM,J,JJ,JJM,JM,K,N INTEGER :: MY_IS_GLB, MY_JS_GLB,MY_IE_GLB,MY_JE_GLB INTEGER :: IBDY,BF,JB,IB INTEGER :: ILPAD1,IRPAD1,JBPAD1,JTPAD1 LOGICAL :: E_BDY,W_BDY,N_BDY,S_BDY !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- ! !----------------------------------------------------------------------- !*** TIME INTERPOLATION OF U AND V AT THE OUTER BOUNDARY !----------------------------------------------------------------------- ! IM=IDE-IDS+1 JM=JDE-JDS+1 IIM=IM JJM=JM ! W_BDY=(ITS==IDS) E_BDY=(ITE==IDE) S_BDY=(JTS==JDS) N_BDY=(JTE==JDE) ! ILPAD1=1 IF(ITS==IDS)ILPAD1=0 IRPAD1=1 IF(ITE==IDE)ILPAD1=0 JBPAD1=1 IF(JTS==JDS)JBPAD1=0 JTPAD1=1 IF(JTE==JDE)JTPAD1=0 ! MY_IS_GLB=ITS MY_IE_GLB=ITE MY_JS_GLB=JTS MY_JE_GLB=JTE ! !----------------------------------------------------------------------- !*** SOUTH AND NORTH BOUNDARIES !*** USE IBDY=1 FOR SOUTH; 2 FOR NORTH. !----------------------------------------------------------------------- ! DO IBDY=1,2 ! !*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY. ! IF((S_BDY.AND.IBDY==1).OR.(N_BDY.AND.IBDY==2))THEN ! IF(IBDY==1)THEN BF=P_YSB ! Which boundary (YSB=the boundary where Y is at its start) JB=1 ! Which cell in from Boundary JJ=1 ! Which cell in the Domain ELSE BF=P_YEB ! Which boundary (YEB=the boundary where Y is at its end) JB=1 ! Which cell in from Boundary JJ=JJM ! Which cell in the Domain ENDIF ! !$omp parallel do & !$omp& private(i,k) DO K=KTS,KTE DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE) U_B(I,K,JB,BF)=U_B(I,K,JB,BF)+U_BT(I,K,JB,BF)*DT V_B(I,K,JB,BF)=V_B(I,K,JB,BF)+V_BT(I,K,JB,BF)*DT U(I,K,JJ)=U_B(I,K,JB,BF) V(I,K,JJ)=V_B(I,K,JB,BF) ENDDO ENDDO ! ENDIF ENDDO ! !----------------------------------------------------------------------- !*** WEST AND EAST BOUNDARIES !*** USE IBDY=1 FOR WEST; 2 FOR EAST. !----------------------------------------------------------------------- ! DO IBDY=1,2 ! !*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY. ! IF((W_BDY.AND.IBDY==1).OR.(E_BDY.AND.IBDY==2))THEN ! IF(IBDY==1)THEN BF=P_XSB ! Which boundary (YSB=the boundary where Y is at its start) IB=1 ! Which cell in from boundary II=1 ! Which cell in the domain ELSE BF=P_XEB ! Which boundary (YEB=the boundary where Y is at its end) IB=1 ! Which cell in from boundary II=IIM ! Which cell in the domain ENDIF ! !$omp parallel do & !$omp& private(j,k) DO K=KTS,KTE DO J=MAX(JTS-1,JDS+2-1),MIN(JTE+1,JDE-1) IF(MOD(J,2)==0)THEN U_B(J,K,IB,BF)=U_B(J,K,IB,BF)+U_BT(J,K,IB,BF)*DT V_B(J,K,IB,BF)=V_B(J,K,IB,BF)+V_BT(J,K,IB,BF)*DT U(II,K,J)=U_B(J,K,IB,BF) V(II,K,J)=V_B(J,K,IB,BF) ENDIF ENDDO ENDDO ! ENDIF ENDDO ! !----------------------------------------------------------------------- !*** EXTRAPOLATION OF TANGENTIAL VELOCITY AT OUTFLOW POINTS !*** BASED ON SOME DISCUSSIONS WITH ZAVISA AND EXPERIMENTS !*** ON GRAVITY PULSE FOR NESTED DOMAIN. !----------------------------------------------------------------------- ! IF(GRIDID/=1)GO TO 201 ! !----------------------------------------------------------------------- ! !$omp parallel do & !$omp& private(i,j,jj,k) DO 200 K=KTS,KTE ! !----------------------------------------------------------------------- ! !*** SOUTHERN BOUNDARY ! IF(S_BDY)THEN DO I=MYIS1_P1,MYIE2_P1 IF(V(I,K,1)<0.)U(I,K,1)=(VTM(I,K,5)+1.)*U(I,K,3) & & -VTM(I,K,5) *U(I,K,5) ENDDO ENDIF ! !*** NORTHERN BOUNDARY ! IF(N_BDY)THEN DO I=MYIS1_P1,MYIE2_P1 IF(V(I,K,JJM)>0.) & & U(I,K,JJM)=(VTM(I,K,JJM-4)+1.)*U(I,K,JJM-2) & & -VTM(I,K,JJM-4) *U(I,K,JJM-4) ENDDO ENDIF ! !*** WESTERN BOUNDARY ! DO J=4,JM-3,2 IF(W_BDY)THEN ! IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1 & & .AND.J<=MY_JE_GLB+JTPAD1)THEN JJ=J IF(U(1,K,JJ)<0.) & & V(1,K,JJ)=(VTM(3,K,JJ)+1.)*V(2,K,JJ) & & -VTM(3,K,JJ) *V(3,K,JJ) ENDIF ! ENDIF ENDDO ! !*** EASTERN BOUNDARY ! DO J=4,JM-3,2 IF(E_BDY)THEN ! IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1 & & .AND.J<=MY_JE_GLB+JTPAD1)THEN JJ=J IF(U(IIM,K,JJ)>0.) & & V(IIM,K,JJ)=(VTM(IIM-2,K,JJ)+1.)*V(IIM-1,K,JJ) & & -VTM(IIM-2,K,JJ) *V(IIM-2,K,JJ) ENDIF ! ENDIF ENDDO !----------------------------------------------------------------------- ! 200 CONTINUE 201 CONTINUE ! !----------------------------------------------------------------------- ! !----------------------------------------------------------------------- !*** SPACE INTERPOLATION OF U AND V AT THE INNER BOUNDARY !----------------------------------------------------------------------- ! !----------------------------------------------------------------------- ! !$omp parallel do & !$omp& private(i,j,jj,k) DO 300 K=KTS,KTE ! !----------------------------------------------------------------------- ! !*** SOUTHWEST CORNER ! IF(S_BDY.AND.W_BDY)THEN U(2,K,2)=D06666*(4.*(U(1,K,1)+U(2,K,1)+U(2,K,3)) & & + U(1,K,2)+U(1,K,4)+U(2,K,4)) V(2,K,2)=D06666*(4.*(V(1,K,1)+V(2,K,1)+V(2,K,3)) & & +V(1,K,2)+V(1,K,4)+V(2,K,4)) ENDIF ! !*** SOUTHEAST CORNER ! IF(S_BDY.AND.E_BDY)THEN U(IIM-1,K,2)=D06666*(4.*(U(IIM-2,K,1)+U(IIM-1,K,1) & & +U(IIM-2,K,3)) & & +U(IIM,K,2)+U(IIM,K,4)+U(IIM-1,K,4)) V(IIM-1,K,2)=D06666*(4.*(V(IIM-2,K,1)+V(IIM-1,K,1) & & +V(IIM-2,K,3)) & & +V(IIM,K,2)+V(IIM,K,4)+V(IIM-1,K,4)) ENDIF ! !*** NORTHWEST CORNER ! IF(N_BDY.AND.W_BDY)THEN U(2,K,JJM-1)=D06666*(4.*(U(1,K,JJM)+U(2,K,JJM)+U(2,K,JJM-2)) & & +U(1,K,JJM-1)+U(1,K,JJM-3) & & +U(2,K,JJM-3)) V(2,K,JJM-1)=D06666*(4.*(V(1,K,JJM)+V(2,K,JJM)+V(2,K,JJM-2)) & & +V(1,K,JJM-1)+V(1,K,JJM-3) & & +V(2,K,JJM-3)) ENDIF ! !*** NORTHEAST CORNER ! IF(N_BDY.AND.E_BDY)THEN U(IIM-1,K,JJM-1)= & & D06666*(4.*(U(IIM-2,K,JJM)+U(IIM-1,K,JJM)+U(IIM-2,K,JJM-2)) & & +U(IIM,K,JJM-1)+U(IIM,K,JJM-3)+U(IIM-1,K,JJM-3)) V(IIM-1,K,JJM-1)= & & D06666*(4.*(V(IIM-2,K,JJM)+V(IIM-1,K,JJM)+V(IIM-2,K,JJM-2)) & & +V(IIM,K,JJM-1)+V(IIM,K,JJM-3)+V(IIM-1,K,JJM-3)) ENDIF ! !----------------------------------------------------------------------- !*** SPACE INTERPOLATION OF U AND V AT THE INNER BOUNDARY !----------------------------------------------------------------------- ! !*** ONE ROW NORTH OF SOUTHERN BOUNDARY ! IF(S_BDY)THEN DO I=MYIS2,MYIE2 U(I,K,2)=(U(I-1,K,1)+U(I,K,1)+U(I-1,K,3)+U(I,K,3))*0.25 V(I,K,2)=(V(I-1,K,1)+V(I,K,1)+V(I-1,K,3)+V(I,K,3))*0.25 ENDDO ENDIF ! !*** ONE ROW SOUTH OF NORTHERN BOUNDARY ! IF(N_BDY)THEN DO I=MYIS2,MYIE2 U(I,K,JJM-1)=(U(I-1,K,JJM-2)+U(I,K,JJM-2) & & +U(I-1,K,JJM)+U(I,K,JJM))*0.25 V(I,K,JJM-1)=(V(I-1,K,JJM-2)+V(I,K,JJM-2) & & +V(I-1,K,JJM)+V(I,K,JJM))*0.25 ENDDO ENDIF ! !*** ONE ROW EAST OF WESTERN BOUNDARY ! DO J=3,JM-2,2 IF(W_BDY)THEN IF(W_BDY.AND.J>=MY_JS_GLB-JBPAD1 & & .AND.J<=MY_JE_GLB+JTPAD1)THEN JJ=J U(1,K,JJ)=(U(1,K,JJ-1)+U(2,K,JJ-1) & & +U(1,K,JJ+1)+U(2,K,JJ+1))*0.25 V(1,K,JJ)=(V(1,K,JJ-1)+V(2,K,JJ-1) & & +V(1,K,JJ+1)+V(2,K,JJ+1))*0.25 ENDIF ENDIF ENDDO ! !*** ONE ROW WEST OF EASTERN BOUNDARY ! IF(E_BDY)THEN DO J=3,JM-2,2 IF(E_BDY.AND.J>=MY_JS_GLB-JBPAD1 & & .AND.J<=MY_JE_GLB+JTPAD1)THEN JJ=J U(IIM-1,K,JJ)=0.25*(U(IIM-1,K,JJ-1)+U(IIM,K,JJ-1) & & +U(IIM-1,K,JJ+1)+U(IIM,K,JJ+1)) V(IIM-1,K,JJ)=0.25*(V(IIM-1,K,JJ-1)+V(IIM,K,JJ-1) & & +V(IIM-1,K,JJ+1)+V(IIM,K,JJ+1)) ENDIF ENDDO ENDIF !----------------------------------------------------------------------- ! 300 CONTINUE ! !----------------------------------------------------------------------- END SUBROUTINE BOCOV !----------------------------------------------------------------------- !----------------------------------------------------------------------- END MODULE MODULE_BNDRY_COND !-----------------------------------------------------------------------