pkg/obcs/obcs_mon_stats.F

5da861df38 Jean*0001 #include "OBCS_OPTIONS.h"
                0002
                0003 C--  File obcs_mon_stats.F: compute statistic of a field at OB section
                0004 C--   Contents
                0005 C--   o OBCS_MON_STATS_EW_RL
                0006 C--   o OBCS_MON_STATS_NS_RL
                0007
                0008 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0009 CBOP
                0010 C     !ROUTINE: OBCS_MON_STATS_EW_RL
                0011
                0012 C     !INTERFACE:
                0013       SUBROUTINE OBCS_MON_STATS_EW_RL(
ae878c3c50 Jean*0014      I     tHasOBE, tHasOBW, iEb, iWb, iNone,
47f36df0c2 Jean*0015      I     kSize, mSize, gPos,
                0016      I     arr, arrhFac, arrDy, arrDr, mskInC,
5da861df38 Jean*0017      O     arrStats,
                0018      I     myThid )
                0019
                0020 C     !DESCRIPTION:
                0021 C     *==========================================================*
                0022 C     | SUBROUTINE OBCS_MON_STATS_EW_RL
                0023 C     | o Caclulate field statistics at Eastern & Western OB
                0024 C     *==========================================================*
                0025
                0026 C     !USES:
                0027       IMPLICIT NONE
                0028
                0029 C     === Global variables ===
                0030 #include "SIZE.h"
                0031 #include "EEPARAMS.h"
                0032
                0033 C     !INPUT PARAMETERS:
                0034 C     tHasOBE  :: list of OBE active tiles
                0035 C     tHasOBW  :: list of OBW active tiles
                0036 C     iEb      :: index of Eastern OB
                0037 C     iWb      :: index of Western OB
ae878c3c50 Jean*0038 C     iNone    :: null index value
5da861df38 Jean*0039 C     kSize    :: field-array 3rd dimension
                0040 C     mSize    :: hFac-array  3rd dimension
47f36df0c2 Jean*0041 C     gPos     :: field position on C-grid ( 0=center , 1=U , 2=V , 3=Corner)
5da861df38 Jean*0042 C     arr      :: field-array
                0043 C     arrhFac  :: hFac factor
                0044 C     arrDy    :: grid-cell length along OB
                0045 C     arrDr    :: grid-level thickness
47f36df0c2 Jean*0046 C     mskInC   :: 2-d mask defining the interior region (cell centered)
5da861df38 Jean*0047 C     myThid   :: my Thread Id number
                0048       LOGICAL tHasOBE(nSx,nSy)
                0049       LOGICAL tHasOBW(nSx,nSy)
                0050       INTEGER iEb(1-OLy:sNy+OLy,nSx,nSy)
                0051       INTEGER iWb(1-OLy:sNy+OLy,nSx,nSy)
ae878c3c50 Jean*0052       INTEGER iNone
5da861df38 Jean*0053       INTEGER kSize
                0054       INTEGER mSize
47f36df0c2 Jean*0055       INTEGER gPos
5da861df38 Jean*0056       _RL arr    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
                0057       _RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,mSize,nSx,nSy)
                0058       _RS arrDy  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
