C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_mon_stats.F,v 1.3 2012/09/17 22:06:17 jmc Exp $ C $Name: $ #include "OBCS_OPTIONS.h" C-- File obcs_mon_stats.F: compute statistic of a field at OB section C-- Contents C-- o OBCS_MON_STATS_EW_RL C-- o OBCS_MON_STATS_NS_RL C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP C !ROUTINE: OBCS_MON_STATS_EW_RL C !INTERFACE: SUBROUTINE OBCS_MON_STATS_EW_RL( I tHasOBE, tHasOBW, iEb, iWb, iNone, I kSize, mSize, gPos, I arr, arrhFac, arrDy, arrDr, mskInC, O arrStats, I myThid ) C !DESCRIPTION: C *==========================================================* C | SUBROUTINE OBCS_MON_STATS_EW_RL C | o Caclulate field statistics at Eastern & Western OB C *==========================================================* C !USES: IMPLICIT NONE C === Global variables === #include "SIZE.h" #include "EEPARAMS.h" C !INPUT PARAMETERS: C tHasOBE :: list of OBE active tiles C tHasOBW :: list of OBW active tiles C iEb :: index of Eastern OB C iWb :: index of Western OB C iNone :: null index value C kSize :: field-array 3rd dimension C mSize :: hFac-array 3rd dimension C gPos :: field position on C-grid ( 0=center , 1=U , 2=V , 3=Corner) C arr :: field-array C arrhFac :: hFac factor C arrDy :: grid-cell length along OB C arrDr :: grid-level thickness C mskInC :: 2-d mask defining the interior region (cell centered) C myThid :: my Thread Id number LOGICAL tHasOBE(nSx,nSy) LOGICAL tHasOBW(nSx,nSy) INTEGER iEb(1-OLy:sNy+OLy,nSx,nSy) INTEGER iWb(1-OLy:sNy+OLy,nSx,nSy) INTEGER iNone INTEGER kSize INTEGER mSize INTEGER gPos _RL arr (1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy) _RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,mSize,nSx,nSy) _RS arrDy (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RS arrDr (kSize) _RS mskInC (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) INTEGER myThid C !OUTPUT PARAMETERS: C arrStats :: field statistics at Eatern & Western OB _RL arrStats(0:4,2) CEOP #ifdef ALLOW_OBCS #ifdef ALLOW_MONITOR C !FUNCTIONS: C !LOCAL VARIABLES: C bi, bj :: tile indices C j, k :: loop indices C ii, iB :: local index of open boundary INTEGER bi, bj INTEGER j, k, km INTEGER ii, iB LOGICAL noPnts _RL tmpA, tmpV, tmpMask _RL theMin, theMax, theArea, theMean, theVar _RL tileArea(nSx,nSy) _RL tileMean(nSx,nSy) _RL tileVar (nSx,nSy) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| DO k=0,4 arrStats(k,1) = 0. _d 0 ENDDO #ifdef ALLOW_OBCS_EAST theMin = 0. theMax = 0. theMean= 0. theVar = 0. theArea= 0. noPnts = .TRUE. c IF ( usingEast_OB ) THEN DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) tileArea(bi,bj) = 0. tileMean(bi,bj) = 0. tileVar (bi,bj) = 0. IF ( tHasOBE(bi,bj) ) THEN DO k=1,kSize km = MIN(k,mSize) DO j=1,sNy tmpMask = 0. ii = iEb(j,bi,bj) C- If 1 OB location is on 2 tiles (@ edge of 2 tiles), select the one which C communicates with tile interior (sNx+1) rather than with halo region (i=1) IF ( ii.NE.iNone .AND. ii.GT.1 ) THEN iB = ii tmpMask = arrhFac(iB,j,km,bi,bj) & *( mskInC(ii-1,j,bi,bj)-mskInC(ii,j,bi,bj) ) ENDIF IF ( tmpMask.GT.0. _d 0 ) THEN tmpV = arr(ii,j,k,bi,bj) tmpA = arrDy(iB,j,bi,bj)*arrDr(k)*tmpMask IF ( noPnts ) THEN theMin = tmpV theMax = tmpV noPnts = .FALSE. ENDIF theMin = MIN( theMin, tmpV ) theMax = MAX( theMax, tmpV ) tileArea(bi,bj) = tileArea(bi,bj) + tmpA tileMean(bi,bj) = tileMean(bi,bj) + tmpA*tmpV tileVar (bi,bj) = tileVar (bi,bj) + tmpA*tmpV*tmpV ENDIF ENDDO ENDDO ENDIF ENDDO ENDDO CALL GLOBAL_SUM_TILE_RL( tileArea, theArea, myThid ) c ENDIF IF ( theArea.GT.0. ) THEN CALL GLOBAL_SUM_TILE_RL( tileMean, theMean, myThid ) CALL GLOBAL_SUM_TILE_RL( tileVar , theVar , myThid ) arrStats(0,1) = theArea arrStats(1,1) = theMean arrStats(2,1) = theVar theMean = theMean/theArea IF ( noPnts ) theMin = theMean theMin = -theMin _GLOBAL_MAX_RL(theMin,myThid) theMin = -theMin IF ( noPnts ) theMax = theMean _GLOBAL_MAX_RL(theMax,myThid) arrStats(3,1) = theMin arrStats(4,1) = theMax ENDIF #endif /* ALLOW_OBCS_EAST */ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| DO k=0,4 arrStats(k,2) = 0. _d 0 ENDDO #ifdef ALLOW_OBCS_WEST theMin = 0. theMax = 0. theMean= 0. theVar = 0. theArea= 0. noPnts = .TRUE. c IF ( usingWest_OB ) THEN DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) tileArea(bi,bj) = 0. tileMean(bi,bj) = 0. tileVar (bi,bj) = 0. IF ( tHasOBW(bi,bj) ) THEN DO k=1,kSize km = MIN(k,mSize) DO j=1,sNy tmpMask = 0. ii = iWb(j,bi,bj) C- If 1 OB location is on 2 tiles (@ edge of 2 tiles), select the one which C communicates with tile interior (i=0) rather than with halo region (i=sNx) IF ( ii.NE.iNone .AND. ii.LT.sNx ) THEN iB = ii+1 tmpMask = arrhFac(iB,j,km,bi,bj) & *( mskInC(ii+1,j,bi,bj)-mskInC(ii,j,bi,bj) ) ENDIF IF ( tmpMask.GT.0. _d 0 ) THEN IF ( gPos.EQ.1 .OR. gPos.EQ.3 ) ii = iB tmpV = arr(ii,j,k,bi,bj) tmpA = arrDy(iB,j,bi,bj)*arrDr(k)*tmpMask IF ( noPnts ) THEN theMin = tmpV theMax = tmpV noPnts = .FALSE. ENDIF theMin = MIN( theMin, tmpV ) theMax = MAX( theMax, tmpV ) tileArea(bi,bj) = tileArea(bi,bj) + tmpA tileMean(bi,bj) = tileMean(bi,bj) + tmpA*tmpV tileVar (bi,bj) = tileVar (bi,bj) + tmpA*tmpV*tmpV ENDIF ENDDO ENDDO ENDIF ENDDO ENDDO CALL GLOBAL_SUM_TILE_RL( tileArea, theArea, myThid ) c ENDIF IF ( theArea.GT.0. ) THEN CALL GLOBAL_SUM_TILE_RL( tileMean, theMean, myThid ) CALL GLOBAL_SUM_TILE_RL( tileVar , theVar , myThid ) arrStats(0,2) = theArea arrStats(1,2) = theMean arrStats(2,2) = theVar theMean = theMean/theArea IF ( noPnts ) theMin = theMean theMin = -theMin _GLOBAL_MAX_RL(theMin,myThid) theMin = -theMin IF ( noPnts ) theMax = theMean _GLOBAL_MAX_RL(theMax,myThid) arrStats(3,2) = theMin arrStats(4,2) = theMax ENDIF #endif /* ALLOW_OBCS_WEST */ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| #endif /* ALLOW_MONITOR */ #endif /* ALLOW_OBCS */ RETURN END C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP C !ROUTINE: OBCS_MON_STATS_NS_RL C !INTERFACE: SUBROUTINE OBCS_MON_STATS_NS_RL( I tHasOBN, tHasOBS, jNb, jSb, jNone, I kSize, mSize, gPos, I arr, arrhFac, arrDx, arrDr, mskInC, O arrStats, I myThid ) C !DESCRIPTION: C *==========================================================* C | SUBROUTINE OBCS_MON_STATS_NS_RL C | o Caclulate field statistics at Northern & Southern OB C *==========================================================* C !USES: IMPLICIT NONE C === Global variables === #include "SIZE.h" #include "EEPARAMS.h" C !INPUT PARAMETERS: C tHasOBN :: list of OBN active tiles C tHasOBS :: list of OBS active tiles C jNb :: index of Northern OB C jSb :: index of Southern OB C jNone :: null index value C kSize :: field-array 3rd dimension C mSize :: hFac-array 3rd dimension C gPos :: field position on C-grid ( 0=center , 1=U , 2=V , 3=Corner) C arr :: field-array C arrhFac :: hFac factor C arrDx :: grid-cell length along OB C arrDr :: grid-level thickness C mskInC :: 2-d mask defining the interior region (cell centered) C myThid :: my Thread Id number LOGICAL tHasOBN(nSx,nSy) LOGICAL tHasOBS(nSx,nSy) INTEGER jNb(1-OLx:sNx+OLx,nSx,nSy) INTEGER jSb(1-OLx:sNx+OLx,nSx,nSy) INTEGER jNone INTEGER kSize INTEGER mSize INTEGER gPos _RL arr (1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy) _RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,mSize,nSx,nSy) _RS arrDx (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) _RS arrDr (kSize) _RS mskInC (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) INTEGER myThid C !OUTPUT PARAMETERS: C arrStats :: field statistics at Northern & Southern OB _RL arrStats(0:4,2) CEOP #ifdef ALLOW_OBCS #ifdef ALLOW_MONITOR C !FUNCTIONS: C !LOCAL VARIABLES: C bi, bj :: tile indices C i, k :: loop indices C jj, jB :: local index of open boundary INTEGER bi, bj INTEGER i, k, km INTEGER jj, jB LOGICAL noPnts _RL tmpA, tmpV, tmpMask _RL theMin, theMax, theArea, theMean, theVar _RL tileArea(nSx,nSy) _RL tileMean(nSx,nSy) _RL tileVar (nSx,nSy) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| DO k=0,4 arrStats(k,1) = 0. _d 0 ENDDO #ifdef ALLOW_OBCS_NORTH theMin = 0. theMax = 0. theMean= 0. theVar = 0. theArea= 0. noPnts = .TRUE. c IF ( usingNorth_OB ) THEN DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) tileArea(bi,bj) = 0. tileMean(bi,bj) = 0. tileVar (bi,bj) = 0. IF ( tHasOBN(bi,bj) ) THEN DO k=1,kSize km = MIN(k,mSize) DO i=1,sNx tmpMask = 0. jj = jNb(i,bi,bj) C- If 1 OB location is on 2 tiles (@ edge of 2 tiles), select the one which C communicates with tile interior (sNy+1) rather than with halo region (j=1) IF ( jj.NE.jNone .AND. jj.GT.1 ) THEN jB = jj tmpMask = arrhFac(i,jB,km,bi,bj) & *( mskInC(i,jj-1,bi,bj)-mskInC(i,jj,bi,bj) ) ENDIF IF ( tmpMask.GT.0. _d 0 ) THEN tmpV = arr(i,jj,k,bi,bj) tmpA = arrDx(i,jB,bi,bj)*arrDr(k)*tmpMask IF ( noPnts ) THEN theMin = tmpV theMax = tmpV noPnts = .FALSE. ENDIF theMin = MIN( theMin, tmpV ) theMax = MAX( theMax, tmpV ) tileArea(bi,bj) = tileArea(bi,bj) + tmpA tileMean(bi,bj) = tileMean(bi,bj) + tmpA*tmpV tileVar (bi,bj) = tileVar (bi,bj) + tmpA*tmpV*tmpV ENDIF ENDDO ENDDO ENDIF ENDDO ENDDO CALL GLOBAL_SUM_TILE_RL( tileArea, theArea, myThid ) c ENDIF IF ( theArea.GT.0. ) THEN CALL GLOBAL_SUM_TILE_RL( tileMean, theMean, myThid ) CALL GLOBAL_SUM_TILE_RL( tileVar , theVar , myThid ) arrStats(0,1) = theArea arrStats(1,1) = theMean arrStats(2,1) = theVar theMean = theMean/theArea IF ( noPnts ) theMin = theMean theMin = -theMin _GLOBAL_MAX_RL(theMin,myThid) theMin = -theMin IF ( noPnts ) theMax = theMean _GLOBAL_MAX_RL(theMax,myThid) arrStats(3,1) = theMin arrStats(4,1) = theMax ENDIF #endif /* ALLOW_OBCS_NORTH */ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| DO k=0,4 arrStats(k,2) = 0. _d 0 ENDDO #ifdef ALLOW_OBCS_SOUTH theMin = 0. theMax = 0. theMean= 0. theVar = 0. theArea= 0. noPnts = .TRUE. c IF ( usingSouth_OB ) THEN DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) tileArea(bi,bj) = 0. tileMean(bi,bj) = 0. tileVar (bi,bj) = 0. IF ( tHasOBS(bi,bj) ) THEN DO k=1,kSize km = MIN(k,mSize) DO i=1,sNx tmpMask = 0. jj = jSb(i,bi,bj) C- If 1 OB location is on 2 tiles (@ edge of 2 tiles), select the one which C communicates with tile interior (j=0) rather than with halo region (j=sNy) IF ( jj.NE.jNone .AND. jj.LT.sNy ) THEN jB = jj+1 tmpMask = arrhFac(i,jB,km,bi,bj) & *( mskInC(i,jj+1,bi,bj)-mskInC(i,jj,bi,bj) ) ENDIF IF ( tmpMask.GT.0. _d 0 ) THEN IF ( gPos.EQ.2 .OR. gPos.EQ.3 ) jj = jB tmpV = arr(i,jj,k,bi,bj) tmpA = arrDx(i,jB,bi,bj)*arrDr(k)*tmpMask IF ( noPnts ) THEN theMin = tmpV theMax = tmpV noPnts = .FALSE. ENDIF theMin = MIN( theMin, tmpV ) theMax = MAX( theMax, tmpV ) tileArea(bi,bj) = tileArea(bi,bj) + tmpA tileMean(bi,bj) = tileMean(bi,bj) + tmpA*tmpV tileVar (bi,bj) = tileVar (bi,bj) + tmpA*tmpV*tmpV ENDIF ENDDO ENDDO ENDIF ENDDO ENDDO CALL GLOBAL_SUM_TILE_RL( tileArea, theArea, myThid ) c ENDIF IF ( theArea.GT.0. ) THEN CALL GLOBAL_SUM_TILE_RL( tileMean, theMean, myThid ) CALL GLOBAL_SUM_TILE_RL( tileVar , theVar , myThid ) arrStats(0,2) = theArea arrStats(1,2) = theMean arrStats(2,2) = theVar theMean = theMean/theArea IF ( noPnts ) theMin = theMean theMin = -theMin _GLOBAL_MAX_RL(theMin,myThid) theMin = -theMin IF ( noPnts ) theMax = theMean _GLOBAL_MAX_RL(theMax,myThid) arrStats(3,2) = theMin arrStats(4,2) = theMax ENDIF #endif /* ALLOW_OBCS_SOUTH */ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| #endif /* ALLOW_MONITOR */ #endif /* ALLOW_OBCS */ RETURN END