Back to home page

MITgcm

 
 

    


File indexing completed on 2024-01-13 06:10:33 UTC

view on githubraw file Latest commit 005af54e on 2024-01-12 20:10:27 UTC
20c0bcbffa Jean*0001 #include "OBCS_OPTIONS.h"
                0002 
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: OBCS_BALANCE_FLOW
                0006 
                0007 C     !INTERFACE:
                0008       SUBROUTINE OBCS_BALANCE_FLOW( myTime, myIter, myThid )
                0009 
                0010 C     !DESCRIPTION:
                0011 C     *==========================================================*
                0012 C     | SUBROUTINE OBCS_BALANCE_FLOW
                0013 C     | o Modify OB normal flow to ensure no net inflow
                0014 C     *==========================================================*
                0015 
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018 
                0019 C     === Global variables ===
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "GRID.h"
9b4f2a04e2 Jean*0024 #include "OBCS_PARAMS.h"
                0025 #include "OBCS_GRID.h"
                0026 #include "OBCS_FIELDS.h"
abfe198bce Mart*0027 #include "FFIELDS.h"
                0028 
20c0bcbffa Jean*0029 C     !INPUT/OUTPUT PARAMETERS:
                0030       _RL myTime
                0031       INTEGER myIter
                0032       INTEGER myThid
                0033 CEOP
                0034 
                0035 #ifdef ALLOW_OBCS
                0036 #ifdef ALLOW_OBCS_BALANCE
                0037 
                0038 C     !FUNCTIONS:
                0039 
                0040 C     !LOCAL VARIABLES:
                0041 C     bi, bj       :: tile indices
                0042 C     i,j,k        :: loop indices
                0043 C     iB, jB       :: local index of open boundary
                0044 C     msgBuf       :: Informational/error message buffer
                0045       INTEGER bi, bj
005af54e38 Jean*0046       INTEGER i, j, k
                0047 #if (defined ALLOW_OBCS_EAST ) || (defined ALLOW_OBCS_WEST )
                0048       INTEGER iB
                0049 #endif
                0050 #if (defined ALLOW_OBCS_NORTH) || (defined ALLOW_OBCS_SOUTH)
                0051       INTEGER jB
                0052 #endif
20c0bcbffa Jean*0053       CHARACTER*(MAX_LEN_MBUF) msgBuf
005af54e38 Jean*0054       _RL areaOB, tmpA
20c0bcbffa Jean*0055       _RL inFlow, flowE, flowW, flowN, flowS
                0056       _RL tileArea(nSx,nSy)
                0057       _RL tileFlow(nSx,nSy)
                0058       _RL tileAreaOB(nSx,nSy)
                0059       _RL tileInFlow(nSx,nSy)
                0060       LOGICAL flag
abfe198bce Mart*0061       _RL netFreshWaterFlux
                0062       _RL shelfIceNetMassFlux
005af54e38 Jean*0063 #ifdef ALLOW_OBCS_EAST
                0064       _RL areaE
                0065 #endif
                0066 #ifdef ALLOW_OBCS_WEST
                0067       _RL areaW
                0068 #endif
                0069 #ifdef ALLOW_OBCS_NORTH
                0070       _RL areaN
                0071 #endif
                0072 #ifdef ALLOW_OBCS_SOUTH
                0073       _RL areaS
                0074 #endif
20c0bcbffa Jean*0075 
                0076 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0077 C-- Old method (OBCS_balanceFac < 0): balance each OB separately
                0078 C-- New method applies to all OB with BCS_balanceFac >=0 :
                0079 C      ensure that the net inflow through all OB is balanced by correcting
                0080 C      each OB normal flow with a uniform velocity, using the corresponding
                0081 C      weight factor OBCS_balanceFac.
