model/src/integr_continuity.F

C $Header: /u/gcmpack/MITgcm/model/src/integr_continuity.F,v 1.5 2003/10/09 04:19:18 edhill Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: INTEGR_CONTINUITY
C     !INTERFACE:
      SUBROUTINE INTEGR_CONTINUITY(
     I                             bi, bj, uFld, vFld,
     I                             myTime, myIter, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE INTEGR_CONTINUITY                                 
C     | o Integrate the continuity Eq : compute vertical velocity 
C     |   and free surface "r-anomaly" (etaN) to satisfy  
C     |   exactly the convervation of the Total Volume            
C     *==========================================================*
C     \ev

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

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     uFld    :: Zonal velocity ( m/s )
C     vFld    :: Meridional velocity ( m/s )
C     bi,bj   :: tile index
C     myTime  :: Current time in simulation
C     myIter  :: Current iteration number in simulation
C     myThid  :: Thread number for this instance of the routine.
      _RL myTime
      INTEGER myIter
      INTEGER myThid
      INTEGER bi,bj
      LOGICAL UpdateEtaN_EtaH
      _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) 

C     !LOCAL VARIABLES:
C     Local variables in common block

C     Local variables
C     i,j,k  :: Loop counters
C     uTrans :: Volume transports ( uVel.xA )
C     vTrans :: Volume transports ( vVel.yA )
C     hDivFlow :: Div. Barotropic Flow [transport unit m3/s]
      INTEGER i,j,k
      _RL uTrans(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
      _RL vTrans(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
      _RL hDivFlow(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
      _RL wSurf, facEmP
CEOP

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

#ifdef EXACT_CONSERV
      IF (exactConserv) THEN

C--   Compute the Divergence of The Barotropic Flow :

C-    Initialise 
      DO j=1-Oly,sNy+Oly
       DO i=1-Olx,sNx+Olx
         dEtaHdt(i,j,bi,bj) = 0. _d 0
         hDivFlow(i,j)      = 0. _d 0
         utrans(i,j)        = 0. _d 0
         vtrans(i,j)        = 0. _d 0
       ENDDO
      ENDDO

      DO k=1,Nr
       
C-    Calculate velocity field "volume transports" through tracer cell faces
        DO j=1,sNy+1
         DO i=1,sNx+1
          uTrans(i,j) = uFld(i,j,k,bi,bj)*_dyG(i,j,bi,bj)
     &                 *drF(k)*_hFacW(i,j,k,bi,bj)
          vTrans(i,j) = vFld(i,j,k,bi,bj)*_dxG(i,j,bi,bj)
     &                 *drF(k)*_hFacS(i,j,k,bi,bj)
         ENDDO
        ENDDO

C-    Integrate vertically the Horizontal Divergence 
        DO j=1,sNy
         DO i=1,sNx
           hDivFlow(i,j) = hDivFlow(i,j)
     &       +maskC(i,j,k,bi,bj)*( uTrans(i+1,j)-uTrans(i,j)
     &                            +vTrans(i,j+1)-vTrans(i,j) )
         ENDDO
        ENDDO

C-    End DO k=1,Nr
      ENDDO

C------------------------------------
       facEmP = 0.
       IF (useRealFreshWaterFlux) facEmP = convertEmP2rUnit
       IF ( myTime.EQ.startTime ) THEN
        IF (myTime.NE. 0. _d 0 .AND. useRealFreshWaterFlux) THEN
C     needs previous time-step value of E-P-R, that has not been loaded
C     and was not in pickup-file ; try to use etaN & etaH instead.
          DO j=1,sNy
           DO i=1,sNx
            dEtaHdt(i,j,bi,bj) =
     &                         (etaN(i,j,bi,bj)-etaH(i,j,bi,bj))
     &                        /(implicDiv2Dflow*deltaTfreesurf)
            PmEpR(i,j,bi,bj) = dEtaHdt(i,j,bi,bj)
     &                       + hDivFlow(i,j)*recip_rA(i,j,bi,bj)
            PmEpR(i,j,bi,bj) = PmEpR(i,j,bi,bj)/convertEmP2rUnit
           ENDDO
          ENDDO
        ELSE
         DO j=1,sNy
          DO i=1,sNx
            PmEpR(i,j,bi,bj) = 0. _d 0
            dEtaHdt(i,j,bi,bj) = -hDivFlow(i,j)*recip_rA(i,j,bi,bj)
          ENDDO
         ENDDO      
        ENDIF
       ELSE
         DO j=1,sNy
          DO i=1,sNx
            PmEpR(i,j,bi,bj) = -EmPmR(i,j,bi,bj)
            dEtaHdt(i,j,bi,bj) = -hDivFlow(i,j)*recip_rA(i,j,bi,bj)
     &                           -facEmP*EmPmR(i,j,bi,bj)
          ENDDO
         ENDDO
       ENDIF
C------------------------------------

      ENDIF

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

      IF (exactConserv .AND. myTime.NE.startTime) THEN
C--   Update etaN at the end of the time step : 
C     Incorporate the Implicit part of -Divergence(Barotropic_Flow)

       IF (implicDiv2Dflow.EQ. 0. _d 0) THEN
        DO j=1-Oly,sNy+Oly
         DO i=1-Olx,sNx+Olx
           etaN(i,j,bi,bj) = etaH(i,j,bi,bj) 
         ENDDO
        ENDDO
       ELSE
        DO j=1,sNy
         DO i=1,sNx
           etaN(i,j,bi,bj) = etaH(i,j,bi,bj)
     &      + implicDiv2Dflow*dEtaHdt(i,j,bi,bj)*deltaTfreesurf
         ENDDO
        ENDDO
       ENDIF

      ENDIF

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

#ifdef NONLIN_FRSURF
      IF (select_rStar .NE. 0) THEN
        DO j=1,sNy
         DO i=1,sNx
           rStarDhCDt(i,j,bi,bj) =
     &            dEtaHdt(i,j,bi,bj)*recip_Rcol(i,j,bi,bj)
         ENDDO
        ENDDO      
      ENDIF
#endif /* NONLIN_FRSURF */
#endif /* EXACT_CONSERV */

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

      DO k=Nr,1,-1
C--    Integrate continuity vertically for vertical velocity

       CALL INTEGRATE_FOR_W(
     I                       bi, bj, k, uFld, vFld,
     O                       wVel,
     I                       myThid )
 
#if ( defined EXACT_CONSERV && defined NONLIN_FRSURF ) 
       IF ( k.EQ.Nr .AND. myTime.NE. 0. _d 0 .AND.
     &      useRealFreshWaterFlux .AND. 
     &      buoyancyRelation .EQ. 'OCEANICP' ) THEN

          DO j=1,sNy
           DO i=1,sNx
             wVel(i,j,k,bi,bj) = wVel(i,j,k,bi,bj) 
     &         +convertEmP2rUnit*PmEpR(i,j,bi,bj)*maskC(i,j,k,bi,bj)
           ENDDO
          ENDDO

       ENDIF
#endif /* EXACT_CONSERV & NONLIN_FRSURF */

#ifdef ALLOW_OBCS
#ifdef ALLOW_NONHYDROSTATIC
C--    Apply OBC to W if in N-H mode
       IF (useOBCS.AND.nonHydrostatic) THEN
          CALL OBCS_APPLY_W( bi, bj, k, wVel, myThid )
        ENDIF
#endif /* ALLOW_NONHYDROSTATIC */
#endif /* ALLOW_OBCS */            

C-    End DO k=Nr,1,-1
      ENDDO

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

      RETURN
      END
1	jmc	1.6	C $Header: /u/gcmpack/MITgcm/model/src/integr_continuity.F,v 1.5 2003/10/09 04:19:18 edhill Exp $
2	jmc	1.1	C $Name: $
3
4	edhill	1.5	#include "PACKAGES_CONFIG.h"
5	jmc	1.1	#include "CPP_OPTIONS.h"
6
7			CBOP
8			C !ROUTINE: INTEGR_CONTINUITY
9			C !INTERFACE:
10			SUBROUTINE INTEGR_CONTINUITY(
11			I bi, bj, uFld, vFld,
12			I myTime, myIter, myThid )
13			C !DESCRIPTION: \bv
14			C ==========================================================
15			C \| SUBROUTINE INTEGR_CONTINUITY
16			C \| o Integrate the continuity Eq : compute vertical velocity
17			C \| and free surface "r-anomaly" (etaN) to satisfy
18			C \| exactly the convervation of the Total Volume
19			C ==========================================================
20			C \ev
21
22			C !USES:
23			IMPLICIT NONE
24			C == Global variables
25			#include "SIZE.h"
26			#include "EEPARAMS.h"
27			#include "PARAMS.h"
28			#include "DYNVARS.h"
29			#include "GRID.h"
30			#include "SURFACE.h"
31			#include "FFIELDS.h"
32
33			C !INPUT/OUTPUT PARAMETERS:
34			C == Routine arguments ==
35			C uFld :: Zonal velocity ( m/s )
36			C vFld :: Meridional velocity ( m/s )
37			C bi,bj :: tile index
38			C myTime :: Current time in simulation
39			C myIter :: Current iteration number in simulation
40			C myThid :: Thread number for this instance of the routine.
41			_RL myTime
42			INTEGER myIter
43			INTEGER myThid
44			INTEGER bi,bj
45			LOGICAL UpdateEtaN_EtaH
46			_RL uFld(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
47			_RL vFld(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
48
49			C !LOCAL VARIABLES:
50			C Local variables in common block
51
52			C Local variables
53			C i,j,k :: Loop counters
54			C uTrans :: Volume transports ( uVel.xA )
55			C vTrans :: Volume transports ( vVel.yA )
56	jmc	1.6	C hDivFlow :: Div. Barotropic Flow [transport unit m3/s]
57	jmc	1.1	INTEGER i,j,k
58			_RL uTrans(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
59			_RL vTrans(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
60	jmc	1.6	_RL hDivFlow(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
61	jmc	1.3	_RL wSurf, facEmP
62	jmc	1.1	CEOP
63
64			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
65
66			#ifdef EXACT_CONSERV
67			IF (exactConserv) THEN
68
69			C-- Compute the Divergence of The Barotropic Flow :
70
71			C- Initialise
72			DO j=1-Oly,sNy+Oly
73			DO i=1-Olx,sNx+Olx
74	jmc	1.6	dEtaHdt(i,j,bi,bj) = 0. _d 0
75			hDivFlow(i,j) = 0. _d 0
76			utrans(i,j) = 0. _d 0
77			vtrans(i,j) = 0. _d 0
78	jmc	1.1	ENDDO
79			ENDDO
80
81			DO k=1,Nr
82
83			C- Calculate velocity field "volume transports" through tracer cell faces
84			DO j=1,sNy+1
85			DO i=1,sNx+1
86			uTrans(i,j) = uFld(i,j,k,bi,bj)*_dyG(i,j,bi,bj)
87			& drF(k)_hFacW(i,j,k,bi,bj)
88			vTrans(i,j) = vFld(i,j,k,bi,bj)*_dxG(i,j,bi,bj)
89			& drF(k)_hFacS(i,j,k,bi,bj)
90			ENDDO
91			ENDDO
92
93			C- Integrate vertically the Horizontal Divergence
94			DO j=1,sNy
95			DO i=1,sNx
96	jmc	1.6	hDivFlow(i,j) = hDivFlow(i,j)
97	jmc	1.1	& +maskC(i,j,k,bi,bj)*( uTrans(i+1,j)-uTrans(i,j)
98			& +vTrans(i,j+1)-vTrans(i,j) )
99			ENDDO
100			ENDDO
101
102			C- End DO k=1,Nr
103			ENDDO
104
105	jmc	1.6	C------------------------------------
106			facEmP = 0.
107			IF (useRealFreshWaterFlux) facEmP = convertEmP2rUnit
108			IF ( myTime.EQ.startTime ) THEN
109			IF (myTime.NE. 0. _d 0 .AND. useRealFreshWaterFlux) THEN
110			C needs previous time-step value of E-P-R, that has not been loaded
111			C and was not in pickup-file ; try to use etaN & etaH instead.
112			DO j=1,sNy
113			DO i=1,sNx
114			dEtaHdt(i,j,bi,bj) =
115			& (etaN(i,j,bi,bj)-etaH(i,j,bi,bj))
116			& /(implicDiv2Dflow*deltaTfreesurf)
117			PmEpR(i,j,bi,bj) = dEtaHdt(i,j,bi,bj)
118			& + hDivFlow(i,j)*recip_rA(i,j,bi,bj)
119			PmEpR(i,j,bi,bj) = PmEpR(i,j,bi,bj)/convertEmP2rUnit
120			ENDDO
121			ENDDO
122			ELSE
123			DO j=1,sNy
124			DO i=1,sNx
125			PmEpR(i,j,bi,bj) = 0. _d 0
126			dEtaHdt(i,j,bi,bj) = -hDivFlow(i,j)*recip_rA(i,j,bi,bj)
127			ENDDO
128			ENDDO
129			ENDIF
130			ELSE
131			DO j=1,sNy
132			DO i=1,sNx
133			PmEpR(i,j,bi,bj) = -EmPmR(i,j,bi,bj)
134			dEtaHdt(i,j,bi,bj) = -hDivFlow(i,j)*recip_rA(i,j,bi,bj)
135			& -facEmP*EmPmR(i,j,bi,bj)
136			ENDDO
137			ENDDO
138			ENDIF
139			C------------------------------------
140
141	jmc	1.1	ENDIF
142
143			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
144
145			IF (exactConserv .AND. myTime.NE.startTime) THEN
146			C-- Update etaN at the end of the time step :
147			C Incorporate the Implicit part of -Divergence(Barotropic_Flow)
148
149			IF (implicDiv2Dflow.EQ. 0. _d 0) THEN
150			DO j=1-Oly,sNy+Oly
151			DO i=1-Olx,sNx+Olx
152			etaN(i,j,bi,bj) = etaH(i,j,bi,bj)
153			ENDDO
154			ENDDO
155			ELSE
156			DO j=1,sNy
157			DO i=1,sNx
158			etaN(i,j,bi,bj) = etaH(i,j,bi,bj)
159	jmc	1.6	& + implicDiv2DflowdEtaHdt(i,j,bi,bj)deltaTfreesurf
160	jmc	1.1	ENDDO
161			ENDDO
162			ENDIF
163
164			ENDIF
165	jmc	1.3
166			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
167
168			#ifdef NONLIN_FRSURF
169			IF (select_rStar .NE. 0) THEN
170	jmc	1.6	DO j=1,sNy
171			DO i=1,sNx
172			rStarDhCDt(i,j,bi,bj) =
173			& dEtaHdt(i,j,bi,bj)*recip_Rcol(i,j,bi,bj)
174	jmc	1.3	ENDDO
175	jmc	1.6	ENDDO
176	jmc	1.3	ENDIF
177			#endif /* NONLIN_FRSURF */
178	jmc	1.4	#endif /* EXACT_CONSERV */
179	jmc	1.1
180			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
181
182			DO k=Nr,1,-1
183			C-- Integrate continuity vertically for vertical velocity
184
185			CALL INTEGRATE_FOR_W(
186			I bi, bj, k, uFld, vFld,
187			O wVel,
188			I myThid )
189
190	jmc	1.4	#if ( defined EXACT_CONSERV && defined NONLIN_FRSURF )
191	jmc	1.2	IF ( k.EQ.Nr .AND. myTime.NE. 0. _d 0 .AND.
192			& useRealFreshWaterFlux .AND.
193			& buoyancyRelation .EQ. 'OCEANICP' ) THEN
194
195			DO j=1,sNy
196			DO i=1,sNx
197			wVel(i,j,k,bi,bj) = wVel(i,j,k,bi,bj)
198	jmc	1.6	& +convertEmP2rUnitPmEpR(i,j,bi,bj)maskC(i,j,k,bi,bj)
199	jmc	1.2	ENDDO
200			ENDDO
201
202			ENDIF
203	jmc	1.4	#endif /* EXACT_CONSERV & NONLIN_FRSURF */
204	jmc	1.2
205	jmc	1.1	#ifdef ALLOW_OBCS
206			#ifdef ALLOW_NONHYDROSTATIC
207			C-- Apply OBC to W if in N-H mode
208			IF (useOBCS.AND.nonHydrostatic) THEN
209			CALL OBCS_APPLY_W( bi, bj, k, wVel, myThid )
210			ENDIF
211			#endif /* ALLOW_NONHYDROSTATIC */
212			#endif /* ALLOW_OBCS */
213
214			C- End DO k=Nr,1,-1
215			ENDDO
216
217			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
218
219			RETURN
220			END