C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_sponge.F,v 1.14 2014/09/27 00:13:40 dimitri Exp $
C $Name:  $

#include "OBCS_OPTIONS.h"

C--   File obcs_sponge.F:
C--    Contents:
C--    o OBCS_SPONGE_U
C--    o OBCS_SPONGE_V
C--    o OBCS_SPONGE_T
C--    o OBCS_SPONGE_S

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

CStartOfInterface
      SUBROUTINE OBCS_SPONGE_U(
     U                gU_arr,
     I                iMin,iMax,jMin,jMax, k, bi, bj,
     I                myTime, myIter, myThid )
C     *==========================================================*
C     | S/R OBCS_SPONGE_U
C     | o Contains problem specific forcing for zonal velocity.
C     *==========================================================*
C     | Adds a relaxation term to gU near Open-Boundaries
C     *==========================================================*
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "OBCS_PARAMS.h"
#include "OBCS_GRID.h"
#include "OBCS_FIELDS.h"

C     == Routine arguments ==
C     gU_arr    :: the tendency array
C     iMin,iMax :: Working range of x-index for applying forcing.
C     jMin,jMax :: Working range of y-index for applying forcing.
C     k         :: Current vertical level index
C     bi,bj     :: Current tile indices
      _RL gU_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      INTEGER iMin, iMax, jMin, jMax
      INTEGER k, bi, bj
      _RL myTime
      INTEGER myIter
      INTEGER myThid
CEndOfInterface

#if defined(ALLOW_OBCS) && defined(ALLOW_OBCS_SPONGE)
C     == Local variables ==
C     Loop counters
      INTEGER i, j, isl, jsl
      _RL urelax, lambda_obcs_u

      IF ( useOBCSsponge .AND. spongeThickness.NE.0 ) THEN

C Northern Open Boundary
#ifdef ALLOW_OBCS_NORTH
       IF ( OBCSsponge_N .AND. OBCSsponge_UatNS ) THEN
        DO i=iMin,iMax
         IF ( OB_Jn(i,bi,bj).NE.OB_indexNone ) THEN
          DO jsl= 1,spongeThickness
           j=OB_Jn(i,bi,bj)-jsl
           IF ((j.ge.jmin).and.(j.le.jmax)) THEN
            IF (useLinearSponge) THEN
             urelax = OBNu(i,k,bi,bj)
            ELSE
             urelax=(
     &            float(spongeThickness-jsl)*OBNu(i,k,bi,bj)
     &            + float(jsl)*uVel(i,j,k,bi,bj) )
     &            / float(spongeThickness)
            ENDIF
            lambda_obcs_u = (
     &           float(spongeThickness-jsl)*Vrelaxobcsbound
     &           + float(jsl)*Vrelaxobcsinner)
     &           / float(spongeThickness)
            IF (lambda_obcs_u.ne.0.) THEN
             lambda_obcs_u = 1. _d 0 / lambda_obcs_u
            ELSE
             lambda_obcs_u = 0. _d 0
            ENDIF
            gU_arr(i,j) = gU_arr(i,j)
     &           - _maskW(i,j,k,bi,bj) * lambda_obcs_u
     &           * ( uVel(i,j,k,bi,bj) - urelax )
           ENDIF
          ENDDO
         ENDIF
        ENDDO
       ENDIF
#endif /* ALLOW_OBCS_NORTH */

C Southern Open Boundary
#ifdef ALLOW_OBCS_SOUTH
       IF ( OBCSsponge_S .AND. OBCSsponge_UatNS ) THEN
        DO i=iMin,iMax
         IF ( OB_Js(i,bi,bj).NE.OB_indexNone ) THEN
          DO jsl= 1,spongeThickness
           j=OB_Js(i,bi,bj)+jsl
           IF ((j.ge.jmin).and.(j.le.jmax)) THEN
            IF (useLinearSponge) THEN
             urelax= OBSu(i,k,bi,bj)
            ELSE
             urelax=(
     &            float(spongeThickness-jsl)*OBSu(i,k,bi,bj)
     &            + float(jsl)*uVel(i,j,k,bi,bj) )
     &            / float(spongeThickness)
            ENDIF
            lambda_obcs_u = (
     &           float(spongeThickness-jsl)*Vrelaxobcsbound
     &           + float(jsl)*Vrelaxobcsinner)
     &           / float(spongeThickness)
            IF (lambda_obcs_u.ne.0.) THEN
             lambda_obcs_u = 1. _d 0 / lambda_obcs_u
            ELSE
             lambda_obcs_u = 0. _d 0
            ENDIF
            gU_arr(i,j) = gU_arr(i,j)
     &           - _maskW(i,j,k,bi,bj) * lambda_obcs_u
     &           * ( uVel(i,j,k,bi,bj) - urelax )
           ENDIF
          ENDDO
         ENDIF
        ENDDO
       ENDIF