abfe198bce Mart*0082 C  e.g., OBCS_balanceFacE,W,N,S= 1, -1, 2, 0 :
20c0bcbffa Jean*0083 C      => correct Western OBWu (by substracting a uniform velocity) to ensure
                0084 C         zero net transport through Western OB
                0085 C      => correct Eastern and Northern normal flow (twice larger Northern
                0086 C         velocity correction than Eastern correction) to ensure that
                0087 C         the total inflow through E+N+S OB is balanced
                0088 
                0089 #ifdef ALLOW_DEBUG
                0090       IF (debugMode) CALL DEBUG_ENTER('OBCS_BALANCE_FLOW',myThid)
                0091 #endif
                0092 
                0093 C--   Integrate the transport through each OB
                0094       flag = .FALSE.
                0095       areaOB = 0. _d 0
                0096       inFlow = 0. _d 0
                0097       DO bj=myByLo(myThid),myByHi(myThid)
                0098        DO bi=myBxLo(myThid),myBxHi(myThid)
                0099         tileAreaOB(bi,bj) = 0.
                0100         tileInFlow(bi,bj) = 0.
                0101        ENDDO
                0102       ENDDO
                0103 
                0104 #ifdef ALLOW_OBCS_EAST
                0105       areaE = 0. _d 0
                0106       flowE = 0. _d 0
                0107       flag = flag .OR. ( OBCS_balanceFacE.GT.0. )
                0108       DO bj=myByLo(myThid),myByHi(myThid)
                0109        DO bi=myBxLo(myThid),myBxHi(myThid)
                0110         tileArea(bi,bj) = 0.
                0111         tileFlow(bi,bj) = 0.
                0112         IF ( tileHasOBE(bi,bj) ) THEN
                0113          DO k=1,Nr
                0114           DO j=1,sNy
                0115            iB = OB_Ie(j,bi,bj)
838c7f9401 Jean*0116 C-    If 1 OB location is on 2 tiles (@ edge of 2 tiles), select the one which
                0117 C     communicates with tile interior (sNx+1) rather than with halo region (i=1)
                0118            IF ( iB.NE.OB_indexNone .AND. iB.GT.1 ) THEN
f441182300 Jean*0119             tmpA = drF(k)*hFacW(iB,j,k,bi,bj)*dyG(iB,j,bi,bj)
                0120      &                   *maskInW(iB,j,bi,bj)
47f36df0c2 Jean*0121             tileArea(bi,bj) = tileArea(bi,bj) + tmpA
                0122             tileFlow(bi,bj) = tileFlow(bi,bj) + tmpA*OBEu(j,k,bi,bj)
20c0bcbffa Jean*0123            ENDIF
                0124           ENDDO
                0125          ENDDO
                0126          IF ( OBCS_balanceFacE.GE.0. ) THEN
                0127            tileInFlow(bi,bj) = tileInFlow(bi,bj) - tileFlow(bi,bj)
                0128            tileAreaOB(bi,bj) = tileAreaOB(bi,bj)
                0129      &                       + tileArea(bi,bj)*OBCS_balanceFacE
                0130          ENDIF
                0131          areaE = areaE + tileArea(bi,bj)
                0132          flowE = flowE + tileFlow(bi,bj)
                0133         ENDIF
                0134        ENDDO
                0135       ENDDO
                0136 c     WRITE(standardMessageUnit,'(A,I9,1P2E16.8)')
                0137 c    &   'OBCS_balance it,areaE,flowE=', myIter, areaE, flowE
                0138       IF ( OBCS_balanceFacE.LT.0. ) THEN
                0139         CALL GLOBAL_SUM_TILE_RL( tileArea, areaE, myThid )
                0140         IF ( areaE.GT.0. ) THEN
                0141           CALL GLOBAL_SUM_TILE_RL( tileFlow, flowE, myThid )
