C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_apply_uvice.F,v 1.17 2012/09/18 20:09:17 jmc Exp $ C $Name: $ #include "OBCS_OPTIONS.h" #ifdef ALLOW_SEAICE #include "SEAICE_OPTIONS.h" #endif CBOP C !ROUTINE: OBCS_APPLY_UVICE C !INTERFACE: SUBROUTINE OBCS_APPLY_UVICE( U uFld, vFld, I myThid ) C !DESCRIPTION: C *==========================================================* C | S/R OBCS_APPLY_UVICE C | Apply OB values to corresponding field array C *==========================================================* C !USES: IMPLICIT NONE C == Global variables == #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" c#include "GRID.h" #include "OBCS_PARAMS.h" #include "OBCS_GRID.h" #include "OBCS_SEAICE.h" #ifdef ALLOW_SEAICE # include "SEAICE_SIZE.h" # include "SEAICE.h" #endif C !INPUT/OUTPUT PARAMETERS: C == Routine Arguments == C uFld :: horizontal velocity field, 1rst component (zonal) C vFld :: horizontal velocity field, 2nd component (meridional) C myThid :: my Thread Id number _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) INTEGER myThid #ifdef ALLOW_SEAICE #ifdef SEAICE_CGRID #ifndef OBCS_UVICE_OLD C !LOCAL VARIABLES: C bi, bj :: indices of current tile C i, j :: Loop counters INTEGER bi, bj INTEGER i, j INTEGER Iobc, Jobc _RL uvIceApplyFac CEOP 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. uvIceApplyFac = OBCS_uvApplyFac c IF ( OBCS_monitorFreq.EQ.1. ) uvIceApplyFac = -1. c IF ( OBCS_monitorFreq.EQ.deltaTmom*0.5 ) uvIceApplyFac = 0. c IF ( OBCS_monitorFreq.EQ.deltaTmom ) uvIceApplyFac = 1. c WRITE(standardMessageUnit,*) c 'OBCS_APPLY_UVICE: uvIceApplyFac=', uvIceApplyFac DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) C-- Set Tangential component first: 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 ) THEN uFld(i,Jobc,bi,bj) = OBNuice(i,bi,bj) & *seaiceMaskU(i,Jobc,bi,bj) 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 ) THEN uFld(i,Jobc,bi,bj) = OBSuice(i,bi,bj) & *seaiceMaskU(i,Jobc,bi,bj) 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 ) THEN vFld(Iobc,j,bi,bj) = OBEvice(j,bi,bj) & *seaiceMaskV(Iobc,j,bi,bj) 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 ) THEN vFld(Iobc,j,bi,bj) = OBWvice(j,bi,bj) & *seaiceMaskV(Iobc,j,bi,bj) ENDIF ENDDO ENDIF # endif /* ALLOW_OBCS_WEST */ C-- Then set Normal component: 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 ) THEN vFld(i,Jobc,bi,bj) = OBNvice(i,bi,bj) & *seaiceMaskV(i,Jobc,bi,bj) IF ( uvIceApplyFac.GE.0. ) & vFld(i,Jobc+1,bi,bj) = OBNvice(i,bi,bj) & *seaiceMaskV(i,Jobc,bi,bj) & *uvIceApplyFac 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 ) THEN vFld(i,Jobc+1,bi,bj) = OBSvice(i,bi,bj) & *seaiceMaskV(i,Jobc+1,bi,bj) IF ( uvIceApplyFac.GE.0. ) & vFld(i,Jobc,bi,bj) = OBSvice(i,bi,bj) & *seaiceMaskV(i,Jobc+1,bi,bj) & *uvIceApplyFac 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 ) THEN uFld(Iobc,j,bi,bj) = OBEuice(j,bi,bj) & *seaiceMaskU(Iobc,j,bi,bj) IF ( uvIceApplyFac.GE.0. ) & uFld(Iobc+1,j,bi,bj) = OBEuice(j,bi,bj) & *seaiceMaskU(Iobc,j,bi,bj) & *uvIceApplyFac 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 ) THEN uFld(Iobc+1,j,bi,bj) = OBWuice(j,bi,bj) & *seaiceMaskU(Iobc+1,j,bi,bj) IF ( uvIceApplyFac.GE.0. ) & uFld(Iobc,j,bi,bj) = OBWuice(j,bi,bj) & *seaiceMaskU(Iobc+1,j,bi,bj) & *uvIceApplyFac ENDIF ENDDO ENDIF # endif /* ALLOW_OBCS_WEST */ ENDDO ENDDO CALL EXCH_UV_XY_RL( uFld, vFld,.TRUE.,myThid) #endif /* ndef OBCS_UVICE_OLD */ #endif /* SEAICE_CGRID */ #endif /* ALLOW_SEAICE */ RETURN END