#endif /* ALLOW_OBCS_SOUTH */

C Eastern Open Boundary
#ifdef ALLOW_OBCS_EAST
       IF ( OBCSsponge_E .AND. OBCSsponge_UatEW ) THEN
        DO j=jMin,jMax
         IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN
          DO isl= 1,spongeThickness
           i=OB_Ie(j,bi,bj)-isl
           IF ((i.ge.imin).and.(i.le.imax)) THEN
            IF (useLinearSponge) THEN
             urelax=OBEu(j,k,bi,bj)
            ELSE
             urelax=(
     &            float(spongeThickness-isl)*OBEu(j,k,bi,bj)
     &            + float(isl)*uVel(i,j,k,bi,bj) )
     &            / float(spongeThickness)
            ENDIF
            lambda_obcs_u = (
     &           float(spongeThickness-isl)*Urelaxobcsbound
     &           + float(isl)*Urelaxobcsinner)
     &           / float(spongeThickness)
            IF (lambda_obcs_u.ne.0.) THEN
             lambda_obcs_u = 1. _d 0 / lambda_obcs_u
            ELSE
             lambda_obcs_u = 0. _d 0
            ENDIF
            gU_arr(i,j) = gU_arr(i,j)
     &           - _maskW(i,j,k,bi,bj) * lambda_obcs_u
     &           * ( uVel(i,j,k,bi,bj) - urelax )
           ENDIF
          ENDDO
         ENDIF
        ENDDO
       ENDIF
#endif /* ALLOW_OBCS_EAST */

C Western Open Boundary
#ifdef ALLOW_OBCS_WEST
       IF ( OBCSsponge_W .AND. OBCSsponge_UatEW ) THEN
        DO j=jMin,jMax
         IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN
          DO isl= 1,spongeThickness
           i=OB_Iw(j,bi,bj)+isl+1
           IF ((i.ge.imin).and.(i.le.imax)) THEN
            IF (useLinearSponge) THEN
             urelax= OBWu(j,k,bi,bj)
            ELSE
             urelax=(
     &            float(spongeThickness-isl)*OBWu(j,k,bi,bj)
     &            + float(isl)*uVel(i,j,k,bi,bj) )
     &            / float(spongeThickness)
            ENDIF
            lambda_obcs_u= (
     &           float(spongeThickness-isl)*Urelaxobcsbound
     &           + float(isl)*Urelaxobcsinner)
     &           / float(spongeThickness)
            IF (lambda_obcs_u.ne.0.) THEN
             lambda_obcs_u = 1. _d 0 / lambda_obcs_u
            ELSE
             lambda_obcs_u = 0. _d 0
            ENDIF
            gU_arr(i,j) = gU_arr(i,j)
     &           - _maskW(i,j,k,bi,bj) * lambda_obcs_u
     &           * ( uVel(i,j,k,bi,bj) - urelax )
           ENDIF
          ENDDO
         ENDIF
        ENDDO
       ENDIF
#endif /* ALLOW_OBCS_WEST */

      ENDIF

#endif /* ALLOW_OBCS & ALLOW_OBCS_SPONGE */

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

CStartOfInterface
      SUBROUTINE OBCS_SPONGE_V(
     U                gV_arr,
     I                iMin,iMax,jMin,jMax, k, bi, bj,
     I                myTime, myIter, myThid )