8830b8f970 Jean*0142           IF ( debugLevel.GE.debLevC ) THEN
20c0bcbffa Jean*0143             WRITE(msgBuf,'(A,I9,A,1P2E16.8)') 'OBCS_balance (it=',
                0144      &            myIter, ' ) correct OBEu:', flowE, -flowE/areaE
                0145             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0146      &                          SQUEEZE_RIGHT, myThid )
                0147           ENDIF
                0148           flowE = -flowE/areaE
                0149         ENDIF
                0150       ENDIF
                0151 #endif /* ALLOW_OBCS_EAST */
                0152 
                0153 #ifdef ALLOW_OBCS_WEST
                0154       areaW = 0. _d 0
                0155       flowW = 0. _d 0
                0156       flag = flag .OR. ( OBCS_balanceFacW.GT.0. )
                0157       DO bj=myByLo(myThid),myByHi(myThid)
                0158        DO bi=myBxLo(myThid),myBxHi(myThid)
                0159         tileArea(bi,bj) = 0.
                0160         tileFlow(bi,bj) = 0.
                0161         IF ( tileHasOBW(bi,bj) ) THEN
                0162          DO k=1,Nr
                0163           DO j=1,sNy
                0164            iB = OB_Iw(j,bi,bj)
838c7f9401 Jean*0165 C-    If 1 OB location is on 2 tiles (@ edge of 2 tiles), select the one which
                0166 C     communicates with tile interior (i=0) rather than with halo region (i=sNx)
                0167            IF ( iB.NE.OB_indexNone .AND. iB.LT.sNx ) THEN
f441182300 Jean*0168             tmpA = drF(k)*hFacW(1+iB,j,k,bi,bj)*dyG(1+iB,j,bi,bj)
                0169      &                   *maskInW(1+iB,j,bi,bj)
47f36df0c2 Jean*0170             tileArea(bi,bj) = tileArea(bi,bj) + tmpA
                0171             tileFlow(bi,bj) = tileFlow(bi,bj) + tmpA*OBWu(j,k,bi,bj)
20c0bcbffa Jean*0172            ENDIF
                0173           ENDDO
                0174          ENDDO
                0175          IF ( OBCS_balanceFacW.GE.0. ) THEN
                0176            tileInFlow(bi,bj) = tileInFlow(bi,bj) + tileFlow(bi,bj)
                0177            tileAreaOB(bi,bj) = tileAreaOB(bi,bj)
                0178      &                       + tileArea(bi,bj)*OBCS_balanceFacW
                0179          ENDIF
                0180          areaW = areaW + tileArea(bi,bj)
                0181          flowW = flowW + tileFlow(bi,bj)
                0182         ENDIF
                0183        ENDDO
                0184       ENDDO
                0185 c     WRITE(standardMessageUnit,'(A,I9,1P2E16.8)')
                0186 c    &   'OBCS_balance it,areaW,flowW=', myIter, areaW, flowW
                0187       IF ( OBCS_balanceFacW.LT.0. ) THEN
                0188         CALL GLOBAL_SUM_TILE_RL( tileArea, areaW, myThid )
                0189         IF ( areaW.GT.0. ) THEN
                0190           CALL GLOBAL_SUM_TILE_RL( tileFlow, flowW, myThid )
8830b8f970 Jean*0191           IF ( debugLevel.GE.debLevC ) THEN
20c0bcbffa Jean*0192             WRITE(msgBuf,'(A,I9,A,1P2E16.8)') 'OBCS_balance (it=',
                0193      &            myIter, ' ) correct OBWu:', flowW, -flowW/areaW
                0194             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0195      &                          SQUEEZE_RIGHT, myThid )
                0196           ENDIF
                0197           flowW = -flowW/areaW
                0198         ENDIF
                0199       ENDIF
                0200 #endif /* ALLOW_OBCS_WEST */
                0201 
                0202 #ifdef ALLOW_OBCS_NORTH
                0203       areaN = 0. _d 0
                0204       flowN = 0. _d 0
                0205       flag = flag .OR. ( OBCS_balanceFacN.GT.0. )
                0206       DO bj=myByLo(myThid),myByHi(myThid)
                0207        DO bi=myBxLo(myThid),myBxHi(myThid)
                0208         tileArea(bi,bj) = 0.
                0209         tileFlow(bi,bj) = 0.
                0210         IF ( tileHasOBN(bi,bj) ) THEN
                0211          DO k=1,Nr
                0212           DO i=1,sNx
                0213            jB = OB_Jn(i,bi,bj)
