C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_apply_w.F,v 1.10 2012/11/15 15:55:42 dimitri Exp $
C $Name: $
#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