!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
    SUBROUTINE BOCOHF
!     ******************************************************************
!$$$  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

! 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
!                  PVRBLS
!                  CLDWTR
!                  BOCO
!                  MAPOT
!                  DYNAM
!                  NHYDRO

! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM SP
!$$$
!     ******************************************************************
!-----------------------------------------------------------------------
    INCLUDE "parmeta.f90"
    INCLUDE "mpif.h"
    INCLUDE "mpp.h"
#include "sp.h"
!-----------------------------------------------------------------------
    PARAMETER &
    (IMJM=IM*JM-JM/2,LB=2*IM+JM-3,LP1=LM+1)
    PARAMETER &
    (ISIZ1=2*LB,ISIZ2=2*LB*LM)
!-----------------------------------------------------------------------
    LOGICAL :: &
    RUN,FIRST,RESTRT,SIGMA,NEST
!-----------------------------------------------------------------------
    INCLUDE "COMM_CTLBLK.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_MASKS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_VRBLS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_PVRBLS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_CLDWTR.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_BOCO.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_MAPOT.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_NHYDRO.f90"
!-----------------------------------------------------------------------
!***********************************************************************
!--------------READ FRESH BOUNDARY DATA IF NECESSARY--------------------
    IF(NTSD-1 == NBOCO)THEN
        IF(MYPE == 0 .AND. NEST)THEN
            NREC=NINT((NTSD-1)*ABS(DT)/3600.)+2
            READ(NBC,REC=NREC)BCHR &
            ,                   ((PDB(K,N),K=1,LB),N=1,2) &
            ,                   (((TB(K,L,N),K=1,LB),L=1,LM),N=1,2) &
            ,                   (((QB(K,L,N),K=1,LB),L=1,LM),N=1,2) &
            ,                   (((UB(K,L,N),K=1,LB),L=1,LM),N=1,2) &
            ,                   (((VB(K,L,N),K=1,LB),L=1,LM),N=1,2) &
            ,                  (((Q2B(K,L,N),K=1,LB),L=1,LM),N=1,2) &
            ,                 (((CWMB(K,L,N),K=1,LB),L=1,LM),N=1,2)
        ENDIF
        IF(MYPE == 0 .AND. .NOT. NEST)THEN
            READ(NBC)PDB
            READ(NBC)TB
            READ(NBC)QB
            READ(NBC)UB
            READ(NBC)VB
            READ(NBC)Q2B
            READ(NBC)CWMB
        ENDIF
    
        CALL MPI_BCAST(PDB,ISIZ1,MPI_REAL,0,MPI_COMM_COMP,IRTN)
        CALL MPI_BCAST(TB,ISIZ2,MPI_REAL,0,MPI_COMM_COMP,IRTN)
    ! c     CALL MPI_BCAST(QB,ISIZ2,MPI_REAL,0,MPI_COMM_COMP,IRTN)
        CALL MPI_BCAST(UB,ISIZ2,MPI_REAL,0,MPI_COMM_COMP,IRTN)
        CALL MPI_BCAST(VB,ISIZ2,MPI_REAL,0,MPI_COMM_COMP,IRTN)
        CALL MPI_BCAST(Q2B,ISIZ2,MPI_REAL,0,MPI_COMM_COMP,IRTN)
    ! c     CALL MPI_BCAST(CWMB,ISIZ2,MPI_REAL,0,MPI_COMM_COMP,IRTN)
    !***
    !***    FIND NEXT BOUNDARY CONDITION READ
    !***
        IF(NTSD < NTSTM)THEN
            IF(MYPE == 0 .AND. NEST)BCHR=BCHR+1    ! This assumes 1-hrly BCs
            IF(MYPE == 0 .AND. .NOT. NEST)READ(NBC)BCHR
            CALL MPI_BCAST(BCHR,1,MPI_REAL,0,MPI_COMM_COMP,IRTN)
            NBOCO=INT(BCHR*TSPH+0.5)
        ENDIF
    
    ENDIF
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
    IIM=IM-MY_IS_GLB+1
    JJM=JM-MY_JS_GLB+1