838c7f9401 Jean*0214 C-    If 1 OB location is on 2 tiles (@ edge of 2 tiles), select the one which
                0215 C     communicates with tile interior (sNy+1) rather than with halo region (j=1)
                0216            IF ( jB.NE.OB_indexNone .AND. jB.GT.1 ) THEN
f441182300 Jean*0217             tmpA = drF(k)*hFacS(i,jB,k,bi,bj)*dxG(i,jB,bi,bj)
                0218      &                   *maskInS(i,jB,bi,bj)
47f36df0c2 Jean*0219             tileArea(bi,bj) = tileArea(bi,bj) + tmpA
                0220             tileFlow(bi,bj) = tileFlow(bi,bj) + tmpA*OBNv(i,k,bi,bj)
20c0bcbffa Jean*0221            ENDIF
                0222           ENDDO
                0223          ENDDO
                0224          IF ( OBCS_balanceFacN.GE.0. ) THEN
                0225            tileInFlow(bi,bj) = tileInFlow(bi,bj) - tileFlow(bi,bj)
                0226            tileAreaOB(bi,bj) = tileAreaOB(bi,bj)
                0227      &                       + tileArea(bi,bj)*OBCS_balanceFacN
                0228          ENDIF
                0229          areaN = areaN + tileArea(bi,bj)
                0230          flowN = flowN + tileFlow(bi,bj)
                0231         ENDIF
                0232        ENDDO
                0233       ENDDO
                0234 c     WRITE(standardMessageUnit,'(A,I9,1P2E16.8)')
                0235 c    &   'OBCS_balance it,areaN,flowN=', myIter, areaN, flowN
                0236       IF ( OBCS_balanceFacN.LT.0. ) THEN
                0237         CALL GLOBAL_SUM_TILE_RL( tileArea, areaN, myThid )
                0238         IF ( areaN.GT.0. ) THEN
                0239           CALL GLOBAL_SUM_TILE_RL( tileFlow, flowN, myThid )
8830b8f970 Jean*0240           IF ( debugLevel.GE.debLevC ) THEN
20c0bcbffa Jean*0241             WRITE(msgBuf,'(A,I9,A,1P2E16.8)') 'OBCS_balance (it=',
                0242      &            myIter, ' ) correct OBNv:', flowN, -flowN/areaN
                0243             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0244      &                          SQUEEZE_RIGHT, myThid )
                0245           ENDIF
                0246           flowN = -flowN/areaN
                0247         ENDIF
                0248       ENDIF
                0249 #endif /* ALLOW_OBCS_NORTH */
                0250 
                0251 #ifdef ALLOW_OBCS_SOUTH
                0252       areaS = 0. _d 0
                0253       flowS = 0. _d 0
                0254       flag = flag .OR. ( OBCS_balanceFacS.GT.0. )
                0255       DO bj=myByLo(myThid),myByHi(myThid)
                0256        DO bi=myBxLo(myThid),myBxHi(myThid)
                0257         tileArea(bi,bj) = 0.
                0258         tileFlow(bi,bj) = 0.
                0259         IF ( tileHasOBS(bi,bj) ) THEN
                0260          DO k=1,Nr
                0261           DO i=1,sNx
                0262            jB = OB_Js(i,bi,bj)
838c7f9401 Jean*0263 C-    If 1 OB location is on 2 tiles (@ edge of 2 tiles), select the one which
                0264 C     communicates with tile interior (j=0) rather than with halo region (j=sNy)
                0265            IF ( jB.NE.OB_indexNone .AND. jB.LT.sNy ) THEN
f441182300 Jean*0266             tmpA = drF(k)*hFacS(i,1+jB,k,bi,bj)*dxG(i,1+jB,bi,bj)
                0267      &                   *maskInS(i,1+jB,bi,bj)
