obcs_apply_w.F

#include "OBCS_OPTIONS.h"

CBOP
C     !ROUTINE: OBCS_APPLY_W
C     !INTERFACE:
      SUBROUTINE OBCS_APPLY_W( bi, bj, kArg,
     U                         wFld,
     I                         myThid )

C     !DESCRIPTION:
C     *==========================================================*
C     | S/R OBCS_APPLY_W
C     |   Apply vertical velocity OB values
C     |   to corresponding field array
C     *==========================================================*

C     !USES:
      IMPLICIT NONE
C     == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "OBCS_PARAMS.h"
#include "OBCS_GRID.h"
#include "OBCS_FIELDS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine Arguments ==
C    bi, bj   :: indices of current tile
C    kArg     :: index of current level which OBC apply to
C                or if zero, apply to all levels
C    wFld     :: vertical velocity field
C    myThid   :: my Thread Id number
      INTEGER bi, bj
      INTEGER kArg
      _RL wFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
      INTEGER myThid
CEOP

#ifdef ALLOW_NONHYDROSTATIC
C     !LOCAL VARIABLES:
C     == Local variables ==
      INTEGER kLo, kHi
      INTEGER k, km1
      INTEGER i, j
      INTEGER Iobc, Jobc
      _RL obc_mask

      IF ( nonHydrostatic ) THEN

        IF ( kArg.EQ.0 ) THEN
          kLo = 1
          kHi = Nr
        ELSE
          k   = kArg
          km1 = MAX( k-1, 1 )
        ENDIF

C     Set model variables to OB values on North/South Boundaries
#ifdef ALLOW_OBCS_NORTH
        IF ( tileHasOBN(bi,bj) ) THEN
C Northern boundary
         DO i=1-OLx,sNx+OLx
          Jobc = OB_Jn(i,bi,bj)
          IF ( Jobc.NE.OB_indexNone .AND. kArg.EQ.0 ) THEN
           DO k = kLo,kHi
            km1 = MAX( k-1, 1 )
            obc_mask = maskC(i,Jobc,km1,bi,bj)*maskC(i,Jobc,k,bi,bj)
            wFld(i,Jobc,k,bi,bj) = OBNw(i,k,bi,bj)*obc_mask
           ENDDO
          ELSEIF ( Jobc.NE.OB_indexNone ) THEN
            obc_mask = maskC(i,Jobc,km1,bi,bj)*maskC(i,Jobc,k,bi,bj)
            wFld(i,Jobc,k,bi,bj) = OBNw(i,k,bi,bj)*obc_mask
          ENDIF
         ENDDO
        ENDIF
#endif /* ALLOW_OBCS_NORTH */

#ifdef ALLOW_OBCS_SOUTH
        IF ( tileHasOBS(bi,bj) ) THEN
C Southern boundary
         DO i=1-OLx,sNx+OLx
          Jobc = OB_Js(i,bi,bj)
          IF ( Jobc.NE.OB_indexNone .AND. kArg.EQ.0 ) THEN
           DO k = kLo,kHi
            km1 = MAX( k-1, 1 )
            obc_mask = maskC(i,Jobc,km1,bi,bj)*maskC(i,Jobc,k,bi,bj)
            wFld(i,Jobc,k,bi,bj) = OBSw(i,k,bi,bj)*obc_mask
           ENDDO
          ELSEIF ( Jobc.NE.OB_indexNone ) THEN
            obc_mask = maskC(i,Jobc,km1,bi,bj)*maskC(i,Jobc,k,bi,bj)
            wFld(i,Jobc,k,bi,bj) = OBSw(i,k,bi,bj)*obc_mask
          ENDIF
         ENDDO
        ENDIF
#endif /* ALLOW_OBCS_SOUTH */

C     Set model variables to OB values on East/West Boundaries
#ifdef ALLOW_OBCS_EAST
        IF ( tileHasOBE(bi,bj) ) THEN
C Eastern boundary
         DO j=1-OLy,sNy+OLy
          Iobc = OB_Ie(j,bi,bj)
          IF ( Iobc.NE.OB_indexNone .AND. kArg.EQ.0 ) THEN
           DO k = kLo,kHi
            km1 = MAX( k-1, 1 )
            obc_mask = maskC(Iobc,j,km1,bi,bj)*maskC(Iobc,j,k,bi,bj)
            wFld(Iobc,j,k,bi,bj) = OBEw(j,k,bi,bj)*obc_mask
           ENDDO
          ELSEIF ( Iobc.NE.OB_indexNone ) THEN
            obc_mask = maskC(Iobc,j,km1,bi,bj)*maskC(Iobc,j,k,bi,bj)
            wFld(Iobc,j,k,bi,bj) = OBEw(j,k,bi,bj)*obc_mask
          ENDIF
         ENDDO
        ENDIF
#endif /* ALLOW_OBCS_EAST */

#ifdef ALLOW_OBCS_WEST
        IF ( tileHasOBW(bi,bj) ) THEN
C Western boundary
         DO j=1-OLy,sNy+OLy
          Iobc = OB_Iw(j,bi,bj)
          IF ( Iobc.NE.OB_indexNone .AND. kArg.EQ.0 ) THEN
           DO k = kLo,kHi
            km1 = MAX( k-1, 1 )
            obc_mask = maskC(Iobc,j,km1,bi,bj)*maskC(Iobc,j,k,bi,bj)
            wFld(Iobc,j,k,bi,bj) = OBWw(j,k,bi,bj)*obc_mask
           ENDDO
          ELSEIF ( Iobc.NE.OB_indexNone ) THEN
            obc_mask = maskC(Iobc,j,km1,bi,bj)*maskC(Iobc,j,k,bi,bj)
            wFld(Iobc,j,k,bi,bj) = OBWw(j,k,bi,bj)*obc_mask
          ENDIF
         ENDDO
        ENDIF
#endif /* ALLOW_OBCS_WEST */

      ENDIF
#endif /* ALLOW_NONHYDROSTATIC */

      RETURN
      END