C     *==========================================================*
C     | S/R OBCS_SPONGE_V
C     | o Contains problem specific forcing for merid velocity.
C     *==========================================================*
C     | Adds a relaxation term to gV near Open-Boundaries
C     *==========================================================*
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "OBCS_PARAMS.h"
#include "OBCS_GRID.h"
#include "OBCS_FIELDS.h"

C     == Routine arguments ==
C     gV_arr    :: the tendency array
C     iMin,iMax :: Working range of x-index for applying forcing.
C     jMin,jMax :: Working range of y-index for applying forcing.
C     k         :: Current vertical level index
C     bi,bj     :: Current tile indices
      _RL gV_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      INTEGER iMin, iMax, jMin, jMax
      INTEGER k, bi, bj
      _RL myTime
      INTEGER myIter
      INTEGER myThid
CEndOfInterface

#if defined(ALLOW_OBCS) && defined(ALLOW_OBCS_SPONGE)
C     == Local variables ==
C     Loop counters
      INTEGER i, j, isl, jsl
      _RL vrelax,lambda_obcs_v

      IF ( useOBCSsponge .AND. spongeThickness.NE.0 ) THEN

C Northern Open Boundary
#ifdef ALLOW_OBCS_NORTH
       IF ( OBCSsponge_N .AND. OBCSsponge_VatNS ) THEN
        DO i=iMin,iMax
         IF ( OB_Jn(i,bi,bj).NE.OB_indexNone ) THEN
          DO jsl= 1,spongeThickness
           j=OB_Jn(i,bi,bj)-jsl
           IF ((j.ge.jmin).and.(j.le.jmax)) THEN
            IF (useLinearSponge) THEN
             vrelax= OBNv(i,k,bi,bj)
            ELSE
             vrelax=(
     &            float(spongeThickness-jsl)*OBNv(i,k,bi,bj)
     &            + float(jsl)*vVel(i,j,k,bi,bj) )
     &            / float(spongeThickness)
            ENDIF
            lambda_obcs_v = (
     &           float(spongeThickness-jsl)*Vrelaxobcsbound
     &           + float(jsl)*Vrelaxobcsinner)
     &           / float(spongeThickness)
            IF (lambda_obcs_v.ne.0.) THEN
             lambda_obcs_v = 1. _d 0 / lambda_obcs_v
            ELSE
             lambda_obcs_v = 0. _d 0
            ENDIF
            gV_arr(i,j) = gV_arr(i,j)
     &           - _maskS(i,j,k,bi,bj) * lambda_obcs_v
     &           * ( vVel(i,j,k,bi,bj) - vrelax )
           ENDIF
          ENDDO
         ENDIF
        ENDDO
       ENDIF
#endif /* ALLOW_OBCS_NORTH */

C Southern Open Boundary
#ifdef ALLOW_OBCS_SOUTH
       IF ( OBCSsponge_S .AND. OBCSsponge_VatNS ) THEN
        DO i=iMin,iMax
         IF ( OB_Js(i,bi,bj).NE.OB_indexNone ) THEN
          DO jsl= 1,spongeThickness
           j=OB_Js(i,bi,bj)+jsl+1
           IF ((j.ge.jmin).and.(j.le.jmax)) THEN
            IF (useLinearSponge) THEN
             vrelax= OBSv(i,k,bi,bj)
            ELSE
             vrelax=(
     &            float(spongeThickness-jsl)*OBSv(i,k,bi,bj)
     &            + float(jsl)*vVel(i,j,k,bi,bj) )
     &            / float(spongeThickness)
            ENDIF
            lambda_obcs_v = (
     &           float(spongeThickness-jsl)*Vrelaxobcsbound
     &           + float(jsl)*Vrelaxobcsinner)
     &           / float(spongeThickness)
            IF (lambda_obcs_v.ne.0.) THEN
             lambda_obcs_v = 1. _d 0 / lambda_obcs_v
            ELSE
             lambda_obcs_v = 0. _d 0
            ENDIF
            gV_arr(i,j) = gV_arr(i,j)
     &           - _maskS(i,j,k,bi,bj) * lambda_obcs_v
     &           * ( vVel(i,j,k,bi,bj) - vrelax )
           ENDIF
          ENDDO
         ENDIF
        ENDDO
       ENDIF
#endif /* ALLOW_OBCS_SOUTH */

