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
0004
0005
0006
0007
0008 SUBROUTINE OBCS_BALANCE_FLOW( myTime, myIter, myThid )
0009
0010
0011
0012
0013
0014
0015
0016
0017 IMPLICIT NONE
0018
0019
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
0030 _RL myTime
0031 INTEGER myIter
0032 INTEGER myThid
0033
0034
0035 #ifdef ALLOW_OBCS
0036 #ifdef ALLOW_OBCS_BALANCE
0037
0038
0039
0040
0041
0042
0043
0044
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
0077
0078
0079
0080
0081
abfe198bce Mart*0082
20c0bcbffa Jean*0083
0084
0085
0086
0087
0088
0089 #ifdef ALLOW_DEBUG
0090 IF (debugMode) CALL DEBUG_ENTER('OBCS_BALANCE_FLOW',myThid)
0091 #endif
0092
0093
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
0117
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
0137
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
0166
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
0186
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
0215
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
0235
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
0264
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
0284
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
abfe198bce Mart*0301
0302
0303
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
20c0bcbffa Jean*0345
0346
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
0383
0384
0385
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