47f36df0c2 Jean*0268             tileArea(bi,bj) = tileArea(bi,bj) + tmpA
                0269             tileFlow(bi,bj) = tileFlow(bi,bj) + tmpA*OBSv(i,k,bi,bj)
20c0bcbffa Jean*0270            ENDIF
                0271           ENDDO
                0272          ENDDO
                0273          IF ( OBCS_balanceFacS.GE.0. ) THEN
                0274            tileInFlow(bi,bj) = tileInFlow(bi,bj) + tileFlow(bi,bj)
                0275            tileAreaOB(bi,bj) = tileAreaOB(bi,bj)
                0276      &                       + tileArea(bi,bj)*OBCS_balanceFacS
                0277          ENDIF
                0278          areaS = areaS + tileArea(bi,bj)
                0279          flowS = flowS + tileFlow(bi,bj)
                0280         ENDIF
                0281        ENDDO
                0282       ENDDO
                0283 c     WRITE(standardMessageUnit,'(A,I9,1P2E16.8)')
                0284 c    &   'OBCS_balance it,areaS,flowS=', myIter, areaS, flowS
                0285       IF ( OBCS_balanceFacS.LT.0. ) THEN
                0286         CALL GLOBAL_SUM_TILE_RL( tileArea, areaS, myThid )
                0287         IF ( areaS.GT.0. ) THEN
                0288           CALL GLOBAL_SUM_TILE_RL( tileFlow, flowS, myThid )
8830b8f970 Jean*0289           IF ( debugLevel.GE.debLevC ) THEN
20c0bcbffa Jean*0290             WRITE(msgBuf,'(A,I9,A,1P2E16.8)') 'OBCS_balance (it=',
                0291      &            myIter, ' ) correct OBSv:', flowS, -flowS/areaS
                0292             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0293      &                          SQUEEZE_RIGHT, myThid )
                0294           ENDIF
                0295           flowS = -flowS/areaS
                0296         ENDIF
                0297       ENDIF
                0298 #endif /* ALLOW_OBCS_SOUTH */
                0299 
                0300 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
abfe198bce Mart*0301 C--   Calculate a flux throught the surface from the global change of etaH
                0302 C     to take into account both freshwater fluxes like precipitation and
                0303 C     displacement fluxes from advancing ice sheets or imported sea ice
                0304 
                0305       netFreshWaterFlux = 0. _d 0
                0306       shelfIceNetMassFlux = 0. _d 0
                0307       IF ( OBCSbalanceSurf ) THEN
                0308        DO bj=myByLo(myThid),myByHi(myThid)
                0309         DO bi=myBxLo(myThid),myBxHi(myThid)
                0310          tileFlow(bi,bj) = 0.
                0311          DO j=1,sNy
                0312           DO i=1,sNx
                0313            tileFlow(bi,bj) = tileFlow(bi,bj)
                0314      &          - EmPmR(i,j,bi,bj)
                0315      &          * _rA(i,j,bi,bj) * maskInC(i,j,bi,bj)
                0316           ENDDO
                0317          ENDDO
                0318         ENDDO
                0319        ENDDO
                0320        CALL GLOBAL_SUM_TILE_RL( tileFlow, netFreshWaterFlux, myThid )
                0321        IF ( debugLevel.GE.debLevC ) THEN
                0322         WRITE(msgBuf,'(A,I9,A,1P1E16.8)') 'OBCS_balance (it=',
                0323      &       myIter, ' ) correct for netFreshWaterFlux:',
                0324      &       netFreshWaterFlux
                0325         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0326      &       SQUEEZE_RIGHT, myThid )
                0327        ENDIF
                0328 #ifdef ALLOW_SHELFICE
                0329        IF ( useShelfIce ) THEN
                0330         CALL SHELFICE_NETMASSFLUX_SURF(
                0331      O                        shelfIceNetMassFlux,
                0332      I                        myTime, myIter, myThid )
                0333         IF ( debugLevel.GE.debLevC ) THEN
                0334          WRITE(msgBuf,'(A,I9,A,1P1E16.8)') 'OBCS_balance (it=',
                0335      &        myIter, ' ) correct for shelfIceNetMassFlux:',
                0336      &        shelfIceNetMassFlux
                0337          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0338      &        SQUEEZE_RIGHT, myThid )
                0339         ENDIF
                0340        ENDIF
                0341 #endif /* ALLOW_SHELFICE */
                0342       ENDIF
                0343 
                0344 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
