pkg/down_slope/dwnslp_calc_flow.F

b6bbe8cccf Jean*0001 #include "DWNSLP_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: DWNSLP_CALC_FLOW
                0005 C     !INTERFACE:
                0006       SUBROUTINE DWNSLP_CALC_FLOW(
04f24c0cdf Jean*0007      I                             bi, bj, kBottom, rho3d,
b6bbe8cccf Jean*0008      I                             myTime, myIter, myThid )
bb79aa40f5 Jean*0009
b6bbe8cccf Jean*0010 C     !DESCRIPTION: \bv
                0011 C     *==========================================================*
                0012 C     | SUBROUTINE DWNSLP_CALC_FLOW
                0013 C     | o Detect active site of Down-Sloping flow and compute
                0014 C     |   the corresponding volume transport
                0015 C     *==========================================================*
                0016 C     \ev
                0017
                0018 C     !USES:
                0019       IMPLICIT NONE
                0020
                0021 C     === Global variables ===
                0022 #include "SIZE.h"
                0023 #include "EEPARAMS.h"
                0024 #include "PARAMS.h"
                0025 #include "DWNSLP_SIZE.h"
                0026 #include "DWNSLP_PARAMS.h"
                0027 #include "DWNSLP_VARS.h"
                0028
                0029 C     !INPUT/OUTPUT PARAMETERS:
                0030 C     === Routine arguments ===
                0031 C     bi,bj     :: Tile indices
                0032 C     kBottom   :: Vertical index of bottom grid cell.
04f24c0cdf Jean*0033 C     rho3d     :: In-situ density [kg/m3] computed at z=rC ;
b6bbe8cccf Jean*0034 C     myTime    :: Current time in simulation
                0035 C     myIter    :: Current time-step number
                0036 C     myThid    :: my Thread Id number
                0037       INTEGER bi, bj
04f24c0cdf Jean*0038       INTEGER kBottom( xySize, nSx,nSy )
                0039       _RL     rho3d  ( xySize, Nr,nSx,nSy )
b6bbe8cccf Jean*0040       _RL     myTime
                0041       INTEGER myIter, myThid
                0042
                0043 #ifdef ALLOW_DOWN_SLOPE
                0044
                0045 C     !LOCAL VARIABLES:
                0046 C     === Local variables ===
bb79aa40f5 Jean*0047 C     msgBuf    :: Informational/error message buffer
b6bbe8cccf Jean*0048 C     ijd     :: horiz. index of deep water column receiving dense water flow
                0049 C     ijs     :: horiz. index of shallow water column (e.g. shelf)
                0050 C                from which dense water flow originates
                0051 c     CHARACTER*(MAX_LEN_MBUF) msgBuf
                0052       INTEGER k
                0053       INTEGER n, ijd, ijr, ijs
                0054       INTEGER kdeep, ishelf, jshelf, kshelf
                0055       _RL     dRhoH
                0056       INTEGER downward
                0057 #ifdef ALLOW_DIAGNOSTICS
                0058       LOGICAL doDiagDwnSlpFlow
                0059       INTEGER ij
                0060       _RL     sgnFac
                0061       _RL     uFlow( xySize )
                0062       _RL     vFlow( xySize )
                0063 C-    Functions:
                0064       LOGICAL  DIAGNOSTICS_IS_ON
                0065       EXTERNAL DIAGNOSTICS_IS_ON
                0066 #endif /* ALLOW_DIAGNOSTICS */
                0067
                0068 CEOP
                0069
                0070 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0071
                0072 c     downward = rkSign*NINT(gravitySign)
                0073       downward = 1
                0074       IF ( usingPCoords ) downward = -1
                0075
                0076 #ifdef ALLOW_DIAGNOSTICS
                0077       IF ( useDiagnostics ) THEN
                0078         doDiagDwnSlpFlow = DIAGNOSTICS_IS_ON( 'DSLPuFlw', myThid )
                0079      &                .OR. DIAGNOSTICS_IS_ON( 'DSLPvFlw', myThid )
                0080         IF ( doDiagDwnSlpFlow ) THEN
                0081           DO ij=1,xySize
                0082            uFlow(ij) = 0. _d 0
                0083            vFlow(ij) = 0. _d 0
                0084           ENDDO
                0085         ENDIF
                0086       ELSE
                0087         doDiagDwnSlpFlow = .FALSE.
                0088       ENDIF
                0089 #endif /* ALLOW_DIAGNOSTICS */
                0090
                0091       DO n=1,DWNSLP_NbSite(bi,bj)
                0092         DWNSLP_deepK(n,bi,bj) = 0
                0093
0884a363a5 Jean*0094 C- detect density gradient along the slope => Downsloping flow
b6bbe8cccf Jean*0095
                0096         ijd = DWNSLP_ijDeep(n,bi,bj)
                0097         ijr = DWNSLP_shVsD(n,bi,bj)
                0098         ijs = ijd + ijr
                0099         kshelf = kBottom(ijs,bi,bj)
                0100
