C $Header: /u/gcmpack/MITgcm/pkg/down_slope/dwnslp_apply.F,v 1.7 2014/08/20 22:35:50 jmc Exp $
C $Name:  $

#include "DWNSLP_OPTIONS.h"

CBOP
C     !ROUTINE: DWNSLP_APPLY
C     !INTERFACE:
      SUBROUTINE DWNSLP_APPLY(
     I            trIdentity, bi, bj, kBottom,
     I            tracer,
     U            gTracer,
     I            recip_hFac, recip_rA_arg, recip_drF,
     I            deltaTLev, myTime, myIter, myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE DWNSLP_APPLY
C     | o Apply the dowsloping-transport to tracer field
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE

C     === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DWNSLP_SIZE.h"
#include "DWNSLP_PARAMS.h"
#include "DWNSLP_VARS.h"
#ifdef ALLOW_GENERIC_ADVDIFF
# include "GAD.h"
#endif

C     !INPUT/OUTPUT PARAMETERS:
C     === Routine arguments ===
C     trIdentity :: tracer identification number
C     bi,bj      :: Tile indices
C     kBottom    :: bottom level
C     tracer     :: tracer field at current time (input)
C     gTracer    :: tracer tendency to update
C     recip_hFac :: Reciprocal of cell open-depth factor
C     recip_rA_arg :: Reciprocal of cell Area
C     recip_drF  :: Reciprocal of cell thickness
C     deltaTLev  :: tracer time step
C     myTime     :: Current time in simulation
C     myIter     :: Current time-step number
C     myThid     :: my Thread Id. number
      INTEGER trIdentity
      INTEGER bi, bj
      INTEGER kBottom ( xySize, nSx, nSy )
      _RL tracer      ( xySize, Nr )
      _RL gTracer     ( xySize, Nr )
      _RS recip_hFac  ( xySize, Nr )
      _RS recip_rA_arg( xySize, nSx, nSy )
      _RS recip_drF(Nr)
      _RL deltaTLev(Nr)
      _RL     myTime
      INTEGER myIter, myThid

#ifdef ALLOW_DOWN_SLOPE
#ifdef ALLOW_DIAGNOSTICS
C-    !FUNCTIONS:
      LOGICAL  DIAGNOSTICS_IS_ON
      EXTERNAL 
#endif /* ALLOW_DIAGNOSTICS */

C     !LOCAL VARIABLES:
C     === Local variables ===
C     msgBuf     :: Informational/error message buffer
      INTEGER k
      INTEGER n,ijd,ijs,kshelf
      _RL     gTrLoc(0:Nr)
      _RL     tmpFld
      INTEGER upward
      LOGICAL onOffFlag

#ifdef ALLOW_DIAGNOSTICS
      CHARACTER*8 diagName
      CHARACTER*4 diagSufx
      LOGICAL     doDiagDwnSlpTend
      _RL         tmpFac
#ifdef ALLOW_GENERIC_ADVDIFF
      CHARACTER*4 GAD_DIAG_SUFX
      EXTERNAL    
#endif
#endif /* ALLOW_DIAGNOSTICS */

CEOP

      onOffFlag = .TRUE.
#ifdef ALLOW_GENERIC_ADVDIFF
      IF ( trIdentity.EQ.GAD_TEMPERATURE ) onOffFlag = temp_useDWNSLP
      IF ( trIdentity.EQ.GAD_SALINITY    ) onOffFlag = salt_useDWNSLP
#endif
      IF ( onOffFlag ) THEN
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

c      upward = rkSign*NINT(-gravitySign)
       upward = 1
       IF (usingZCoords) upward = -1

#ifdef ALLOW_DIAGNOSTICS
       IF ( useDiagnostics ) THEN
        IF ( trIdentity.GE.1 ) THEN
C--   Set diagnostic suffix for the current tracer
#ifdef ALLOW_GENERIC_ADVDIFF
          diagSufx = GAD_DIAG_SUFX( trIdentity, myThid )
#else
          diagSufx = 'aaaa'
#endif
          diagName = 'DSLP'//diagSufx
        ELSE
          STOP 'S/R DWNSLP_APPLY: should never reach this point !'
        ENDIF
        doDiagDwnSlpTend = DIAGNOSTICS_IS_ON(diagName,myThid)
       ELSE
        doDiagDwnSlpTend = .FALSE.
       ENDIF
       IF ( doDiagDwnSlpTend ) THEN
         tmpFac = -1. _d 0
         CALL DIAGNOSTICS_SCALE_FILL( gTracer, tmpFac, 1, diagName,
     &                                0, Nr, -2, bi, bj, myThid )
       ENDIF
#endif /* ALLOW_DIAGNOSTICS */

       IF ( DWNSLP_ioUnit.GT.0 ) THEN
        _BEGIN_MASTER(myThid)
        WRITE(DWNSLP_ioUnit,'(A,I8,3I4)')
     &   ' DWNSLP_APPLY: iter, iTr, bi,bj=', myIter,trIdentity, bi,bj
        WRITE(DWNSLP_ioUnit,'(2A)') '  bi  bj     n    ijDp    ijSh',
     &   ' kDp   Tr_Dp         Gt_Dp         Tr_Sh         Gt_Sh'
        _END_MASTER(myThid)
       ENDIF

       DO n=1,DWNSLP_NbSite(bi,bj)
        IF (DWNSLP_deepK(n,bi,bj).NE.0) THEN

C- detect density gradient along the slope => Downsloping flow

         ijd = DWNSLP_ijDeep(n,bi,bj)
         ijs = ijd + DWNSLP_shVsD(n,bi,bj)

         kshelf = kBottom(ijs,bi,bj)
         tmpFld = tracer(ijs,kshelf)
C- downsloping flow (in) & upward return flow :
         DO k=DWNSLP_deepK(n,bi,bj),kshelf,upward
          gTrLoc(k) = DWNSLP_Transp(n,bi,bj)
     &       *( tmpFld - tracer(ijd,k) )
     &       *recip_drF(k)*recip_hFac(ijd,k)
     &       *recip_rA_arg(ijd,bi,bj)
          gTracer(ijd,k) = gTracer(ijd,k) + gTrLoc(k)
          tmpFld = tracer(ijd,k)
         ENDDO
C- downsloping flow (out) & return flow to the shelf
          k = kshelf
          gTrLoc(0) = DWNSLP_Transp(n,bi,bj)
     &       *( tmpFld - tracer(ijs,k) )
     &       *recip_drF(k)*recip_hFac(ijs,k)
     &       *recip_rA_arg(ijs,bi,bj)
          gTracer(ijs,k) = gTracer(ijs,k) + gTrLoc(0)

         IF ( DWNSLP_ioUnit.GT.0 ) THEN
          _BEGIN_MASTER(myThid)
          k=DWNSLP_deepK(n,bi,bj)
          WRITE(DWNSLP_ioUnit,'(2I4,I6,2I8,I4,1P4E14.6)')
     &      bi,bj,n,ijd,ijs,k,
     &      tracer(ijd,k),
     &      deltaTLev(k)*DWNSLP_Transp(n,bi,bj)
     &       *recip_drF(k)*recip_hFac(ijd,k)
     &       *recip_rA_arg(ijd,bi,bj)*
     &        (tracer(ijs,kshelf)-tracer(ijd,k)),
     &      tracer(ijs,kshelf),
     &      deltaTLev(k)*DWNSLP_Transp(n,bi,bj)
     &       *recip_drF(kshelf)*recip_hFac(ijs,kshelf)
     &       *recip_rA_arg(ijs,bi,bj)*
     &        (tmpFld-tracer(ijs,kshelf))
          _END_MASTER(myThid)
         ENDIF
        ENDIF
       ENDDO
       IF ( DWNSLP_ioUnit.GT.0 ) THEN
         _BEGIN_MASTER(myThid)
         WRITE(DWNSLP_ioUnit,*)
         _END_MASTER(myThid)
       ENDIF

#ifdef ALLOW_DIAGNOSTICS
       IF ( doDiagDwnSlpTend )
     &  CALL DIAGNOSTICS_FILL( gTracer, diagName, 0,Nr,2,bi,bj,myThid )
#endif /* ALLOW_DIAGNOSTICS */

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C--   end if on-off-flag
      ENDIF

#endif /* ALLOW_DOWN_SLOPE */

      RETURN
      END