20c0bcbffa Jean*0345 C--   Calculate a unique velocity correction for all (OBCS_balanceFac>0) OB
                0346 C     and correct each OB using corresponding weight factor OBCS_balanceFac
                0347 
                0348       IF ( flag ) CALL GLOBAL_SUM_TILE_RL( tileAreaOB, areaOB, myThid )
                0349       IF ( areaOB.GT.0. ) THEN
                0350         CALL GLOBAL_SUM_TILE_RL( tileInFlow, inFlow, myThid )
8830b8f970 Jean*0351         IF ( debugLevel.GE.debLevC ) THEN
20c0bcbffa Jean*0352           WRITE(msgBuf,'(A,I9,A,1P2E16.8)') 'OBCS_balance (it=',
                0353      &       myIter, ' ) correct for inFlow:', inFlow, inFlow/areaOB
                0354           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0355      &                        SQUEEZE_RIGHT, myThid )
                0356         ENDIF
abfe198bce Mart*0357         IF ( OBCSbalanceSurf ) THEN
                0358          inFlow = inFlow + netFreshWaterFlux*mass2rUnit
                0359 #ifdef ALLOW_SHELFICE
                0360          IF ( useShelfIce )
                0361      &        inFlow = inFlow + shelfIceNetMassFlux*mass2rUnit
                0362 #endif
                0363         ENDIF
20c0bcbffa Jean*0364         inFlow = inFlow / areaOB
                0365       ENDIF
                0366       IF ( OBCS_balanceFacE.GE.0. ) flowE =  inFlow*OBCS_balanceFacE
                0367       IF ( OBCS_balanceFacW.GE.0. ) flowW = -inFlow*OBCS_balanceFacW
                0368       IF ( OBCS_balanceFacN.GE.0. ) flowN =  inFlow*OBCS_balanceFacN
                0369       IF ( OBCS_balanceFacS.GE.0. ) flowS = -inFlow*OBCS_balanceFacS
                0370 
8830b8f970 Jean*0371       IF ( debugLevel.GE.debLevC  .AND. areaOB.GT.0. ) THEN
20c0bcbffa Jean*0372           WRITE(msgBuf,'(A,1P2E16.8)')
                0373      &     'OBCS_balance correction to OBEu,OBWu:', flowE, flowW
                0374           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0375      &                        SQUEEZE_RIGHT, myThid )
                0376           WRITE(msgBuf,'(A,1P2E16.8)')
                0377      &     'OBCS_balance correction to OBNv,OBSv:', flowN, flowS
                0378           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0379      &                        SQUEEZE_RIGHT, myThid )
                0380       ENDIF
                0381 
                0382 c     IF ( .NOT.useOBCSbalance ) RETURN
                0383 
                0384 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0385 C--   Add correction:
                0386 
                0387 #ifdef ALLOW_OBCS_EAST
                0388       IF ( OBCS_balanceFacE.NE.0. ) THEN
                0389        DO bj=myByLo(myThid),myByHi(myThid)
                0390         DO bi=myBxLo(myThid),myBxHi(myThid)
                0391          IF ( tileHasOBE(bi,bj) ) THEN
                0392           DO k=1,Nr