04f24c0cdf Jean*0101         dRhoH = rho3d(ijs,kshelf,bi,bj)
                0102      &         -rho3d(ijd,kshelf,bi,bj)
b6bbe8cccf Jean*0103 c       IF ( dRhoH.GT.0. _d 0 ) THEN
04f24c0cdf Jean*0104         IF ( rho3d(ijs,kshelf+1,bi,bj).GT.rho3d(ijd,kshelf+1,bi,bj)
b6bbe8cccf Jean*0105      &    .AND. dRhoH.GT.0. _d 0 ) THEN
                0106
                0107 C- search for deepest level where Rho_shelf > Rho_deep
                0108           kdeep = kshelf
                0109           DO k=kshelf+1,kBottom(ijd,bi,bj),downward
04f24c0cdf Jean*0110            IF ( rho3d(ijs,k,bi,bj).GT.rho3d(ijd,k,bi,bj) ) kdeep = k
b6bbe8cccf Jean*0111           ENDDO
                0112           DWNSLP_deepK(n,bi,bj) = kdeep
                0113
                0114 C- Compute the Volume Transport :
                0115 C- same formulation as described in the paper:
                0116 c         downslpFlow  = DWNSLP_gamma/mu *gravity*dRhoH*recip_rhoConst
                0117 C    with DWNSLP_Gamma = slope * effective cross-section area
                0118           DWNSLP_Transp(n,bi,bj) = DWNSLP_Gamma(n,bi,bj)
                0119      &             *DWNSLP_rec_mu*gravity*dRhoH*recip_rhoConst
                0120
                0121 #ifdef ALLOW_DIAGNOSTICS
                0122           IF ( doDiagDwnSlpFlow ) THEN
                0123             ij = MAX( ijd, ijs )
                0124             sgnFac = SIGN(1,-ijr)
                0125             IF ( ABS(ijr).EQ.1 ) THEN
                0126              uFlow(ij) = sgnFac*DWNSLP_Transp(n,bi,bj)
                0127             ELSE
                0128              vFlow(ij) = sgnFac*DWNSLP_Transp(n,bi,bj)
                0129             ENDIF
                0130           ENDIF
                0131 #endif /* ALLOW_DIAGNOSTICS */
                0132
                0133         ENDIF
                0134
                0135 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0136       ENDDO
                0137
bb79aa40f5 Jean*0138       IF ( DWNSLP_ioUnit.GT.0 ) THEN
                0139        _BEGIN_MASTER(myThid)
b6bbe8cccf Jean*0140        WRITE(DWNSLP_ioUnit,'(A,I8,2I4)')
                0141      &      ' DWNSLP_CALC_FLOW: iter,bi,bj=',myIter,bi,bj
                0142        WRITE(DWNSLP_ioUnit,'(A)')
                0143      &   '  bi  bj     n :     ijd   ijr  is  js ;  ks kd-s Transp :'
                0144        DO n=1,DWNSLP_NbSite(bi,bj)
                0145         IF (DWNSLP_deepK(n,bi,bj).NE.0) THEN
                0146          ijs = DWNSLP_ijDeep(n,bi,bj) + DWNSLP_shVsD(n,bi,bj)
                0147          ishelf = 1-OLx + mod(ijs-1,xSize)
                0148          jshelf = 1-OLy + (ijs-1)/xSize
                0149          kshelf = kBottom(ijs,bi,bj)
                0150          WRITE(DWNSLP_ioUnit,'(2I4,I6,A,I8,I6,2I4,A,2I4,1PE14.6)')
                0151      &     bi,bj,n,' :', DWNSLP_ijDeep(n,bi,bj),
                0152      &                   DWNSLP_shVsD(n,bi,bj), ishelf,jshelf,
                0153      &             ' ;', kshelf, DWNSLP_deepK(n,bi,bj)-kshelf,
                0154      &                   DWNSLP_Transp(n,bi,bj)
                0155         ENDIF
                0156        ENDDO
                0157        WRITE(DWNSLP_ioUnit,*)
bb79aa40f5 Jean*0158        _END_MASTER(myThid)
b6bbe8cccf Jean*0159       ENDIF
                0160
                0161 #ifdef ALLOW_DIAGNOSTICS
                0162       IF ( doDiagDwnSlpFlow ) THEN
                0163         CALL DIAGNOSTICS_FILL( uFlow, 'DSLPuFlw', 0,1,2,bi,bj,myThid )
                0164         CALL DIAGNOSTICS_FILL( vFlow, 'DSLPvFlw', 0,1,2,bi,bj,myThid )
                0165       ENDIF
                0166 #endif /* ALLOW_DIAGNOSTICS */
                0167
                0168 #endif /* ALLOW_DOWN_SLOPE */
                0169
                0170       RETURN
                0171       END