C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_apply_uv.F,v 1.8 2012/09/18 20:09:17 jmc Exp $
C $Name: $
#include "OBCS_OPTIONS.h"
CBOP
C !ROUTINE: OBCS_APPLY_UV
C !INTERFACE:
SUBROUTINE OBCS_APPLY_UV( bi, bj, kArg,
U uFld, vFld,
I myThid )
C !DESCRIPTION:
C *==========================================================*
C | S/R OBCS_APPLY_UV
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 applies to
C or, if zero, apply to all levels
C uFld :: horizontal velocity field, 1rst component (zonal)
C vFld :: horizontal velocity field, 2nd component (meridional)
C myThid :: my Thread Id number
c INTEGER biArg, bjArg
INTEGER bi, bj
INTEGER kArg
_RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
_RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
INTEGER myThid
CEOP
#ifdef ALLOW_OBCS
C !LOCAL VARIABLES:
C == Local variables ==
c INTEGER bi, bj, itLo, itHi, jtLo, jtHi
INTEGER k, kLo, kHi
INTEGER i, j
INTEGER Iobc, Jobc
C-- Set model variables to OB values on North/South Boundaries:
C 2 steps: 1) set tangential component ; 2) set normal component.
C This ensures that the normal component is set correctly even
C when it conficts with tangential setting from an other OB.
c IF ( biArg.EQ.0 .OR. bjArg.EQ.0 ) THEN
c itLo = myBxLo(myThid)
c itHi = myBxHi(myThid)
c jtLo = myByLo(myThid)
c jtHi = myByHi(myThid)
c ELSE
c itLo = biArg
c itHi = biArg
c jtLo = bjArg
c jtHi = bjArg
c ENDIF
IF ( kArg.EQ.0 ) THEN
kLo = 1
kHi = Nr
ELSE
kLo = kArg
kHi = kArg
ENDIF
c DO bj = jtLo,jtHi
c DO bi = itLo,itHi
C-- Set Tangential component first:
#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 ) THEN
DO k = kLo,kHi
uFld(i,Jobc,k,bi,bj) = OBNu(i,k,bi,bj)
& *_maskW(i,Jobc,k,bi,bj)
ENDDO
ENDIF
ENDDO
ENDIF
#endif
#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 ) THEN
DO k = kLo,kHi
uFld(i,Jobc,k,bi,bj) = OBSu(i,k,bi,bj)
& *_maskW(i,Jobc,k,bi,bj)
ENDDO
ENDIF
ENDDO
ENDIF
#endif
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 ) THEN
DO k = kLo,kHi
vFld(Iobc,j,k,bi,bj) = OBEv(j,k,bi,bj)
& *_maskS(Iobc,j,k,bi,bj)
ENDDO
ENDIF
ENDDO
ENDIF
#endif
#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 ) THEN
DO k = kLo,kHi
vFld(Iobc,j,k,bi,bj) = OBWv(j,k,bi,bj)
& *_maskS(Iobc,j,k,bi,bj)
ENDDO
ENDIF
ENDDO
ENDIF
#endif
C-- Then set Normal component:
#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 ) THEN
DO k = kLo,kHi
vFld(i,Jobc,k,bi,bj) = OBNv(i,k,bi,bj)
& *_maskS(i,Jobc,k,bi,bj)
vFld(i,Jobc+1,k,bi,bj) = OBNv(i,k,bi,bj)
& *_maskS(i,Jobc,k,bi,bj)
& *OBCS_uvApplyFac
ENDDO
ENDIF
ENDDO
ENDIF
#endif
#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 ) THEN
DO k = kLo,kHi
vFld(i,Jobc+1,k,bi,bj) = OBSv(i,k,bi,bj)
& *_maskS(i,Jobc+1,k,bi,bj)
vFld(i,Jobc,k,bi,bj) = OBSv(i,k,bi,bj)
& *_maskS(i,Jobc+1,k,bi,bj)
& *OBCS_uvApplyFac
ENDDO
ENDIF
ENDDO
ENDIF
#endif
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 ) THEN
DO k = kLo,kHi
uFld(Iobc,j,k,bi,bj) = OBEu(j,k,bi,bj)
& *_maskW(Iobc,j,k,bi,bj)
uFld(Iobc+1,j,k,bi,bj) = OBEu(j,K,bi,bj)
& *_maskW(Iobc,j,k,bi,bj)
& *OBCS_uvApplyFac
ENDDO
ENDIF
ENDDO
ENDIF
#endif
#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 ) THEN
DO k = kLo,kHi
uFld(Iobc+1,j,k,bi,bj) = OBWu(j,k,bi,bj)
& *_maskW(Iobc+1,j,k,bi,bj)
uFld(Iobc,j,k,bi,bj) = OBWu(j,k,bi,bj)
& *_maskW(Iobc+1,j,k,bi,bj)
& *OBCS_uvApplyFac
ENDDO
ENDIF
ENDDO
ENDIF
#endif
c ENDDO
c ENDDO
#endif /* ALLOW_OBCS */
RETURN
END