pkg/down_slope/dwnslp_calc_flow.F

C $Header: /u/gcmpack/MITgcm/pkg/down_slope/dwnslp_calc_flow.F,v 1.2 2008/09/22 17:57:05 jmc Exp $
C $Name:  $

#include "DWNSLP_OPTIONS.h"

CBOP
C     !ROUTINE: DWNSLP_CALC_FLOW
C     !INTERFACE:
      SUBROUTINE DWNSLP_CALC_FLOW(
     I                             bi, bj, kBottom, rho3d,
     I                             myTime, myIter, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE DWNSLP_CALC_FLOW
C     | o Detect active site of Down-Sloping flow and compute
C     |   the corresponding volume transport
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"

C     !INPUT/OUTPUT PARAMETERS:
C     === Routine arguments ===
C     bi,bj     :: Tile indices
C     kBottom   :: Vertical index of bottom grid cell.
C     rho3d     :: In-situ density [kg/m3] computed at z=rC ;
C     myTime    :: Current time in simulation
C     myIter    :: Current time-step number
C     myThid    :: my Thread Id number
      INTEGER bi, bj
      INTEGER kBottom( xySize, nSx,nSy )
      _RL     rho3d  ( xySize, Nr,nSx,nSy )
      _RL     myTime
      INTEGER myIter, myThid

#ifdef ALLOW_DOWN_SLOPE

C     !LOCAL VARIABLES:
C     === Local variables ===
C     msgBuf     :: Informational/error message buffer
C     ijd     :: horiz. index of deep water column receiving dense water flow
C     ijs     :: horiz. index of shallow water column (e.g. shelf)
C                from which dense water flow originates
c     CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER k
      INTEGER n, ijd, ijr, ijs
      INTEGER kdeep, ishelf, jshelf, kshelf
      _RL     dRhoH
      INTEGER downward
#ifdef ALLOW_DIAGNOSTICS
      LOGICAL doDiagDwnSlpFlow
      INTEGER ij
      _RL     sgnFac
      _RL     uFlow( xySize )
      _RL     vFlow( xySize )
C-    Functions:
      LOGICAL  DIAGNOSTICS_IS_ON
      EXTERNAL DIAGNOSTICS_IS_ON
#endif /* ALLOW_DIAGNOSTICS */

CEOP

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

c     downward = rkSign*NINT(gravitySign)
      downward = 1
      IF ( usingPCoords ) downward = -1

#ifdef ALLOW_DIAGNOSTICS
      IF ( useDiagnostics ) THEN
        doDiagDwnSlpFlow = DIAGNOSTICS_IS_ON( 'DSLPuFlw', myThid )
     &                .OR. DIAGNOSTICS_IS_ON( 'DSLPvFlw', myThid )
        IF ( doDiagDwnSlpFlow ) THEN
          DO ij=1,xySize
           uFlow(ij) = 0. _d 0
           vFlow(ij) = 0. _d 0
          ENDDO
        ENDIF
      ELSE
        doDiagDwnSlpFlow = .FALSE.
      ENDIF
#endif /* ALLOW_DIAGNOSTICS */

      DO n=1,DWNSLP_NbSite(bi,bj)
        DWNSLP_deepK(n,bi,bj) = 0

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

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

        dRhoH = rho3d(ijs,kshelf,bi,bj)
     &         -rho3d(ijd,kshelf,bi,bj)
c       IF ( dRhoH.GT.0. _d 0 ) THEN
        IF ( rho3d(ijs,kshelf+1,bi,bj).GT.rho3d(ijd,kshelf+1,bi,bj)
     &    .AND. dRhoH.GT.0. _d 0 ) THEN

C- search for deepest level where Rho_shelf > Rho_deep
          kdeep = kshelf
          DO k=kshelf+1,kBottom(ijd,bi,bj),downward
           IF ( rho3d(ijs,k,bi,bj).GT.rho3d(ijd,k,bi,bj) ) kdeep = k
          ENDDO
          DWNSLP_deepK(n,bi,bj) = kdeep

C- Compute the Volume Transport :
C- same formulation as described in the paper:
c         downslpFlow  = DWNSLP_gamma/mu *gravity*dRhoH*recip_rhoConst
C    with DWNSLP_Gamma = slope * effective cross-section area
          DWNSLP_Transp(n,bi,bj) = DWNSLP_Gamma(n,bi,bj)
     &             *DWNSLP_rec_mu*gravity*dRhoH*recip_rhoConst

#ifdef ALLOW_DIAGNOSTICS
          IF ( doDiagDwnSlpFlow ) THEN
            ij = MAX( ijd, ijs )
            sgnFac = SIGN(1,-ijr)
            IF ( ABS(ijr).EQ.1 ) THEN
             uFlow(ij) = sgnFac*DWNSLP_Transp(n,bi,bj)
            ELSE
             vFlow(ij) = sgnFac*DWNSLP_Transp(n,bi,bj)
            ENDIF
          ENDIF
#endif /* ALLOW_DIAGNOSTICS */

        ENDIF

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

      IF (debugMode) THEN
       WRITE(DWNSLP_ioUnit,'(A,I8,2I4)')
     &      ' DWNSLP_CALC_FLOW: iter,bi,bj=',myIter,bi,bj
       WRITE(DWNSLP_ioUnit,'(A)')
     &   '  bi  bj     n :     ijd   ijr  is  js ;  ks kd-s Transp :'
       DO n=1,DWNSLP_NbSite(bi,bj)
        IF (DWNSLP_deepK(n,bi,bj).NE.0) THEN
         ijs = DWNSLP_ijDeep(n,bi,bj) + DWNSLP_shVsD(n,bi,bj)
         ishelf = 1-OLx + mod(ijs-1,xSize)
         jshelf = 1-OLy + (ijs-1)/xSize
         kshelf = kBottom(ijs,bi,bj)
         WRITE(DWNSLP_ioUnit,'(2I4,I6,A,I8,I6,2I4,A,2I4,1PE14.6)')
     &     bi,bj,n,' :', DWNSLP_ijDeep(n,bi,bj),
     &                   DWNSLP_shVsD(n,bi,bj), ishelf,jshelf,
     &             ' ;', kshelf, DWNSLP_deepK(n,bi,bj)-kshelf,
     &                   DWNSLP_Transp(n,bi,bj)
        ENDIF
       ENDDO
       WRITE(DWNSLP_ioUnit,*)
      ENDIF

#ifdef ALLOW_DIAGNOSTICS
      IF ( doDiagDwnSlpFlow ) THEN
        CALL DIAGNOSTICS_FILL( uFlow, 'DSLPuFlw', 0,1,2,bi,bj,myThid )
        CALL DIAGNOSTICS_FILL( vFlow, 'DSLPvFlw', 0,1,2,bi,bj,myThid )
      ENDIF
#endif /* ALLOW_DIAGNOSTICS */

#endif /* ALLOW_DOWN_SLOPE */

      RETURN
      END
1	jmc	1.3	C $Header: /u/gcmpack/MITgcm/pkg/down_slope/dwnslp_calc_flow.F,v 1.2 2008/09/22 17:57:05 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "DWNSLP_OPTIONS.h"
5
6			CBOP
7			C !ROUTINE: DWNSLP_CALC_FLOW
8			C !INTERFACE:
9			SUBROUTINE DWNSLP_CALC_FLOW(
10	jmc	1.2	I bi, bj, kBottom, rho3d,
11	jmc	1.1	I myTime, myIter, myThid )
12			C !DESCRIPTION: \bv
13			C ==========================================================
14			C \| SUBROUTINE DWNSLP_CALC_FLOW
15			C \| o Detect active site of Down-Sloping flow and compute
16			C \| the corresponding volume transport
17			C ==========================================================
18			C \ev
19
20			C !USES:
21			IMPLICIT NONE
22
23			C === Global variables ===
24			#include "SIZE.h"
25			#include "EEPARAMS.h"
26			#include "PARAMS.h"
27			#include "DWNSLP_SIZE.h"
28			#include "DWNSLP_PARAMS.h"
29			#include "DWNSLP_VARS.h"
30
31			C !INPUT/OUTPUT PARAMETERS:
32			C === Routine arguments ===
33			C bi,bj :: Tile indices
34			C kBottom :: Vertical index of bottom grid cell.
35	jmc	1.2	C rho3d :: In-situ density [kg/m3] computed at z=rC ;
36	jmc	1.1	C myTime :: Current time in simulation
37			C myIter :: Current time-step number
38			C myThid :: my Thread Id number
39			INTEGER bi, bj
40	jmc	1.2	INTEGER kBottom( xySize, nSx,nSy )
41			_RL rho3d ( xySize, Nr,nSx,nSy )
42	jmc	1.1	_RL myTime
43			INTEGER myIter, myThid
44
45			#ifdef ALLOW_DOWN_SLOPE
46
47			C !LOCAL VARIABLES:
48			C === Local variables ===
49	jmc	1.3	C msgBuf :: Informational/error message buffer
50	jmc	1.1	C ijd :: horiz. index of deep water column receiving dense water flow
51			C ijs :: horiz. index of shallow water column (e.g. shelf)
52			C from which dense water flow originates
53			c CHARACTER*(MAX_LEN_MBUF) msgBuf
54			INTEGER k
55			INTEGER n, ijd, ijr, ijs
56			INTEGER kdeep, ishelf, jshelf, kshelf
57			_RL dRhoH
58			INTEGER downward
59			#ifdef ALLOW_DIAGNOSTICS
60			LOGICAL doDiagDwnSlpFlow
61			INTEGER ij
62			_RL sgnFac
63			_RL uFlow( xySize )
64			_RL vFlow( xySize )
65			C- Functions:
66			LOGICAL DIAGNOSTICS_IS_ON
67			EXTERNAL DIAGNOSTICS_IS_ON
68			#endif /* ALLOW_DIAGNOSTICS */
69
70			CEOP
71
72			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
73
74			c downward = rkSign*NINT(gravitySign)
75			downward = 1
76			IF ( usingPCoords ) downward = -1
77
78			#ifdef ALLOW_DIAGNOSTICS
79			IF ( useDiagnostics ) THEN
80			doDiagDwnSlpFlow = DIAGNOSTICS_IS_ON( 'DSLPuFlw', myThid )
81			& .OR. DIAGNOSTICS_IS_ON( 'DSLPvFlw', myThid )
82			IF ( doDiagDwnSlpFlow ) THEN
83			DO ij=1,xySize
84			uFlow(ij) = 0. _d 0
85			vFlow(ij) = 0. _d 0
86			ENDDO
87			ENDIF
88			ELSE
89			doDiagDwnSlpFlow = .FALSE.
90			ENDIF
91			#endif /* ALLOW_DIAGNOSTICS */
92
93			DO n=1,DWNSLP_NbSite(bi,bj)
94			DWNSLP_deepK(n,bi,bj) = 0
95
96	jmc	1.3	C- detect density gradient along the slope => Downsloping flow
97	jmc	1.1
98			ijd = DWNSLP_ijDeep(n,bi,bj)
99			ijr = DWNSLP_shVsD(n,bi,bj)
100			ijs = ijd + ijr
101			kshelf = kBottom(ijs,bi,bj)
102
103	jmc	1.2	dRhoH = rho3d(ijs,kshelf,bi,bj)
104			& -rho3d(ijd,kshelf,bi,bj)
105	jmc	1.1	c IF ( dRhoH.GT.0. _d 0 ) THEN
106	jmc	1.2	IF ( rho3d(ijs,kshelf+1,bi,bj).GT.rho3d(ijd,kshelf+1,bi,bj)
107	jmc	1.1	& .AND. dRhoH.GT.0. _d 0 ) THEN
108
109			C- search for deepest level where Rho_shelf > Rho_deep
110			kdeep = kshelf
111			DO k=kshelf+1,kBottom(ijd,bi,bj),downward
112	jmc	1.2	IF ( rho3d(ijs,k,bi,bj).GT.rho3d(ijd,k,bi,bj) ) kdeep = k
113	jmc	1.1	ENDDO
114			DWNSLP_deepK(n,bi,bj) = kdeep
115
116			C- Compute the Volume Transport :
117			C- same formulation as described in the paper:
118			c downslpFlow = DWNSLP_gamma/mu gravitydRhoH*recip_rhoConst
119			C with DWNSLP_Gamma = slope * effective cross-section area
120			DWNSLP_Transp(n,bi,bj) = DWNSLP_Gamma(n,bi,bj)
121			& DWNSLP_rec_mugravitydRhoHrecip_rhoConst
122
123			#ifdef ALLOW_DIAGNOSTICS
124			IF ( doDiagDwnSlpFlow ) THEN
125			ij = MAX( ijd, ijs )
126			sgnFac = SIGN(1,-ijr)
127			IF ( ABS(ijr).EQ.1 ) THEN
128			uFlow(ij) = sgnFac*DWNSLP_Transp(n,bi,bj)
129			ELSE
130			vFlow(ij) = sgnFac*DWNSLP_Transp(n,bi,bj)
131			ENDIF
132			ENDIF
133			#endif /* ALLOW_DIAGNOSTICS */
134
135			ENDIF
136
137			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
138			ENDDO
139
140			IF (debugMode) THEN
141			WRITE(DWNSLP_ioUnit,'(A,I8,2I4)')
142			& ' DWNSLP_CALC_FLOW: iter,bi,bj=',myIter,bi,bj
143			WRITE(DWNSLP_ioUnit,'(A)')
144			& ' bi bj n : ijd ijr is js ; ks kd-s Transp :'
145			DO n=1,DWNSLP_NbSite(bi,bj)
146			IF (DWNSLP_deepK(n,bi,bj).NE.0) THEN
147			ijs = DWNSLP_ijDeep(n,bi,bj) + DWNSLP_shVsD(n,bi,bj)
148			ishelf = 1-OLx + mod(ijs-1,xSize)
149			jshelf = 1-OLy + (ijs-1)/xSize
150			kshelf = kBottom(ijs,bi,bj)
151			WRITE(DWNSLP_ioUnit,'(2I4,I6,A,I8,I6,2I4,A,2I4,1PE14.6)')
152			& bi,bj,n,' :', DWNSLP_ijDeep(n,bi,bj),
153			& DWNSLP_shVsD(n,bi,bj), ishelf,jshelf,
154			& ' ;', kshelf, DWNSLP_deepK(n,bi,bj)-kshelf,
155			& DWNSLP_Transp(n,bi,bj)
156			ENDIF
157			ENDDO
158			WRITE(DWNSLP_ioUnit,*)
159			ENDIF
160
161			#ifdef ALLOW_DIAGNOSTICS
162			IF ( doDiagDwnSlpFlow ) THEN
163			CALL DIAGNOSTICS_FILL( uFlow, 'DSLPuFlw', 0,1,2,bi,bj,myThid )
164			CALL DIAGNOSTICS_FILL( vFlow, 'DSLPvFlw', 0,1,2,bi,bj,myThid )
165			ENDIF
166			#endif /* ALLOW_DIAGNOSTICS */
167
168			#endif /* ALLOW_DOWN_SLOPE */
169
170			RETURN
171			END