C Eastern Open Boundary
#ifdef ALLOW_OBCS_EAST
       IF ( OBCSsponge_E .AND. OBCSsponge_VatEW ) THEN
        DO j=jMin,jMax
         IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN
          DO isl= 1,spongeThickness
           i=OB_Ie(j,bi,bj)-isl
           IF ((i.ge.imin).and.(i.le.imax)) THEN
            IF (useLinearSponge) THEN
             vrelax= OBEv(j,k,bi,bj)
            ELSE
             vrelax=(
     &            float(spongeThickness-isl)*OBEv(j,k,bi,bj)
     &            + float(isl)*vVel(i,j,k,bi,bj) )
     &            / float(spongeThickness)
            ENDIF
            lambda_obcs_v = (
     &           float(spongeThickness-isl)*Urelaxobcsbound
     &           + float(isl)*Urelaxobcsinner)
     &           / float(spongeThickness)
            If (lambda_obcs_v.ne.0.) THEN
             lambda_obcs_v = 1. _d 0 / lambda_obcs_v
            ELSE
             lambda_obcs_v = 0. _d 0
            ENDIF
            gV_arr(i,j) = gV_arr(i,j)
     &           - _maskS(i,j,k,bi,bj) * lambda_obcs_v
     &           * ( vVel(i,j,k,bi,bj) - vrelax )
           ENDIF
          ENDDO
         ENDIF
        ENDDO
       ENDIF
#endif /* ALLOW_OBCS_EAST */

C Western Open Boundary
#ifdef ALLOW_OBCS_WEST
       IF ( OBCSsponge_W .AND. OBCSsponge_VatEW ) THEN
        DO j=jMin,jMax
         IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN
          DO isl= 1,spongeThickness
           i=OB_Iw(j,bi,bj)+isl
           IF ((i.ge.imin).and.(i.le.imax)) THEN
            IF (useLinearSponge) THEN
             vrelax = OBWv(j,k,bi,bj)
            ELSE
             vrelax=(
     &            float(spongeThickness-isl)*OBWv(j,k,bi,bj)
     &            + float(isl)*vVel(i,j,k,bi,bj) )
     &            / float(spongeThickness)
            ENDIF
            lambda_obcs_v = (
     &           float(spongeThickness-isl)*Urelaxobcsbound
     &           + float(isl)*Urelaxobcsinner)
     &           / float(spongeThickness)
            IF (lambda_obcs_v.ne.0.) THEN
             lambda_obcs_v = 1. _d 0 / lambda_obcs_v
            ELSE
             lambda_obcs_v = 0. _d 0
            ENDIF
            gV_arr(i,j) = gV_arr(i,j)
     &           - _maskS(i,j,k,bi,bj) * lambda_obcs_v
     &           * ( vVel(i,j,k,bi,bj) - vrelax )
           ENDIF
          ENDDO
         ENDIF
        ENDDO
       ENDIF
#endif /* ALLOW_OBCS_WEST */

      ENDIF

#endif /* ALLOW_OBCS & ALLOW_OBCS_SPONGE */

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

CStartOfInterface
      SUBROUTINE OBCS_SPONGE_T(
     U                gT_arr,
     I                iMin,iMax,jMin,jMax, k, bi, bj,
     I                myTime, myIter, myThid )
C     *==========================================================*
C     | S/R OBCS_SPONGE_T
C     | o Contains problem specific forcing for temperature.
C     *==========================================================*
C     | Adds a relaxation term to gT near Open-Boundaries
C     *==========================================================*
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "OBCS_PARAMS.h"
#include "OBCS_GRID.h"
#include "OBCS_FIELDS.h"
#ifdef ALLOW_AUTODIFF_TAMC
# include "tamc.h"
# include "tamc_keys.h"
#endif

C     == Routine arguments ==
C     gT_arr    :: the tendency array
C     iMin,iMax :: Working range of x-index for applying forcing.
C     jMin,jMax :: Working range of y-index for applying forcing.
C     k         :: Current vertical level index
C     bi,bj     :: Current tile indices
      _RL gT_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      INTEGER iMin, iMax, jMin, jMax
      INTEGER k, bi, bj
      _RL myTime
      INTEGER myIter
      INTEGER myThid
