SUBROUTINE bocoh 
  !
  ! $Author: CPTEC $
  ! $Date: 2000/02/24 13:15:43 $
  ! $Revision: 1.0 $
  !                .      .    .     
  ! subprogram:    bocoh       update mass points on boundary
  !   prgrmmr: janjic          org: w/nmc2     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
  !     
  ! 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
  !                  pvrbl2
  !                  boco
  !   
  IMPLICIT NONE

  !*** problem size

  INCLUDE "parmeta.f90"
  INTEGER, PARAMETER :: lb=2*im+jm-3

  !*** global variables

  INCLUDE "ctlblk.f90" ! dt(in); nbc(in); nboco(in); ntsd(in)
  INCLUDE "masks.f90"  ! htm(in)
  INCLUDE "vrbls.f90"  ! pd(inout); q(inout); t(inout)
  INCLUDE "cldwtr.f90" ! cwm(inout)
  INCLUDE "boco.f90"   ! pdb(inout); qb(inout); tb(inout); ub(out); vb(out)

  !*** local variables

  REAL, PARAMETER :: h1=1.e0
  REAL            :: cwml,shtm,rhtm
  REAL, DIMENSION(lb,lm,2) :: wb
  INTEGER         :: i, j, l, n

  !*** read fresh boundary data if necessary

  IF(MOD(ntsd-1,nboco).EQ.0)THEN
     READ(nbc)pdb
     READ(nbc)tb
     READ(nbc)qb
     READ(nbc)ub
     READ(nbc)vb
  ENDIF

  !*** set the values of cloud water in bdry to zero

  DO j=1,2                                  
     DO l=1,lm                                 
        DO i=1,lb                                 
           wb(i,l,j)=0.                                                     
        END DO
     END DO
  END DO

  !***  update the surface pressure

  n=1
  DO i=1,im
     pdb(n,1)=pdb(n,1)+pdb(n,2)*dt
     pd(i,1)=pdb(n,1)
     n=n+1
  END DO
  DO i=1,im
     pdb(n,1)=pdb(n,1)+pdb(n,2)*dt
     pd(i,jm)=pdb(n,1)
     n=n+1
  END DO
  DO j=3,jm-2,2
     pdb(n,1)=pdb(n,1)+pdb(n,2)*dt
     pd(1,j)=pdb(n,1)
     n=n+1
  END DO
  DO j=3,jm-2,2
     pdb(n,1)=pdb(n,1)+pdb(n,2)*dt
     pd(im,j)=pdb(n,1)
     n=n+1
  END DO

  !***  update the 3-d mass variables

  DO l=1,lm

     n=1
     DO i=1,im
        tb(n,l,1)=tb(n,l,1)+tb(n,l,2)*dt
        qb(n,l,1)=qb(n,l,1)+qb(n,l,2)*dt
        wb(n,l,1)=wb(n,l,1)+wb(n,l,2)*dt                        
        t(i,1,l)=tb(n,l,1)
        q(i,1,l)=qb(n,l,1)
        cwm(i,1,l)=wb(n,l,1)                                                 
        n=n+1
     END DO
     DO i=1,im
        tb(n,l,1)=tb(n,l,1)+tb(n,l,2)*dt
        qb(n,l,1)=qb(n,l,1)+qb(n,l,2)*dt
        wb(n,l,1)=wb(n,l,1)+wb(n,l,2)*dt                       
        t(i,jm,l)=tb(n,l,1)
        q(i,jm,l)=qb(n,l,1)
        cwm(i,jm,l)=wb(n,l,1)                                                 
        n=n+1
     END DO
     DO j=3,jm-2,2
        tb(n,l,1)=tb(n,l,1)+tb(n,l,2)*dt
        qb(n,l,1)=qb(n,l,1)+qb(n,l,2)*dt
        wb(n,l,1)=wb(n,l,1)+wb(n,l,2)*dt                       
        t(1,j,l)=tb(n,l,1)
        q(1,j,l)=qb(n,l,1)
        cwm(1,j,l)=wb(n,l,1)                                                 
        n=n+1
     END DO
     DO j=3,jm-2,2
        tb(n,l,1)=tb(n,l,1)+tb(n,l,2)*dt
        qb(n,l,1)=qb(n,l,1)+qb(n,l,2)*dt
        wb(n,l,1)=wb(n,l,1)+wb(n,l,2)*dt                       
        t(im,j,l)=tb(n,l,1)
        q(im,j,l)=qb(n,l,1)
        cwm(im,j,l)=wb(n,l,1)                                                 
        n=n+1
     END DO
  END DO

  !*** space interpolation of pd and t at the inner boundary

  DO i=1,im-1
     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
  END DO
  DO i=1,im-1
     shtm=htm(i,jm-2,lm)+htm(i+1,jm-2,lm)+htm(i,jm,lm)+htm(i+1,jm,lm)
     pd(i,jm-1)=(pd(i,jm-2)*htm(i,jm-2,lm) &
          +pd(i+1,jm-2)*htm(i+1,jm-2,lm) &
          +pd(i,jm)*htm(i,jm,lm)+pd(i+1,jm)*htm(i+1,jm,lm))/shtm
  END DO
  DO j=4,jm-3,2
     shtm=htm(1,j-1,lm)+htm(2,j-1,lm)+htm(1,j+1,lm)+htm(2,j+1,lm)
     pd(1,j)=(pd(1,j-1)*htm(1,j-1,lm)+pd(2,j-1)*htm(2,j-1,lm) &
          +pd(1,j+1)*htm(1,j+1,lm)+pd(2,j+1)*htm(2,j+1,lm))/shtm
  END DO
  DO j=4,jm-3,2
     shtm=htm(im-1,j-1,lm)+htm(im,j-1,lm) &
          +htm(im-1,j+1,lm)+htm(im,j+1,lm)
     pd(im-1,j)=(pd(im-1,j-1)*htm(im-1,j-1,lm) &
          +pd(im,j-1)*htm(im,j-1,lm) &
          +pd(im-1,j+1)*htm(im-1,j+1,lm) &
          +pd(im,j+1)*htm(im,j+1,lm))/shtm
  END DO

  DO l=1,lm
     DO i=1,im-1
        rhtm=h1/(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
        q(i,2,l)=(q(i,1,l)*htm(i,1,l)+q(i+1,1,l)*htm(i+1,1,l) &
             +q(i,3,l)*htm(i,3,l)+q(i+1,3,l)*htm(i+1,3,l))*rhtm
        cwm(i,2,l)=(cwm(i,1,l)*htm(i,1,l)+cwm(i+1,1,l)*htm(i+1,1,l) &
             +cwm(i,3,l)*htm(i,3,l)+cwm(i+1,3,l)*htm(i+1,3,l))*rhtm
     END DO
     DO  i=1,im-1
        rhtm=h1/(htm(i,jm-2,l)+htm(i+1,jm-2,l)+htm(i,jm,l)+htm(i+1,jm,l))
        t(i,jm-1,l)=(t(i,jm-2,l)*htm(i,jm-2,l) &
             +t(i+1,jm-2,l)*htm(i+1,jm-2,l) &
             +t(i,jm,l)*htm(i,jm,l)+t(i+1,jm,l)*htm(i+1,jm,l)) &
             *rhtm
        q(i,jm-1,l)=(q(i,jm-2,l)*htm(i,jm-2,l) &
             +q(i+1,jm-2,l)*htm(i+1,jm-2,l) &
             +q(i,jm,l)*htm(i,jm,l)+q(i+1,jm,l)*htm(i+1,jm,l)) &
             *rhtm
        cwm(i,jm-1,l)=(cwm(i,jm-2,l)*htm(i,jm-2,l) &
             +cwm(i+1,jm-2,l)*htm(i+1,jm-2,l) &
             +cwm(i,jm,l)*htm(i,jm,l)+cwm(i+1,jm,l)*htm(i+1,jm,l)) &
             *rhtm
     END DO
     DO j=4,jm-3,2
        rhtm=h1/(htm(1,j-1,l)+htm(2,j-1,l)+htm(1,j+1,l)+htm(2,j+1,l))
        t(1,j,l)=(t(1,j-1,l)*htm(1,j-1,l)+t(2,j-1,l)*htm(2,j-1,l) &
             +t(1,j+1,l)*htm(1,j+1,l)+t(2,j+1,l)*htm(2,j+1,l))*rhtm
        q(1,j,l)=(q(1,j-1,l)*htm(1,j-1,l)+q(2,j-1,l)*htm(2,j-1,l) &
             +q(1,j+1,l)*htm(1,j+1,l)+q(2,j+1,l)*htm(2,j+1,l))*rhtm 
        cwm(1,j,l)=(cwm(1,j-1,l)*htm(1,j-1,l)+cwm(2,j-1,l)*htm(2,j-1,l) &
             +cwm(1,j+1,l)*htm(1,j+1,l)+cwm(2,j+1,l)*htm(2,j+1,l)) &
             *rhtm
     END DO
     DO j=4,jm-3,2
        rhtm=h1/(htm(im-1,j-1,l)+htm(im,j-1,l) &
             +htm(im-1,j+1,l)+htm(im,j+1,l))
        t(im-1,j,l)=(t(im-1,j-1,l)*htm(im-1,j-1,l) &
             +t(im,j-1,l)*htm(im,j-1,l) &
             +t(im-1,j+1,l)*htm(im-1,j+1,l) &
             +t(im,j+1,l)*htm(im,j+1,l))*rhtm
        q(im-1,j,l)=(q(im-1,j-1,l)*htm(im-1,j-1,l) &
             +q(im,j-1,l)*htm(im,j-1,l) &
             +q(im-1,j+1,l)*htm(im-1,j+1,l) &
             +q(im,j+1,l)*htm(im,j+1,l))*rhtm
        cwm(im-1,j,l)=(cwm(im-1,j-1,l)*htm(im-1,j-1,l) &
             +cwm(im,j-1,l)*htm(im,j-1,l) &
             +cwm(im-1,j+1,l)*htm(im-1,j+1,l) &
             +cwm(im,j+1,l)*htm(im,j+1,l))*rhtm
     END DO
  END DO
END SUBROUTINE bocoh
