!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& SUBROUTINE BOCOV ! ****************************************************************** !$$$ 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 ! ! USAGE: CALL BOCOH FROM MAIN PROGRAM EBU ! INPUT ARGUMENT LIST: ! NONE ! ! OUTPUT ARGUMENT LIST: ! NONE ! ! OUTPUT FILES: ! NONE ! ! SUBPROGRAMS CALLED: ! ! UNIQUE: NONE ! ! LIBRARY: NONE ! ! COMMON BLOCKS: CTLBLK ! MASKS ! VRBLS ! BOCO ! ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! MACHINE : IBM SP !$$$ !*********************************************************************** PARAMETER & (D06666=.06666666) !----------------------------------------------------------------------- INCLUDE "parmeta.f90" INCLUDE "mpp.h" #include "sp.h" !----------------------------------------------------------------------- PARAMETER & (IMJM=IM*JM-JM/2,LB=2*IM+JM-3) !----------------------------------------------------------------------- LOGICAL & RUN,FIRST,RESTRT,SIGMA !----------------------------------------------------------------------- INCLUDE "COMM_CTLBLK.f90" !----------------------------------------------------------------------- INCLUDE "COMM_MASKS.f90" !----------------------------------------------------------------------- INCLUDE "COMM_VRBLS.f90" !---------------------------------------------------------------------- INCLUDE "COMM_BOCO.f90" !*********************************************************************** !------------- TIME INTERPOLATION OF U AND V AT THE OUTER BOUNDARY ----- IIM=IM-MY_IS_GLB+1 JJM=JM-MY_JS_GLB+1 !----------------------------------------------------------------------- DO 115 L=1,LM !----------------------------------------------------------------------- N=1 DO 111 I=1,IM-1 UB(N,L,1)=UB(N,L,1)+UB(N,L,2)*DT VB(N,L,1)=VB(N,L,1)+VB(N,L,2)*DT IF(MY_JS_GLB == 1 .AND. I >= MY_IS_GLB-ILPAD1 & .AND.I <= MY_IE_GLB+IRPAD1)THEN II=I-MY_IS_GLB+1 U(II,1,L)=UB(N,L,1) V(II,1,L)=VB(N,L,1) ENDIF N=N+1 CONTINUE 111 END DO ! DO 112 I=1,IM-1 UB(N,L,1)=UB(N,L,1)+UB(N,L,2)*DT VB(N,L,1)=VB(N,L,1)+VB(N,L,2)*DT IF(MY_JE_GLB == JM .AND. I >= MY_IS_GLB-ILPAD1 & .AND.I <= MY_IE_GLB+IRPAD1)THEN II=I-MY_IS_GLB+1 U(II,JJM,L)=UB(N,L,1) V(II,JJM,L)=VB(N,L,1) ENDIF N=N+1 CONTINUE 112 END DO ! DO 113 J=2,JM-1,2 UB(N,L,1)=UB(N,L,1)+UB(N,L,2)*DT VB(N,L,1)=VB(N,L,1)+VB(N,L,2)*DT IF(MY_IS_GLB == 1 .AND. J >= MY_JS_GLB-JBPAD1 & .AND.J <= MY_JE_GLB+JTPAD1)THEN JJ=J-MY_JS_GLB+1 U(1,JJ,L)=UB(N,L,1) V(1,JJ,L)=VB(N,L,1) ENDIF N=N+1 CONTINUE 113 END DO ! DO 114 J=2,JM-1,2 UB(N,L,1)=UB(N,L,1)+UB(N,L,2)*DT VB(N,L,1)=VB(N,L,1)+VB(N,L,2)*DT IF(MY_IE_GLB == IM .AND. J >= MY_JS_GLB-JBPAD1 & .AND.J <= MY_JE_GLB+JTPAD1)THEN JJ=J-MY_JS_GLB+1 U(IIM,JJ,L)=UB(N,L,1) V(IIM,JJ,L)=VB(N,L,1) ENDIF N=N+1 CONTINUE 114 END DO CONTINUE 115 END DO !----------------------------------------------------------------------- !--------------EXTRAPOLATION OF TANGENTIAL VELOCITY AT OUTFLOW POINTS--- !----------------------------------------------------------------------- DO 125 L=1,LM !----------------------------------------------------------------------- IF(IBROW == 1)THEN DO 121 I=MYIS1_P1,MYIE2_P1 IF(V(I,1,L) < 0.)U(I,1,L)=(VTM(I,5,L)+1.)*U(I,3,L) & -VTM(I,5,L) *U(I,5,L) CONTINUE 121 END DO ENDIF ! IF(ITROW == 1)THEN DO 122 I=MYIS1_P1,MYIE2_P1 IF(V(I,JJM,L) > 0.) & U(I,JJM,L)=(VTM(I,JJM-4,L)+1.)*U(I,JJM-2,L) & -VTM(I,JJM-4,L) *U(I,JJM-4,L) CONTINUE 122 END DO ENDIF ! DO 123 J=4,JM-3,2 IF(ILCOL == 1)THEN IF(MY_IS_GLB == 1 .AND. J >= MY_JS_GLB-JBPAD1 & .AND.J <= MY_JE_GLB+JTPAD1)THEN JJ=J-MY_JS_GLB+1 IF(U(1,JJ,L) < 0.) & V(1,JJ,L)=(VTM(3,JJ,L)+1.)*V(2,JJ,L) & -VTM(3,JJ,L) *V(3,JJ,L) ENDIF ENDIF CONTINUE 123 END DO ! DO 124 J=4,JM-3,2 IF(IRCOL == 1)THEN IF(MY_IE_GLB == IM .AND. J >= MY_JS_GLB-JBPAD1 & .AND.J <= MY_JE_GLB+JTPAD1)THEN JJ=J-MY_JS_GLB+1 IF(U(IIM,JJ,L) > 0.) & V(IIM,JJ,L)=(VTM(IIM-2,JJ,L)+1.)*V(IIM-1,JJ,L) & -VTM(IIM-2,JJ,L) *V(IIM-2,JJ,L) ENDIF ENDIF CONTINUE 124 END DO CONTINUE 125 END DO !----------------------------------------------------------------------- !------------- SPACE INTERPOLATION OF U AND V AT THE INNER BOUNDARY ---- !----------------------------------------------------------------------- DO 140 L=1,LM !----------------------------------------------------------------------- IF(IBROW == 1 .AND. ILCOL == 1)THEN U(2,2,L)=D06666*(4.*(U(1,1,L)+U(2,1,L)+U(2,3,L)) & + U(1,2,L)+U(1,4,L)+U(2,4,L)) V(2,2,L)=D06666*(4.*(V(1,1,L)+V(2,1,L)+V(2,3,L)) & +V(1,2,L)+V(1,4,L)+V(2,4,L)) ENDIF ! IF(IBROW == 1 .AND. IRCOL == 1)THEN U(IIM-1,2,L)=D06666*(4.*(U(IIM-2,1,L)+U(IIM-1,1,L) & +U(IIM-2,3,L)) & +U(IIM,2,L)+U(IIM,4,L)+U(IIM-1,4,L)) V(IIM-1,2,L)=D06666*(4.*(V(IIM-2,1,L)+V(IIM-1,1,L) & +V(IIM-2,3,L)) & +V(IIM,2,L)+V(IIM,4,L)+V(IIM-1,4,L)) ENDIF ! IF(ITROW == 1 .AND. ILCOL == 1)THEN U(2,JJM-1,L)=D06666*(4.*(U(1,JJM,L)+U(2,JJM,L)+U(2,JJM-2,L)) & +U(1,JJM-1,L)+U(1,JJM-3,L) & +U(2,JJM-3,L)) V(2,JJM-1,L)=D06666*(4.*(V(1,JJM,L)+V(2,JJM,L)+V(2,JJM-2,L)) & +V(1,JJM-1,L)+V(1,JJM-3,L) & +V(2,JJM-3,L)) ENDIF ! IF(ITROW == 1 .AND. IRCOL == 1)THEN U(IIM-1,JJM-1,L)= & D06666*(4.*(U(IIM-2,JJM,L)+U(IIM-1,JJM,L)+U(IIM-2,JJM-2,L)) & +U(IIM,JJM-1,L)+U(IIM,JJM-3,L)+U(IIM-1,JJM-3,L)) V(IIM-1,JJM-1,L)= & D06666*(4.*(V(IIM-2,JJM,L)+V(IIM-1,JJM,L)+V(IIM-2,JJM-2,L)) & +V(IIM,JJM-1,L)+V(IIM,JJM-3,L)+V(IIM-1,JJM-3,L)) ENDIF !----------------------------------------------------------------------- !--------------SPACE INTERPOLATION OF U AND V AT THE INNER BOUNDARY----- !----------------------------------------------------------------------- IF(IBROW == 1)THEN DO 131 I=MYIS2,MYIE2 U(I,2,L)=(U(I-1,1,L)+U(I,1,L)+U(I-1,3,L)+U(I,3,L))*0.25 V(I,2,L)=(V(I-1,1,L)+V(I,1,L)+V(I-1,3,L)+V(I,3,L))*0.25 CONTINUE 131 END DO ENDIF ! IF(ITROW == 1)THEN DO 132 I=MYIS2,MYIE2 U(I,JJM-1,L)=(U(I-1,JJM-2,L)+U(I,JJM-2,L) & +U(I-1,JJM,L)+U(I,JJM,L))*0.25 V(I,JJM-1,L)=(V(I-1,JJM-2,L)+V(I,JJM-2,L) & +V(I-1,JJM,L)+V(I,JJM,L))*0.25 CONTINUE 132 END DO ENDIF ! DO 133 J=3,JM-2,2 IF(ILCOL == 1)THEN IF(MY_IS_GLB == 1 .AND. J >= MY_JS_GLB-JBPAD1 & .AND.J <= MY_JE_GLB+JTPAD1)THEN JJ=J-MY_JS_GLB+1 U(1,JJ,L)=(U(1,JJ-1,L)+U(2,JJ-1,L) & +U(1,JJ+1,L)+U(2,JJ+1,L))*0.25 V(1,JJ,L)=(V(1,JJ-1,L)+V(2,JJ-1,L) & +V(1,JJ+1,L)+V(2,JJ+1,L))*0.25 ENDIF ENDIF CONTINUE 133 END DO ! IF(IRCOL == 1)THEN DO 134 J=3,JM-2,2 IF(MY_IE_GLB == IM .AND. J >= MY_JS_GLB-JBPAD1 & .AND.J <= MY_JE_GLB+JTPAD1)THEN JJ=J-MY_JS_GLB+1 U(IIM-1,JJ,L)=0.25*(U(IIM-1,JJ-1,L)+U(IIM,JJ-1,L) & +U(IIM-1,JJ+1,L)+U(IIM,JJ+1,L)) V(IIM-1,JJ,L)=0.25*(V(IIM-1,JJ-1,L)+V(IIM,JJ-1,L) & +V(IIM-1,JJ+1,L)+V(IIM,JJ+1,L)) ENDIF CONTINUE 134 END DO ENDIF !----------------------------------------------------------------------- CONTINUE 140 END DO !----------------------------------------------------------------------- RETURN END