CEndOfInterface

#if defined(ALLOW_OBCS) && defined(ALLOW_OBCS_SPONGE)
C     == Local variables ==
C     Loop counters
      INTEGER i, j, isl, jsl
      _RL trelax, lambda_obcs_t

      IF ( useOBCSsponge .AND. spongeThickness.NE.0 ) THEN

#ifdef ALLOW_AUTODIFF_TAMC
       act1 = bi - myBxLo(myThid)
       max1 = myBxHi(myThid) - myBxLo(myThid) + 1
       act2 = bj - myByLo(myThid)
       max2 = myByHi(myThid) - myByLo(myThid) + 1
       act3 = myThid - 1
       max3 = nTx*nTy
       act4 = ikey_dynamics - 1
       ikey = (act1 + 1) + act2*max1
     &      + act3*max1*max2
     &      + act4*max1*max2*max3
       kkey = (ikey-1)*Nr + k
#endif /* ALLOW_AUTODIFF_TAMC */

C Northern Open Boundary
#ifdef ALLOW_OBCS_NORTH
       IF ( OBCSsponge_N .AND. OBCSsponge_Theta ) THEN
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE OBNt(:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
#endif
        DO i=iMin,iMax
         IF ( OB_Jn(i,bi,bj).NE.OB_indexNone ) THEN
          DO jsl= 1,spongeThickness
           j=OB_Jn(i,bi,bj)-jsl
           IF ((j.ge.jmin).and.(j.le.jmax)) THEN
            IF  (OBNt(i,k,bi,bj).ne. 0.d0) then
             IF (useLinearSponge) THEN
              trelax = OBNt(i,k,bi,bj)
             ELSE
              trelax=(
     &             float(spongeThickness-jsl)*OBNt(i,k,bi,bj)
     &             + float(jsl)*theta(i,j,k,bi,bj) )
     &             / float(spongeThickness)
             ENDIF
             lambda_obcs_t = (
     &            float(spongeThickness-jsl)*Vrelaxobcsbound
     &            + float(jsl)*Vrelaxobcsinner)
     &            / float(spongeThickness)
             IF (lambda_obcs_t.ne.0.) THEN
              lambda_obcs_t = 1. _d 0 / lambda_obcs_t
             ELSE
              lambda_obcs_t = 0. _d 0
             ENDIF
             gT_arr(i,j) = gT_arr(i,j)
     &            -  maskC(i,j,k,bi,bj) * lambda_obcs_t
     &            * ( theta(i,j,k,bi,bj) - trelax )
            ENDIF
           ENDIF
          ENDDO
         ENDIF
        ENDDO
       ENDIF
#endif /* ALLOW_OBCS_NORTH */

C Southern Open Boundary
#ifdef ALLOW_OBCS_SOUTH
       IF ( OBCSsponge_S .AND. OBCSsponge_Theta ) THEN
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE OBSt(:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
#endif
        DO i=iMin,iMax
         IF ( OB_Js(i,bi,bj).NE.OB_indexNone ) THEN
          DO jsl= 1,spongeThickness
           j=OB_Js(i,bi,bj)+jsl
           IF ((j.ge.jmin).and.(j.le.jmax)) THEN
            IF  (OBSt(i,k,bi,bj).ne. 0.d0) then
             IF (useLinearSponge) THEN
              trelax= OBSt(i,k,bi,bj)
             ELSE
              trelax=(
     &             float(spongeThickness-jsl)*OBSt(i,k,bi,bj)
     &             + float(jsl)*theta(i,j,k,bi,bj) )
     &             / float(spongeThickness)
             ENDIF
             lambda_obcs_t = (
     &            float(spongeThickness-jsl)*Vrelaxobcsbound
     &            + float(jsl)*Vrelaxobcsinner)
     &            / float(spongeThickness)
             IF (lambda_obcs_t.ne.0.) THEN
              lambda_obcs_t = 1. _d 0 / lambda_obcs_t
             ELSE
              lambda_obcs_t = 0. _d 0
             ENDIF
             gT_arr(i,j) = gT_arr(i,j)
     &            - maskC(i,j,k,bi,bj) * lambda_obcs_t
     &            * ( theta(i,j,k,bi,bj) - trelax )
            ENDIF
           ENDIF
          ENDDO
         ENDIF
        ENDDO
       ENDIF
#endif /* ALLOW_OBCS_SOUTH */

C Eastern Open Boundary
#ifdef ALLOW_OBCS_EAST
       IF ( OBCSsponge_E .AND. OBCSsponge_Theta ) THEN
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE OBEt(:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
#endif
        DO j=jMin,jMax
         IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN
          DO isl= 1,spongeThickness
           i=OB_Ie(j,bi,bj)-isl
           IF ((i.ge.imin).and.(i.le.imax)) THEN
            IF  (OBEt(j,k,bi,bj).ne. 0.d0) then
             IF (useLinearSponge) THEN
              trelax = OBEt(j,k,bi,bj)
             ELSE
              trelax=(
     &             float(spongeThickness-isl)*OBEt(j,k,bi,bj)
     &             + float(isl)*theta(i,j,k,bi,bj) )
     &             / float(spongeThickness)
             ENDIF
             lambda_obcs_t = (
     &            float(spongeThickness-isl)*Urelaxobcsbound
     &            + float(isl)*Urelaxobcsinner)
     &            / float(spongeThickness)
             IF (lambda_obcs_t.ne.0.) THEN
              lambda_obcs_t = 1. _d 0 / lambda_obcs_t
             ELSE
              lambda_obcs_t = 0. _d 0
             ENDIF
             gT_arr(i,j) = gT_arr(i,j)
     &            - maskC(i,j,k,bi,bj) * lambda_obcs_t
     &            * ( theta(i,j,k,bi,bj) - trelax )
            ENDIF
           ENDIF
          ENDDO
         ENDIF
        ENDDO
       ENDIF
#endif /* ALLOW_OBCS_EAST */

C Western Open Boundary
#ifdef ALLOW_OBCS_WEST
       IF ( OBCSsponge_W .AND. OBCSsponge_Theta ) THEN
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE OBWt(:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
#endif
        DO j=jMin,jMax
         IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN
          DO isl= 1,spongeThickness
           i=OB_Iw(j,bi,bj)+isl
           IF ((i.ge.imin).and.(i.le.imax)) THEN
            IF  (OBWt(j,k,bi,bj).ne. 0.d0) THEN
             IF (useLinearSponge) THEN
              trelax= OBWt(j,k,bi,bj)
             ELSE
              trelax=(
     &             float(spongeThickness-isl)*OBWt(j,k,bi,bj)
     &             + float(isl)*theta(i,j,k,bi,bj) )
     &             / float(spongeThickness)
             ENDIF
             lambda_obcs_t= (
     &            float(spongeThickness-isl)*Urelaxobcsbound
     &            + float(isl)*Urelaxobcsinner)
     &            / float(spongeThickness)
             IF (lambda_obcs_t .ne. 0.) THEN
              lambda_obcs_t = 1. _d 0 / lambda_obcs_t
             ELSE
              lambda_obcs_t = 0. _d 0
             ENDIF
             gT_arr(i,j) = gT_arr(i,j)
     &            - maskC(i,j,k,bi,bj) * lambda_obcs_t
     &            * ( theta(i,j,k,bi,bj) - trelax )
            ENDIF
           ENDIF
          ENDDO
         ENDIF
        ENDDO
       ENDIF
#endif /* ALLOW_OBCS_WEST */

      ENDIF

#endif /* ALLOW_OBCS & ALLOW_OBCS_SPONGE */

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

CStartOfInterface
      SUBROUTINE OBCS_SPONGE_S(
     U                gS_arr,
     I                iMin,iMax,jMin,jMax, k, bi, bj,
     I                myTime, myIter, myThid )
C     *==========================================================*
C     | S/R OBCS_SPONGE_S
C     | o Contains problem specific forcing for salinity.
C     *==========================================================*
C     | Adds a relaxation term to gS near Open-Boundaries
C     *==========================================================*
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "OBCS_PARAMS.h"
#include "OBCS_GRID.h"
#include "OBCS_FIELDS.h"
#ifdef ALLOW_AUTODIFF_TAMC
# include "tamc.h"
# include "tamc_keys.h"
#endif

C     == Routine arguments ==
C     gS_arr    :: the tendency array
C     iMin,iMax :: Working range of x-index for applying forcing.
C     jMin,jMax :: Working range of y-index for applying forcing.
C     k         :: Current vertical level index
C     bi,bj     :: Current tile indices
      _RL gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      INTEGER iMin, iMax, jMin, jMax
      INTEGER k, bi, bj
      _RL myTime
      INTEGER myIter
      INTEGER myThid
CEndOfInterface

#if defined(ALLOW_OBCS) && defined(ALLOW_OBCS_SPONGE)
C     == Local variables ==
C     Loop counters
      INTEGER i, j, isl, jsl
      _RL srelax, lambda_obcs_s

      IF ( useOBCSsponge .AND. spongeThickness.NE.0 ) THEN

#ifdef ALLOW_AUTODIFF_TAMC
       act1 = bi - myBxLo(myThid)
       max1 = myBxHi(myThid) - myBxLo(myThid) + 1
       act2 = bj - myByLo(myThid)
       max2 = myByHi(myThid) - myByLo(myThid) + 1
       act3 = myThid - 1
       max3 = nTx*nTy
       act4 = ikey_dynamics - 1
       ikey = (act1 + 1) + act2*max1
     &      + act3*max1*max2
     &      + act4*max1*max2*max3
       kkey = (ikey-1)*Nr + k
#endif /* ALLOW_AUTODIFF_TAMC */

C Northern Open Boundary
#ifdef ALLOW_OBCS_NORTH
       IF ( OBCSsponge_N .AND. OBCSsponge_Salt ) THEN
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE OBNs(:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
#endif
        DO i=iMin,iMax
         IF ( OB_Jn(i,bi,bj).NE.OB_indexNone ) THEN
          DO jsl= 1,spongeThickness
           j=OB_Jn(i,bi,bj)-jsl
           IF ((j.ge.jmin).and.(j.le.jmax)) THEN
            IF  (OBNs(i,k,bi,bj).ne. 0.d0) then
             IF (useLinearSponge) THEN
              srelax= OBNs(i,k,bi,bj)
             ELSE
              srelax=(
     &             float(spongeThickness-jsl)*OBNs(i,k,bi,bj)
     &             + float(jsl)*salt(i,j,k,bi,bj) )
     &             / float(spongeThickness)
             ENDIF
             lambda_obcs_s = (
     &            float(spongeThickness-jsl)*Vrelaxobcsbound
     &            + float(jsl)*Vrelaxobcsinner)
     &            / float(spongeThickness)
             IF (lambda_obcs_s.ne.0.) THEN
              lambda_obcs_s = 1. _d 0 / lambda_obcs_s
             ELSE
              lambda_obcs_s = 0. _d 0
             ENDIF
             gS_arr(i,j) = gS_arr(i,j)
     &            - maskC(i,j,k,bi,bj) * lambda_obcs_s
     &            * ( salt(i,j,k,bi,bj) - srelax )
            ENDIF
           ENDIF
          ENDDO
         ENDIF
        ENDDO
       ENDIF
#endif /* ALLOW_OBCS_NORTH */

C Southern Open Boundary
#ifdef ALLOW_OBCS_SOUTH
       IF ( OBCSsponge_S .AND. OBCSsponge_Salt ) THEN
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE OBSs(:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
#endif
        DO i=iMin,iMax
         IF ( OB_Js(i,bi,bj).NE.OB_indexNone ) THEN
          DO jsl= 1,spongeThickness
           j=OB_Js(i,bi,bj)+jsl
           IF ((j.ge.jmin).and.(j.le.jmax)) THEN
            IF  (OBSs(i,k,bi,bj).ne. 0.d0) THEN
            IF (useLinearSponge) THEN
             srelax= OBSs(i,k,bi,bj)
            ELSE
             srelax=(
     &            float(spongeThickness-jsl)*OBSs(i,k,bi,bj)
     &            + float(jsl)*salt(i,j,k,bi,bj) )
     &            / float(spongeThickness)
            ENDIF
            lambda_obcs_s = (
     &           float(spongeThickness)*Vrelaxobcsbound
     &           + float(jsl)*Vrelaxobcsinner)
     &           / float(spongeThickness)
            IF (lambda_obcs_s.ne.0.) THEN
             lambda_obcs_s = 1. _d 0 / lambda_obcs_s
            ELSE
             lambda_obcs_s = 0. _d 0
            ENDIF
            gS_arr(i,j) = gS_arr(i,j)
     &           - maskC(i,j,k,bi,bj) * lambda_obcs_s
     &           * ( salt(i,j,k,bi,bj) - srelax )
           ENDIF
          ENDIF
         ENDDO
        ENDIF
       ENDDO
      ENDIF
#endif /* ALLOW_OBCS_SOUTH */

C Eastern Open Boundary
#ifdef ALLOW_OBCS_EAST
      IF ( OBCSsponge_E .AND. OBCSsponge_Salt ) THEN
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE OBEs(:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
#endif
       DO j=jMin,jMax
        IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN
         DO isl= 1,spongeThickness
          i=OB_Ie(j,bi,bj)-isl
          IF ((i.ge.imin).and.(i.le.imax)) THEN
           IF  (OBEs(j,k,bi,bj).ne. 0.d0) THEN
            IF (useLinearSponge) THEN
             srelax=  OBEs(j,k,bi,bj)
            ELSE
             srelax=(
     &            float(spongeThickness-isl)*OBEs(j,k,bi,bj)
     &            + float(isl)*salt(i,j,k,bi,bj) )
     &            / float(spongeThickness)
            ENDIF
            lambda_obcs_s = (
     &           float(spongeThickness-isl)*Urelaxobcsbound
     &           + float(isl)*Urelaxobcsinner)
     &           / float(spongeThickness)
            IF (lambda_obcs_s.ne.0.) THEN
             lambda_obcs_s = 1. _d 0 / lambda_obcs_s
            ELSE
             lambda_obcs_s = 0. _d 0
            ENDIF
            gS_arr(i,j) = gS_arr(i,j)
     &           - maskC(i,j,k,bi,bj) * lambda_obcs_s
     &           * ( salt(i,j,k,bi,bj) - srelax )
           ENDIF
          ENDIF
         ENDDO
        ENDIF
       ENDDO
      ENDIF
#endif /* ALLOW_OBCS_EAST */

C Western Open Boundary
#ifdef ALLOW_OBCS_WEST
      IF ( OBCSsponge_W .AND. OBCSsponge_Salt ) THEN
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE OBWs(:,k,bi,bj)  = comlev1_bibj_k, key=kkey, byte=isbyte
#endif
       DO j=jMin,jMax
        IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN
         DO isl= 1,spongeThickness
          i=OB_Iw(j,bi,bj)+isl
          IF ((i.ge.imin).and.(i.le.imax)) THEN
           IF  (OBWs(j,k,bi,bj).ne. 0.d0) then
            IF (useLinearSponge) THEN
             srelax= OBWs(j,k,bi,bj)
            ELSE
             srelax=(
     &            float(spongeThickness-isl)*OBWs(j,k,bi,bj)
     &            + float(isl)*salt(i,j,k,bi,bj) )
     &            / float(spongeThickness)
            ENDIF
            lambda_obcs_s= (
     &           float(spongeThickness-isl)*Urelaxobcsbound
     &           + float(isl)*Urelaxobcsinner)
     &           / float(spongeThickness)
            IF (lambda_obcs_s.ne.0.) THEN
             lambda_obcs_s = 1. _d 0 / lambda_obcs_s
            ELSE
             lambda_obcs_s = 0. _d 0
            ENDIF
            gS_arr(i,j) = gS_arr(i,j)
     &           - maskC(i,j,k,bi,bj) * lambda_obcs_s
     &           * ( salt(i,j,k,bi,bj) - srelax )
           ENDIF
          ENDIF
         ENDDO
        ENDIF
       ENDDO
      ENDIF
#endif /* ALLOW_OBCS_WEST */

      ENDIF

#endif /* ALLOW_OBCS & ALLOW_OBCS_SPONGE */

      RETURN
      END