C $Header: /u/gcmpack/MITgcm/model/src/integrate_for_w.F,v 1.16 2011/05/23 00:39:20 jmc Exp $
C $Name:  $

#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: INTEGRATE_FOR_W
C     !INTERFACE:
      SUBROUTINE INTEGRATE_FOR_W(
     I                     bi, bj, k, uFld, vFld, mFld, rStarDhDt,
     O                     wFld,
     I                     myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE INTEGRATE_FOR_W
C     | o Integrate for vertical velocity.
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE
C     == GLobal variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "SURFACE.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     uFld, vFld :: Zonal and meridional flow
C     mFld       :: added mass
C     rStarDhDt  :: relative time derivative of column thickness = d.eta/dt / H
C     wFld       :: Vertical flow
      INTEGER bi,bj,k
      _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)
#ifdef ALLOW_ADDFLUID
      _RL  mFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
#else
      _RL  mFld (1)
#endif
#if (defined NONLIN_FRSURF) && !(defined DISABLE_RSTAR_CODE)
      _RL rStarDhDt(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
#else
      _RL rStarDhDt(1)
#endif
      _RL  wFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     uTrans, vTrans :: Temps. for volume transports
C     conv2d         :: horizontal transport convergence [m^3/s]
      INTEGER i,j
      _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL conv2d(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
CEOP

C--   Calculate velocity field "volume transports" through
C     tracer cell faces (anelastic: scaled as a mass transport).
      DO j=1,sNy+1
        DO i=1,sNx+1
          uTrans(i,j) = uFld(i,j,k,bi,bj)
     &                *_dyG(i,j,bi,bj)*deepFacC(k)*rhoFacC(k)
     &                *drF(k)*_hFacW(i,j,k,bi,bj)
          vTrans(i,j) = vFld(i,j,k,bi,bj)
     &                *_dxG(i,j,bi,bj)*deepFacC(k)*rhoFacC(k)
     &                *drF(k)*_hFacS(i,j,k,bi,bj)
        ENDDO
      ENDDO
      DO j=1,sNy
        DO i=1,sNx
          conv2d(i,j) = -( uTrans(i+1,j)-uTrans(i,j)
     &                    +vTrans(i,j+1)-vTrans(i,j) )
        ENDDO
      ENDDO
#ifdef ALLOW_ADDFLUID
      IF ( selectAddFluid.GE.1 ) THEN
       DO j=1,sNy
        DO i=1,sNx
          conv2d(i,j) = conv2d(i,j)
     &                + mFld(i,j,k,bi,bj)*mass2rUnit
        ENDDO
       ENDDO
      ENDIF
#endif /* ALLOW_ADDFLUID */

C--   Calculate vertical "volume transport" through face k
C     between tracer cell k-1 & k
      IF (rigidLid) THEN
C-  o Rigid-Lid case: zero at lower and upper boundaries
        IF (k.EQ.1) THEN
          DO j=1,sNy
           DO i=1,sNx
             wFld(i,j,k,bi,bj) = 0.
           ENDDO
          ENDDO
        ELSEIF (k.EQ.Nr) THEN
          DO j=1,sNy
           DO i=1,sNx
             wFld(i,j,k,bi,bj) =
     &          conv2d(i,j)*recip_rA(i,j,bi,bj)
     &         *maskC(i,j,k,bi,bj)*maskC(i,j,k-1,bi,bj)
     &         *recip_deepFac2F(k)*recip_rhoFacF(k)
           ENDDO
          ENDDO
        ELSE
          DO j=1,sNy
           DO i=1,sNx
             wFld(i,j,k,bi,bj) =
     &        ( wFld(i,j,k+1,bi,bj)*deepFac2F(k+1)*rhoFacF(k+1)
     &         +conv2d(i,j)*recip_rA(i,j,bi,bj)
     &        )*maskC(i,j,k,bi,bj)*maskC(i,j,k-1,bi,bj)
     &         *recip_deepFac2F(k)*recip_rhoFacF(k)
           ENDDO
          ENDDO
        ENDIF
#ifdef NONLIN_FRSURF
# ifndef DISABLE_RSTAR_CODE
      ELSEIF ( select_rStar.NE.0 ) THEN
C-  o rStar case: zero under-ground and at r_lower boundary
C     can be non-zero at surface (useRealFreshWaterFlux).
        IF (k.EQ.Nr) THEN
          DO j=1,sNy
           DO i=1,sNx
             wFld(i,j,k,bi,bj) =
     &        ( conv2d(i,j)*recip_rA(i,j,bi,bj)
     &         -rStarDhDt(i,j)*drF(k)*h0FacC(i,j,k,bi,bj)
     &        )*maskC(i,j,k,bi,bj)
     &         *recip_deepFac2F(k)*recip_rhoFacF(k)
           ENDDO
          ENDDO
        ELSE
          DO j=1,sNy
           DO i=1,sNx
             wFld(i,j,k,bi,bj) =
     &        ( wFld(i,j,k+1,bi,bj)*deepFac2F(k+1)*rhoFacF(k+1)
     &         +conv2d(i,j)*recip_rA(i,j,bi,bj)
     &         -rStarDhDt(i,j)*drF(k)*h0FacC(i,j,k,bi,bj)
     &        )*maskC(i,j,k,bi,bj)
     &         *recip_deepFac2F(k)*recip_rhoFacF(k)
           ENDDO
          ENDDO
        ENDIF
# endif /* DISABLE_RSTAR_CODE */
# ifndef DISABLE_SIGMA_CODE
      ELSEIF ( selectSigmaCoord.NE.0 ) THEN
C-  o Hybrid Sigma coordinate:
        IF (k.EQ.Nr) THEN
          DO j=1,sNy
           DO i=1,sNx
             wFld(i,j,k,bi,bj) =
     &        ( conv2d(i,j)*recip_rA(i,j,bi,bj)
     &         -dEtaHdt(i,j,bi,bj)*dBHybSigF(k)
     &        )*maskC(i,j,k,bi,bj)
           ENDDO
          ENDDO
        ELSE
          DO j=1,sNy
           DO i=1,sNx
             wFld(i,j,k,bi,bj) =
     &        ( wFld(i,j,k+1,bi,bj)
     &         +conv2d(i,j)*recip_rA(i,j,bi,bj)
     &         -dEtaHdt(i,j,bi,bj)*dBHybSigF(k)
     &        )*maskC(i,j,k,bi,bj)
           ENDDO
          ENDDO
        ENDIF
# endif /* DISABLE_SIGMA_CODE */
#endif /* NONLIN_FRSURF */
      ELSE
C-  o Free Surface case (r-Coordinate):
C      non zero at surface ; zero under-ground and at r_lower boundary
        IF (k.EQ.Nr) THEN
          DO j=1,sNy
           DO i=1,sNx
             wFld(i,j,k,bi,bj) =
     &          conv2d(i,j)*recip_rA(i,j,bi,bj)
     &         *maskC(i,j,k,bi,bj)
     &         *recip_deepFac2F(k)*recip_rhoFacF(k)
           ENDDO
          ENDDO
        ELSE
          DO j=1,sNy
           DO i=1,sNx
             wFld(i,j,k,bi,bj) =
     &        ( wFld(i,j,k+1,bi,bj)*deepFac2F(k+1)*rhoFacF(k+1)
     &         +conv2d(i,j)*recip_rA(i,j,bi,bj)
     &        )*maskC(i,j,k,bi,bj)
     &         *recip_deepFac2F(k)*recip_rhoFacF(k)
           ENDDO
          ENDDO
        ENDIF
C-  endif - rigid-lid / Free-Surf.
      ENDIF

      RETURN
      END