47f36df0c2 Jean*0059       _RS arrDr  (kSize)
                0060       _RS mskInC (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
5da861df38 Jean*0061       INTEGER myThid
                0062
                0063 C     !OUTPUT PARAMETERS:
                0064 C     arrStats :: field statistics at Eatern & Western OB
                0065       _RL arrStats(0:4,2)
                0066 CEOP
                0067
                0068 #ifdef ALLOW_OBCS
                0069 #ifdef ALLOW_MONITOR
                0070
                0071 C     !FUNCTIONS:
                0072
                0073 C     !LOCAL VARIABLES:
                0074 C     bi, bj   :: tile indices
                0075 C     j, k     :: loop indices
                0076 C     ii, iB   :: local index of open boundary
005af54e38 Jean*0077       INTEGER k
                0078 #if (defined ALLOW_OBCS_EAST ) || (defined ALLOW_OBCS_WEST )
5da861df38 Jean*0079       INTEGER bi, bj
005af54e38 Jean*0080       INTEGER j, km
5da861df38 Jean*0081       INTEGER ii, iB
                0082       LOGICAL noPnts
                0083       _RL tmpA, tmpV, tmpMask
                0084       _RL theMin, theMax, theArea, theMean, theVar
                0085       _RL tileArea(nSx,nSy)
                0086       _RL tileMean(nSx,nSy)
                0087       _RL tileVar (nSx,nSy)
005af54e38 Jean*0088 #endif
5da861df38 Jean*0089
                0090 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0091
                0092       DO k=0,4
                0093         arrStats(k,1) = 0. _d 0
                0094       ENDDO
                0095 #ifdef ALLOW_OBCS_EAST
                0096       theMin = 0.
                0097       theMax = 0.
                0098       theMean= 0.
                0099       theVar = 0.
                0100       theArea= 0.
                0101       noPnts = .TRUE.
                0102 c     IF ( usingEast_OB ) THEN
                0103         DO bj=myByLo(myThid),myByHi(myThid)
                0104          DO bi=myBxLo(myThid),myBxHi(myThid)
                0105           tileArea(bi,bj) = 0.
                0106           tileMean(bi,bj) = 0.
                0107           tileVar (bi,bj) = 0.
                0108           IF ( tHasOBE(bi,bj) ) THEN
                0109            DO k=1,kSize
                0110             km = MIN(k,mSize)
                0111             DO j=1,sNy
                0112              tmpMask = 0.
                0113              ii = iEb(j,bi,bj)
ae878c3c50 Jean*0114 C-    If 1 OB location is on 2 tiles (@ edge of 2 tiles), select the one which
                0115 C     communicates with tile interior (sNx+1) rather than with halo region (i=1)
                0116              IF ( ii.NE.iNone .AND. ii.GT.1 ) THEN
5da861df38 Jean*0117               iB = ii
47f36df0c2 Jean*0118               tmpMask = arrhFac(iB,j,km,bi,bj)
                0119      &                *( mskInC(ii-1,j,bi,bj)-mskInC(ii,j,bi,bj) )
5da861df38 Jean*0120              ENDIF
                0121              IF ( tmpMask.GT.0. _d 0 ) THEN
                0122               tmpV = arr(ii,j,k,bi,bj)
                0123               tmpA = arrDy(iB,j,bi,bj)*arrDr(k)*tmpMask
                0124               IF ( noPnts ) THEN
                0125                 theMin = tmpV
                0126                 theMax = tmpV
                0127                 noPnts = .FALSE.
                0128               ENDIF
                0129               theMin = MIN( theMin, tmpV )
                0130               theMax = MAX( theMax, tmpV )
                0131               tileArea(bi,bj) = tileArea(bi,bj) + tmpA
                0132               tileMean(bi,bj) = tileMean(bi,bj) + tmpA*tmpV
                0133               tileVar (bi,bj) = tileVar (bi,bj) + tmpA*tmpV*tmpV
                0134              ENDIF
                0135             ENDDO
                0136            ENDDO
                0137           ENDIF
                0138          ENDDO
                0139         ENDDO
                0140         CALL GLOBAL_SUM_TILE_RL( tileArea, theArea, myThid )
                0141 c     ENDIF
                0142       IF ( theArea.GT.0. ) THEN
                0143         CALL GLOBAL_SUM_TILE_RL( tileMean, theMean, myThid )
                0144         CALL GLOBAL_SUM_TILE_RL( tileVar , theVar , myThid )
                0145         arrStats(0,1) = theArea
                0146         arrStats(1,1) = theMean
                0147         arrStats(2,1) = theVar
                0148
                0149         theMean = theMean/theArea
                0150         IF ( noPnts ) theMin = theMean
                0151         theMin = -theMin
                0152         _GLOBAL_MAX_RL(theMin,myThid)
                0153         theMin = -theMin
                0154         IF ( noPnts ) theMax = theMean
                0155         _GLOBAL_MAX_RL(theMax,myThid)
                0156         arrStats(3,1) = theMin
                0157         arrStats(4,1) = theMax
                0158
                0159       ENDIF
                0160 #endif /* ALLOW_OBCS_EAST */
                0161
                0162 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0163
                0164       DO k=0,4
                0165         arrStats(k,2) = 0. _d 0
                0166       ENDDO
                0167 #ifdef ALLOW_OBCS_WEST
                0168       theMin = 0.
                0169       theMax = 0.
                0170       theMean= 0.
                0171       theVar = 0.
                0172       theArea= 0.
                0173       noPnts = .TRUE.
                0174 c     IF ( usingWest_OB ) THEN
                0175         DO bj=myByLo(myThid),myByHi(myThid)
                0176          DO bi=myBxLo(myThid),myBxHi(myThid)
                0177           tileArea(bi,bj) = 0.
                0178           tileMean(bi,bj) = 0.
                0179           tileVar (bi,bj) = 0.
                0180           IF ( tHasOBW(bi,bj) ) THEN
                0181            DO k=1,kSize
                0182             km = MIN(k,mSize)
                0183             DO j=1,sNy
                0184              tmpMask = 0.
                0185              ii = iWb(j,bi,bj)
ae878c3c50 Jean*0186 C-    If 1 OB location is on 2 tiles (@ edge of 2 tiles), select the one which
                0187 C     communicates with tile interior (i=0) rather than with halo region (i=sNx)
                0188              IF ( ii.NE.iNone .AND. ii.LT.sNx ) THEN
5da861df38 Jean*0189               iB = ii+1
47f36df0c2 Jean*0190               tmpMask = arrhFac(iB,j,km,bi,bj)
                0191      &                *( mskInC(ii+1,j,bi,bj)-mskInC(ii,j,bi,bj) )
5da861df38 Jean*0192              ENDIF
                0193              IF ( tmpMask.GT.0. _d 0 ) THEN
                0194               IF ( gPos.EQ.1 .OR. gPos.EQ.3 ) ii = iB
                0195               tmpV = arr(ii,j,k,bi,bj)
                0196               tmpA = arrDy(iB,j,bi,bj)*arrDr(k)*tmpMask
                0197               IF ( noPnts ) THEN
                0198                 theMin = tmpV
                0199                 theMax = tmpV
                0200                 noPnts = .FALSE.
                0201               ENDIF
                0202               theMin = MIN( theMin, tmpV )
                0203               theMax = MAX( theMax, tmpV )
                0204               tileArea(bi,bj) = tileArea(bi,bj) + tmpA
                0205               tileMean(bi,bj) = tileMean(bi,bj) + tmpA*tmpV
                0206               tileVar (bi,bj) = tileVar (bi,bj) + tmpA*tmpV*tmpV
                0207              ENDIF
                0208             ENDDO
                0209            ENDDO
                0210           ENDIF
                0211          ENDDO
                0212         ENDDO
                0213         CALL GLOBAL_SUM_TILE_RL( tileArea, theArea, myThid )
                0214 c     ENDIF
                0215       IF ( theArea.GT.0. ) THEN
                0216         CALL GLOBAL_SUM_TILE_RL( tileMean, theMean, myThid )
                0217         CALL GLOBAL_SUM_TILE_RL( tileVar , theVar , myThid )
                0218         arrStats(0,2) = theArea
                0219         arrStats(1,2) = theMean
                0220         arrStats(2,2) = theVar
                0221
                0222         theMean = theMean/theArea
                0223         IF ( noPnts ) theMin = theMean
                0224         theMin = -theMin
                0225         _GLOBAL_MAX_RL(theMin,myThid)
                0226         theMin = -theMin
                0227         IF ( noPnts ) theMax = theMean
                0228         _GLOBAL_MAX_RL(theMax,myThid)
                0229         arrStats(3,2) = theMin
                0230         arrStats(4,2) = theMax
                0231
                0232       ENDIF
                0233 #endif /* ALLOW_OBCS_WEST */
                0234
                0235 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0236
                0237 #endif /* ALLOW_MONITOR */
                0238 #endif /* ALLOW_OBCS */
                0239
                0240       RETURN
                0241       END
                0242
                0243 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0244 CBOP
                0245 C     !ROUTINE: OBCS_MON_STATS_NS_RL
                0246
                0247 C     !INTERFACE:
                0248       SUBROUTINE OBCS_MON_STATS_NS_RL(
ae878c3c50 Jean*0249      I     tHasOBN, tHasOBS, jNb, jSb, jNone,
47f36df0c2 Jean*0250      I     kSize, mSize, gPos,
                0251      I     arr, arrhFac, arrDx, arrDr, mskInC,
5da861df38 Jean*0252      O     arrStats,
                0253      I     myThid )
                0254
                0255 C     !DESCRIPTION:
                0256 C     *==========================================================*
                0257 C     | SUBROUTINE OBCS_MON_STATS_NS_RL
                0258 C     | o Caclulate field statistics at Northern & Southern OB
                0259 C     *==========================================================*
                0260
                0261 C     !USES:
                0262       IMPLICIT NONE
                0263
                0264 C     === Global variables ===
                0265 #include "SIZE.h"
                0266 #include "EEPARAMS.h"
                0267
                0268 C     !INPUT PARAMETERS:
                0269 C     tHasOBN  :: list of OBN active tiles
                0270 C     tHasOBS  :: list of OBS active tiles
                0271 C     jNb      :: index of Northern OB
                0272 C     jSb      :: index of Southern OB
ae878c3c50 Jean*0273 C     jNone    :: null index value
5da861df38 Jean*0274 C     kSize    :: field-array 3rd dimension
47f36df0c2 Jean*0275 C     mSize    :: hFac-array  3rd dimension
                0276 C     gPos     :: field position on C-grid ( 0=center , 1=U , 2=V , 3=Corner)
5da861df38 Jean*0277 C     arr      :: field-array
                0278 C     arrhFac  :: hFac factor
                0279 C     arrDx    :: grid-cell length along OB
                0280 C     arrDr    :: grid-level thickness
47f36df0c2 Jean*0281 C     mskInC   :: 2-d mask defining the interior region (cell centered)
5da861df38 Jean*0282 C     myThid   :: my Thread Id number
                0283       LOGICAL tHasOBN(nSx,nSy)
                0284       LOGICAL tHasOBS(nSx,nSy)
                0285       INTEGER jNb(1-OLx:sNx+OLx,nSx,nSy)
                0286       INTEGER jSb(1-OLx:sNx+OLx,nSx,nSy)
ae878c3c50 Jean*0287       INTEGER jNone
5da861df38 Jean*0288       INTEGER kSize
                0289       INTEGER mSize
47f36df0c2 Jean*0290       INTEGER gPos
5da861df38 Jean*0291       _RL arr    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
                0292       _RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,mSize,nSx,nSy)
                0293       _RS arrDx  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