!--------------------------------------------------------------
!***
!***  UPDATE THE SURFACE PRESSURE
!***
!--------------------------------------------------------------
    N=1
    DO 101 I=1,IM
        PDB(N,1)=PDB(N,1)+PDB(N,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
            PD(II,1)=PDB(N,1)
        ENDIF
        N=N+1
    101 END DO

    DO 102 I=1,IM
        PDB(N,1)=PDB(N,1)+PDB(N,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
            PD(II,JJM)=PDB(N,1)
        ENDIF
        N=N+1
    102 END DO

    DO 103 J=3,JM-2,2
        PDB(N,1)=PDB(N,1)+PDB(N,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
            PD(1,JJ)=PDB(N,1)
        ENDIF
        N=N+1
    103 END DO

    DO 104 J=3,JM-2,2
        PDB(N,1)=PDB(N,1)+PDB(N,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
            PD(IIM,JJ)=PDB(N,1)
        ENDIF
        N=N+1
    104 END DO
!--------------------------------------------------------------
!***
!***  UPDATE THE 3-D MASS VARIABLES
!***
!--------------------------------------------------------------
    DO 115 L=1,LM
    !--------------------------------------------------------------
        N=1
        DO 111 I=1,IM
            TB(N,L,1)=TB(N,L,1)+TB(N,L,2)*DT
            Q2B(N,L,1)=Q2B(N,L,1)+Q2B(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
                T(II,1,L)=TB(N,L,1)
                Q2(II,1,L)=Q2B(N,L,1)
                PINT(II,1,L+1)=PD(II,1)*ETA(L+1)+PT
            ENDIF
            N=N+1
        111 END DO
    
        DO 112 I=1,IM
            TB(N,L,1)=TB(N,L,1)+TB(N,L,2)*DT
            Q2B(N,L,1)=Q2B(N,L,1)+Q2B(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
                T(II,JJM,L)=TB(N,L,1)
                Q2(II,JJM,L)=Q2B(N,L,1)
                PINT(II,JJM,L+1)=PD(II,JJM)*ETA(L+1)+PT
            ENDIF
            N=N+1
        112 END DO
    
        DO 113 J=3,JM-2,2
            TB(N,L,1)=TB(N,L,1)+TB(N,L,2)*DT
            Q2B(N,L,1)=Q2B(N,L,1)+Q2B(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
                T(1,JJ,L)=TB(N,L,1)
                Q2(1,JJ,L)=Q2B(N,L,1)
                PINT(1,JJ,L+1)=PD(1,JJ)*ETA(L+1)+PT
            ENDIF
            N=N+1
        113 END DO
    
        DO 114 J=3,JM-2,2
            TB(N,L,1)=TB(N,L,1)+TB(N,L,2)*DT
            Q2B(N,L,1)=Q2B(N,L,1)+Q2B(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
                T(IIM,JJ,L)=TB(N,L,1)
                Q2(IIM,JJ,L)=Q2B(N,L,1)
                PINT(IIM,JJ,L+1)=PD(IIM,JJ)*ETA(L+1)+PT
            ENDIF
            N=N+1
        114 END DO
    
    115 END DO
!--------------------------------------------------------------------

!------- SPACE INTERPOLATION OF PD AND T AT THE INNER BOUNDARY ------

!--------------------------------------------------------------------
    IF(IBROW == 1)THEN
        DO 121 I=MYIS,MYIE1
            SHTM=HTM(I,1,LM)+HTM(I+1,1,LM)+HTM(I,3,LM)+HTM(I+1,3,LM)
            PD(I,2)=(PD(I,1)*HTM(I,1,LM)+PD(I+1,1)*HTM(I+1,1,LM) &
            +PD(I,3)*HTM(I,3,LM)+PD(I+1,3)*HTM(I+1,3,LM))/SHTM
        121 END DO
    ENDIF

    IF(ITROW == 1)THEN
        DO 122 I=MYIS,MYIE1
            SHTM=HTM(I,JJM-2,LM)+HTM(I+1,JJM-2,LM)+HTM(I,JJM,LM) &
            +HTM(I+1,JJM,LM)
            PD(I,JJM-1)=(PD(I,JJM-2)*HTM(I,JJM-2,LM) &
            +PD(I+1,JJM-2)*HTM(I+1,JJM-2,LM) &
            +PD(I,JJM)*HTM(I,JJM,LM) &
            +PD(I+1,JJM)*HTM(I+1,JJM,LM))/SHTM
        122 END DO
    ENDIF

    IF(ILCOL == 1)THEN
        DO 123 J=4,JM-3,2
            IF(MY_IS_GLB == 1 .AND. J >= MY_JS_GLB-JBPAD1  &
            .AND.J <= MY_JE_GLB+JTPAD1)THEN
                JJ=J-MY_JS_GLB+1
                SHTM=HTM(1,JJ-1,LM)+HTM(2,JJ-1,LM)+HTM(1,JJ+1,LM) &
                +HTM(2,JJ+1,LM)
                PD(1,JJ)=(PD(1,JJ-1)*HTM(1,JJ-1,LM) &
                +PD(2,JJ-1)*HTM(2,JJ-1,LM) &
                +PD(1,JJ+1)*HTM(1,JJ+1,LM) &
                +PD(2,JJ+1)*HTM(2,JJ+1,LM))/SHTM
            ENDIF
        123 END DO
    ENDIF

    IF(IRCOL == 1)THEN
        DO 124 J=4,JM-3,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
                SHTM=HTM(IIM-1,JJ-1,LM)+HTM(IIM,JJ-1,LM) &
                +HTM(IIM-1,JJ+1,LM)+HTM(IIM,JJ+1,LM)
                PD(IIM-1,JJ)=(PD(IIM-1,JJ-1)*HTM(IIM-1,JJ-1,LM) &
                +PD(IIM,JJ-1)*HTM(IIM,JJ-1,LM) &
                +PD(IIM-1,JJ+1)*HTM(IIM-1,JJ+1,LM) &
                +PD(IIM,JJ+1)*HTM(IIM,JJ+1,LM))/SHTM
            ENDIF
        124 END DO
    ENDIF


!--------------------------------------------------------------------
    DO 135 L=1,LM
    !--------------------------------------------------------------------
        IF(IBROW == 1)THEN
            DO 131 I=MYIS,MYIE1
                RHTM=1./(HTM(I,1,L)+HTM(I+1,1,L)+HTM(I,3,L)+HTM(I+1,3,L))
                T(I,2,L)=(T(I,1,L)*HTM(I,1,L)+T(I+1,1,L)*HTM(I+1,1,L) &
                +T(I,3,L)*HTM(I,3,L)+T(I+1,3,L)*HTM(I+1,3,L))*RHTM
                Q2(I,2,L)=(Q2(I,1,L)*HTM(I,1,L)+Q2(I+1,1,L)*HTM(I+1,1,L) &
                +Q2(I,3,L)*HTM(I,3,L)+Q2(I+1,3,L)*HTM(I+1,3,L))*RHTM
                PINT(I,2,L+1)=(PINT(I,1,L+1)*HTM(I,1,L) &
                +PINT(I+1,1,L+1)*HTM(I+1,1,L) &
                +PINT(I,3,L+1)*HTM(I,3,L) &
                +PINT(I+1,3,L+1)*HTM(I+1,3,L))*RHTM
            131 END DO
        ENDIF
    
        IF(ITROW == 1)THEN
            DO 132 I=MYIS,MYIE1
                RHTM=1./(HTM(I,JJM-2,L)+HTM(I+1,JJM-2,L) &
                +HTM(I,JJM,L)+HTM(I+1,JJM,L))
                T(I,JJM-1,L)=(T(I,JJM-2,L)*HTM(I,JJM-2,L) &
                +T(I+1,JJM-2,L)*HTM(I+1,JJM-2,L) &
                +T(I,JJM,L)*HTM(I,JJM,L) &
                +T(I+1,JJM,L)*HTM(I+1,JJM,L))*RHTM
                Q2(I,JJM-1,L)=(Q2(I,JJM-2,L)*HTM(I,JJM-2,L) &
                +Q2(I+1,JJM-2,L)*HTM(I+1,JJM-2,L) &
                +Q2(I,JJM,L)*HTM(I,JJM,L) &
                +Q2(I+1,JJM,L)*HTM(I+1,JJM,L))*RHTM
                PINT(I,JJM-1,L+1)=(PINT(I,JJM-2,L+1)*HTM(I,JJM-2,L) &
                +PINT(I+1,JJM-2,L+1)*HTM(I+1,JJM-2,L) &
                +PINT(I,JJM,L+1)*HTM(I,JJM,L) &
                +PINT(I+1,JJM,L+1)*HTM(I+1,JJM,L))*RHTM
            132 END DO
        ENDIF
    
        IF(ILCOL == 1)THEN
            DO 133 J=4,JM-3,2
                IF(MY_IS_GLB == 1 .AND. J >= MY_JS_GLB-JBPAD1  &
                .AND.J <= MY_JE_GLB+JTPAD1)THEN
                    JJ=J-MY_JS_GLB+1
                    RHTM=1./(HTM(1,JJ-1,L)+HTM(2,JJ-1,L) &
                    +HTM(1,JJ+1,L)+HTM(2,JJ+1,L))
                    T(1,JJ,L)=(T(1,JJ-1,L)*HTM(1,JJ-1,L) &
                    +T(2,JJ-1,L)*HTM(2,JJ-1,L) &
                    +T(1,JJ+1,L)*HTM(1,JJ+1,L) &
                    +T(2,JJ+1,L)*HTM(2,JJ+1,L))*RHTM
                    Q2(1,JJ,L)=(Q2(1,JJ-1,L)*HTM(1,JJ-1,L) &
                    +Q2(2,JJ-1,L)*HTM(2,JJ-1,L) &
                    +Q2(1,JJ+1,L)*HTM(1,JJ+1,L) &
                    +Q2(2,JJ+1,L)*HTM(2,JJ+1,L))*RHTM
                    PINT(1,JJ,L+1)=(PINT(1,JJ-1,L+1)*HTM(1,JJ-1,L) &
                    +PINT(2,JJ-1,L+1)*HTM(2,JJ-1,L) &
                    +PINT(1,JJ+1,L+1)*HTM(1,JJ+1,L) &
                    +PINT(2,JJ+1,L+1)*HTM(2,JJ+1,L))*RHTM
                ENDIF
            133 END DO
        ENDIF
    
        IF(IRCOL == 1)THEN
            DO 134 J=4,JM-3,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
                    RHTM=1./(HTM(IIM-1,JJ-1,L)+HTM(IIM,JJ-1,L) &
                    +HTM(IIM-1,JJ+1,L)+HTM(IIM,JJ+1,L))
                    T(IIM-1,JJ,L)=(T(IIM-1,JJ-1,L)*HTM(IIM-1,JJ-1,L) &
                    +T(IIM,JJ-1,L)*HTM(IIM,JJ-1,L) &
                    +T(IIM-1,JJ+1,L)*HTM(IIM-1,JJ+1,L) &
                    +T(IIM,JJ+1,L)*HTM(IIM,JJ+1,L))*RHTM
                    Q2(IIM-1,JJ,L)=(Q2(IIM-1,JJ-1,L)*HTM(IIM-1,JJ-1,L) &
                    +Q2(IIM,JJ-1,L)*HTM(IIM,JJ-1,L) &
                    +Q2(IIM-1,JJ+1,L)*HTM(IIM-1,JJ+1,L) &
                    +Q2(IIM,JJ+1,L)*HTM(IIM,JJ+1,L))*RHTM
                    PINT(IIM-1,JJ,L+1)=(PINT(IIM-1,JJ-1,L+1)*HTM(IIM-1,JJ-1,L) &
                    +PINT(IIM,JJ-1,L+1)*HTM(IIM,JJ-1,L) &
                    +PINT(IIM-1,JJ+1,L+1)*HTM(IIM-1,JJ+1,L) &
                    +PINT(IIM,JJ+1,L+1)*HTM(IIM,JJ+1,L))*RHTM
                ENDIF
            134 END DO
        ENDIF
    135 END DO
!--------------------------------------------------------------------
!--------------------------------------------------------------------
    RETURN
    END SUBROUTINE BOCOHF