838c7f9401 Jean*0393            DO j=1-OLy,sNy+OLy
20c0bcbffa Jean*0394             iB = OB_Ie(j,bi,bj)
838c7f9401 Jean*0395             IF ( iB.NE.OB_indexNone ) THEN
20c0bcbffa Jean*0396              OBEu(j,k,bi,bj) = OBEu(j,k,bi,bj)
                0397      &                       + flowE*maskW(iB,j,k,bi,bj)
                0398             ENDIF
                0399            ENDDO
                0400           ENDDO
                0401          ENDIF
                0402         ENDDO
                0403        ENDDO
                0404       ENDIF
                0405 #endif /* ALLOW_OBCS_EAST */
                0406 
                0407 #ifdef ALLOW_OBCS_WEST
                0408       IF ( OBCS_balanceFacW.NE.0. ) THEN
                0409        DO bj=myByLo(myThid),myByHi(myThid)
                0410         DO bi=myBxLo(myThid),myBxHi(myThid)
                0411          IF ( tileHasOBW(bi,bj) ) THEN
                0412           DO k=1,Nr
838c7f9401 Jean*0413            DO j=1-OLy,sNy+OLy
20c0bcbffa Jean*0414             iB = OB_Iw(j,bi,bj)
838c7f9401 Jean*0415             IF ( iB.NE.OB_indexNone ) THEN
20c0bcbffa Jean*0416              OBWu(j,k,bi,bj) = OBWu(j,k,bi,bj)
                0417      &                       + flowW*maskW(1+iB,j,k,bi,bj)
                0418             ENDIF
                0419            ENDDO
                0420           ENDDO
                0421          ENDIF
                0422         ENDDO
                0423        ENDDO
                0424       ENDIF
                0425 #endif /* ALLOW_OBCS_WEST */
                0426 
                0427 #ifdef ALLOW_OBCS_NORTH
f2bfd4c10a Jean*0428       IF ( OBCS_balanceFacN.NE.0. ) THEN
20c0bcbffa Jean*0429        DO bj=myByLo(myThid),myByHi(myThid)
                0430         DO bi=myBxLo(myThid),myBxHi(myThid)
                0431          IF ( tileHasOBN(bi,bj) ) THEN
                0432           DO k=1,Nr
838c7f9401 Jean*0433            DO i=1-OLx,sNx+OLx
20c0bcbffa Jean*0434             jB = OB_Jn(i,bi,bj)
838c7f9401 Jean*0435             IF ( jB.NE.OB_indexNone ) THEN
20c0bcbffa Jean*0436              OBNv(i,k,bi,bj) = OBNv(i,k,bi,bj)
                0437      &                       + flowN*maskS(i,jB,k,bi,bj)
                0438             ENDIF
                0439            ENDDO
                0440           ENDDO
                0441          ENDIF
                0442         ENDDO
                0443        ENDDO
                0444       ENDIF
                0445 #endif /* ALLOW_OBCS_NORTH */
                0446 
                0447 #ifdef ALLOW_OBCS_SOUTH
                0448       IF ( OBCS_balanceFacS.NE.0. ) THEN
                0449        DO bj=myByLo(myThid),myByHi(myThid)
                0450         DO bi=myBxLo(myThid),myBxHi(myThid)
                0451          IF ( tileHasOBS(bi,bj) ) THEN
                0452           DO k=1,Nr
838c7f9401 Jean*0453            DO i=1-OLx,sNx+OLx
20c0bcbffa Jean*0454             jB = OB_Js(i,bi,bj)
838c7f9401 Jean*0455             IF ( jB.NE.OB_indexNone ) THEN
20c0bcbffa Jean*0456              OBSv(i,k,bi,bj) = OBSv(i,k,bi,bj)
                0457      &                       + flowS*maskS(i,1+jB,k,bi,bj)
                0458             ENDIF
                0459            ENDDO
                0460           ENDDO
                0461          ENDIF
                0462         ENDDO
                0463        ENDDO
                0464       ENDIF
                0465 #endif /* ALLOW_OBCS_SOUTH */
                0466 
                0467 #ifdef ALLOW_DEBUG
                0468       IF (debugMode) CALL DEBUG_LEAVE('OBCS_BALANCE_FLOW',myThid)
                0469 #endif
                0470 
                0471 #endif /* ALLOW_OBCS_BALANCE */
                0472 #endif /* ALLOW_OBCS */
                0473 
                0474       RETURN
                0475       END