47f36df0c2 Jean*0294       _RS arrDr  (kSize)
                0295       _RS mskInC (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
5da861df38 Jean*0296       INTEGER myThid
                0297
                0298 C     !OUTPUT PARAMETERS:
                0299 C     arrStats :: field statistics at Northern & Southern OB
                0300       _RL arrStats(0:4,2)
                0301 CEOP
                0302
                0303 #ifdef ALLOW_OBCS
                0304 #ifdef ALLOW_MONITOR
                0305
                0306 C     !FUNCTIONS:
                0307
                0308 C     !LOCAL VARIABLES:
                0309 C     bi, bj   :: tile indices
                0310 C     i, k     :: loop indices
                0311 C     jj, jB   :: local index of open boundary
005af54e38 Jean*0312       INTEGER k
                0313 #if (defined ALLOW_OBCS_NORTH) || (defined ALLOW_OBCS_SOUTH)
5da861df38 Jean*0314       INTEGER bi, bj
005af54e38 Jean*0315       INTEGER i, km
5da861df38 Jean*0316       INTEGER jj, jB
                0317       LOGICAL noPnts
                0318       _RL tmpA, tmpV, tmpMask
                0319       _RL theMin, theMax, theArea, theMean, theVar
                0320       _RL tileArea(nSx,nSy)
                0321       _RL tileMean(nSx,nSy)
                0322       _RL tileVar (nSx,nSy)
005af54e38 Jean*0323 #endif
5da861df38 Jean*0324
                0325 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0326
                0327       DO k=0,4
                0328         arrStats(k,1) = 0. _d 0
                0329       ENDDO
                0330 #ifdef ALLOW_OBCS_NORTH
                0331       theMin = 0.
                0332       theMax = 0.
                0333       theMean= 0.
                0334       theVar = 0.
                0335       theArea= 0.
                0336       noPnts = .TRUE.
                0337 c     IF ( usingNorth_OB ) THEN
                0338         DO bj=myByLo(myThid),myByHi(myThid)
                0339          DO bi=myBxLo(myThid),myBxHi(myThid)
                0340           tileArea(bi,bj) = 0.
                0341           tileMean(bi,bj) = 0.
                0342           tileVar (bi,bj) = 0.
                0343           IF ( tHasOBN(bi,bj) ) THEN
                0344            DO k=1,kSize
                0345             km = MIN(k,mSize)
                0346             DO i=1,sNx
                0347              tmpMask = 0.
                0348              jj = jNb(i,bi,bj)
ae878c3c50 Jean*0349 C-    If 1 OB location is on 2 tiles (@ edge of 2 tiles), select the one which
                0350 C     communicates with tile interior (sNy+1) rather than with halo region (j=1)
                0351              IF ( jj.NE.jNone .AND. jj.GT.1 ) THEN
5da861df38 Jean*0352               jB = jj
47f36df0c2 Jean*0353               tmpMask = arrhFac(i,jB,km,bi,bj)
                0354      &                *( mskInC(i,jj-1,bi,bj)-mskInC(i,jj,bi,bj) )
5da861df38 Jean*0355              ENDIF
                0356              IF ( tmpMask.GT.0. _d 0 ) THEN
                0357               tmpV = arr(i,jj,k,bi,bj)
                0358               tmpA = arrDx(i,jB,bi,bj)*arrDr(k)*tmpMask
                0359               IF ( noPnts ) THEN
                0360                 theMin = tmpV
                0361                 theMax = tmpV
                0362                 noPnts = .FALSE.
                0363               ENDIF
                0364               theMin = MIN( theMin, tmpV )
                0365               theMax = MAX( theMax, tmpV )
                0366               tileArea(bi,bj) = tileArea(bi,bj) + tmpA
                0367               tileMean(bi,bj) = tileMean(bi,bj) + tmpA*tmpV
                0368               tileVar (bi,bj) = tileVar (bi,bj) + tmpA*tmpV*tmpV
                0369              ENDIF
                0370             ENDDO
                0371            ENDDO
                0372           ENDIF
                0373          ENDDO
                0374         ENDDO
                0375         CALL GLOBAL_SUM_TILE_RL( tileArea, theArea, myThid )
                0376 c     ENDIF
                0377       IF ( theArea.GT.0. ) THEN
                0378         CALL GLOBAL_SUM_TILE_RL( tileMean, theMean, myThid )
                0379         CALL GLOBAL_SUM_TILE_RL( tileVar , theVar , myThid )
                0380         arrStats(0,1) = theArea
                0381         arrStats(1,1) = theMean
                0382         arrStats(2,1) = theVar
                0383
                0384         theMean = theMean/theArea
                0385         IF ( noPnts ) theMin = theMean
                0386         theMin = -theMin
                0387         _GLOBAL_MAX_RL(theMin,myThid)
                0388         theMin = -theMin
                0389         IF ( noPnts ) theMax = theMean
                0390         _GLOBAL_MAX_RL(theMax,myThid)
                0391         arrStats(3,1) = theMin
                0392         arrStats(4,1) = theMax
                0393
                0394       ENDIF
                0395 #endif /* ALLOW_OBCS_NORTH */
                0396
                0397 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0398
                0399       DO k=0,4
                0400         arrStats(k,2) = 0. _d 0
                0401       ENDDO
                0402 #ifdef ALLOW_OBCS_SOUTH
                0403       theMin = 0.
                0404       theMax = 0.
                0405       theMean= 0.
                0406       theVar = 0.
                0407       theArea= 0.
                0408       noPnts = .TRUE.
                0409 c     IF ( usingSouth_OB ) THEN
                0410         DO bj=myByLo(myThid),myByHi(myThid)
                0411          DO bi=myBxLo(myThid),myBxHi(myThid)
                0412           tileArea(bi,bj) = 0.
                0413           tileMean(bi,bj) = 0.
                0414           tileVar (bi,bj) = 0.
                0415           IF ( tHasOBS(bi,bj) ) THEN
                0416            DO k=1,kSize
                0417             km = MIN(k,mSize)
                0418             DO i=1,sNx
                0419              tmpMask = 0.
                0420              jj = jSb(i,bi,bj)
ae878c3c50 Jean*0421 C-    If 1 OB location is on 2 tiles (@ edge of 2 tiles), select the one which
                0422 C     communicates with tile interior (j=0) rather than with halo region (j=sNy)
                0423              IF ( jj.NE.jNone .AND. jj.LT.sNy ) THEN
5da861df38 Jean*0424               jB = jj+1
47f36df0c2 Jean*0425               tmpMask = arrhFac(i,jB,km,bi,bj)
                0426      &                *( mskInC(i,jj+1,bi,bj)-mskInC(i,jj,bi,bj) )
5da861df38 Jean*0427              ENDIF
                0428              IF ( tmpMask.GT.0. _d 0 ) THEN
                0429               IF ( gPos.EQ.2 .OR. gPos.EQ.3 ) jj = jB
                0430               tmpV = arr(i,jj,k,bi,bj)
                0431               tmpA = arrDx(i,jB,bi,bj)*arrDr(k)*tmpMask
                0432               IF ( noPnts ) THEN
                0433                 theMin = tmpV
                0434                 theMax = tmpV
                0435                 noPnts = .FALSE.
                0436               ENDIF
                0437               theMin = MIN( theMin, tmpV )
                0438               theMax = MAX( theMax, tmpV )
                0439               tileArea(bi,bj) = tileArea(bi,bj) + tmpA
                0440               tileMean(bi,bj) = tileMean(bi,bj) + tmpA*tmpV
                0441               tileVar (bi,bj) = tileVar (bi,bj) + tmpA*tmpV*tmpV
                0442              ENDIF
                0443             ENDDO
                0444            ENDDO
                0445           ENDIF
                0446          ENDDO
                0447         ENDDO
                0448         CALL GLOBAL_SUM_TILE_RL( tileArea, theArea, myThid )
                0449 c     ENDIF
                0450       IF ( theArea.GT.0. ) THEN
                0451         CALL GLOBAL_SUM_TILE_RL( tileMean, theMean, myThid )
                0452         CALL GLOBAL_SUM_TILE_RL( tileVar , theVar , myThid )
                0453         arrStats(0,2) = theArea
                0454         arrStats(1,2) = theMean
                0455         arrStats(2,2) = theVar
                0456
                0457         theMean = theMean/theArea
                0458         IF ( noPnts ) theMin = theMean
                0459         theMin = -theMin
                0460         _GLOBAL_MAX_RL(theMin,myThid)
                0461         theMin = -theMin
                0462         IF ( noPnts ) theMax = theMean
                0463         _GLOBAL_MAX_RL(theMax,myThid)
                0464         arrStats(3,2) = theMin
                0465         arrStats(4,2) = theMax
                0466
                0467       ENDIF
                0468 #endif /* ALLOW_OBCS_SOUTH */
                0469
                0470 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0471
                0472 #endif /* ALLOW_MONITOR */
                0473 #endif /* ALLOW_OBCS */
                0474
                0475       RETURN
                0476       END