pkg/debug/debug_fld_stats_rs.F

C $Header: /u/gcmpack/MITgcm/pkg/debug/debug_fld_stats_rs.F,v 1.4 2009/04/28 18:10:47 jmc Exp $
C $Name:  $

#include "DEBUG_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: DEBUG_FLD_STATS_RS

C     !INTERFACE:
      SUBROUTINE DEBUG_FLD_STATS_RS(
     I                myNr, arr, exclValue,
     O                theMin, theMax, theMean, theSD,
     I                myThid )

C     *==========================================================*
C     | SUBROUTINE DEBUG_FLD_STATS_RS                            |
C     | o Calculate bare statistics of global array "_RS arr"    |
C     *==========================================================*

C     !USES:
      IMPLICIT NONE

C     === Global data ===
#include "SIZE.h"
#include "EEPARAMS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     myNr      :: 3rd  dimension of input field array
C     arr       :: input field array
C     exclValue :: exclusion value
C     theMin    :: field minimum value
C     theMax    :: field maximun value
C     theMean   :: field averaged value
C     theStD    :: field Standard Deviation
C     myThid    :: my Thread Id number
      INTEGER myNr
      _RS arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
      _RS exclValue
      _RL theMin
      _RL theMax
      _RL theMean
      _RL theSD
      INTEGER myThid

C     !LOCAL VARIABLES:
      INTEGER bi,bj,i,j,k
      LOGICAL noPnts
      _RL tmpVal
      _RL nbPnts, rNbPnts
      _RL theVar
      _RL tileMean(nSx,nSy)
      _RL tileVar (nSx,nSy)
      _RL tileSD  (nSx,nSy)
      _RL tileNbPt(nSx,nSy)
CEOP

      theMin = 0.
      theMax = 0.
      theMean= 0.
      theSD  = 0.
      theVar = 0.
      nbPnts = 0.
      noPnts = .TRUE.

      DO bj=myByLo(myThid),myByHi(myThid)
       DO bi=myBxLo(myThid),myBxHi(myThid)
        tileNbPt(bi,bj) = 0.
        tileMean(bi,bj) = 0.
        tileVar (bi,bj) = 0.
        DO k=1,myNr
         DO j=1,sNy
          DO i=1,sNx
           tmpVal = arr(i,j,k,bi,bj)
           IF ( tmpVal.NE.exclValue .AND. noPnts ) THEN
            theMin = tmpVal
            theMax = tmpVal
            noPnts = .FALSE.
           ENDIF
           IF ( tmpVal.NE.exclValue ) THEN
            theMin = MIN( theMin, tmpVal )
            theMax = MAX( theMax, tmpVal )
            tileNbPt(bi,bj) = tileNbPt(bi,bj) + 1. _d 0
            tileMean(bi,bj) = tileMean(bi,bj) + tmpVal
            tileVar (bi,bj) = tileVar (bi,bj) + tmpVal*tmpVal
           ENDIF
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ENDDO

      CALL GLOBAL_SUM_TILE_RL( tileNbPt, nbPnts,  myThid )
      CALL GLOBAL_SUM_TILE_RL( tileMean, theMean, myThid )
c     CALL GLOBAL_SUM_TILE_RL( tileVar , theVar,  myThid )

      IF ( nbPnts.GT.zeroRL ) THEN
       rNbPnts = 1. _d 0/nbPnts
       theMean = theMean*rNbPnts
c      theVar  = theVar *rNbPnts

       IF ( noPnts ) theMin = theMean
       theMin = -theMin
       _GLOBAL_MAX_RL( theMin, myThid )
       theMin = -theMin
       IF ( noPnts ) theMax = theMean
       _GLOBAL_MAX_RL( theMax, myThid )

       DO bj=myByLo(myThid),myByHi(myThid)
        DO bi=myBxLo(myThid),myBxHi(myThid)
         tileSD(bi,bj) = 0.
         DO k=1,myNr
          DO j=1,sNy
           DO i=1,sNx
            tmpVal = arr(i,j,k,bi,bj)
            IF ( tmpVal.NE.exclValue ) THEN
             tileSD(bi,bj) = tileSD(bi,bj)
     &                     + (tmpVal-theMean)*(tmpVal-theMean)
            ENDIF
           ENDDO
          ENDDO
         ENDDO
        ENDDO
       ENDDO

       CALL GLOBAL_SUM_TILE_RL( tileSD, theSD, myThid )

       theSD = SQRT( theSD*rNbPnts )
c      theSD = SQRT( theVar - theMean*theMean )
      ENDIF

      RETURN
      END
1	jmc	1.5	C $Header: /u/gcmpack/MITgcm/pkg/debug/debug_fld_stats_rs.F,v 1.4 2009/04/28 18:10:47 jmc Exp $
2	jmc	1.3	C $Name: $
3	heimbach	1.1
4	edhill	1.2	#include "DEBUG_OPTIONS.h"
5	heimbach	1.1
6	jmc	1.5	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7			CBOP
8			C !ROUTINE: DEBUG_FLD_STATS_RS
9
10			C !INTERFACE:
11	heimbach	1.1	SUBROUTINE DEBUG_FLD_STATS_RS(
12	jmc	1.5	I myNr, arr, exclValue,
13			O theMin, theMax, theMean, theSD,
14	heimbach	1.1	I myThid )
15	jmc	1.5
16			C ==========================================================
17	heimbach	1.1	C \| SUBROUTINE DEBUG_FLD_STATS_RS \|
18			C \| o Calculate bare statistics of global array "_RS arr" \|
19	jmc	1.5	C ==========================================================
20
21			C !USES:
22	heimbach	1.1	IMPLICIT NONE
23
24			C === Global data ===
25			#include "SIZE.h"
26			#include "EEPARAMS.h"
27
28	jmc	1.5	C !INPUT/OUTPUT PARAMETERS:
29			C myNr :: 3rd dimension of input field array
30			C arr :: input field array
31			C exclValue :: exclusion value
32			C theMin :: field minimum value
33			C theMax :: field maximun value
34			C theMean :: field averaged value
35			C theStD :: field Standard Deviation
36			C myThid :: my Thread Id number
37	heimbach	1.1	INTEGER myNr
38			_RS arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
39	jmc	1.5	_RS exclValue
40	heimbach	1.1	_RL theMin
41			_RL theMax
42			_RL theMean
43			_RL theSD
44			INTEGER myThid
45
46	jmc	1.5	C !LOCAL VARIABLES:
47			INTEGER bi,bj,i,j,k
48	heimbach	1.1	LOGICAL noPnts
49	jmc	1.5	_RL tmpVal
50			_RL nbPnts, rNbPnts
51	heimbach	1.1	_RL theVar
52	jmc	1.5	_RL tileMean(nSx,nSy)
53			_RL tileVar (nSx,nSy)
54			_RL tileSD (nSx,nSy)
55			_RL tileNbPt(nSx,nSy)
56			CEOP
57
58			theMin = 0.
59			theMax = 0.
60			theMean= 0.
61			theSD = 0.
62			theVar = 0.
63			nbPnts = 0.
64			noPnts = .TRUE.
65	heimbach	1.1
66			DO bj=myByLo(myThid),myByHi(myThid)
67			DO bi=myBxLo(myThid),myBxHi(myThid)
68	jmc	1.5	tileNbPt(bi,bj) = 0.
69			tileMean(bi,bj) = 0.
70			tileVar (bi,bj) = 0.
71			DO k=1,myNr
72			DO j=1,sNy
73			DO i=1,sNx
74			tmpVal = arr(i,j,k,bi,bj)
75			IF ( tmpVal.NE.exclValue .AND. noPnts ) THEN
76			theMin = tmpVal
77			theMax = tmpVal
78			noPnts = .FALSE.
79	heimbach	1.1	ENDIF
80	jmc	1.5	IF ( tmpVal.NE.exclValue ) THEN
81			theMin = MIN( theMin, tmpVal )
82			theMax = MAX( theMax, tmpVal )
83			tileNbPt(bi,bj) = tileNbPt(bi,bj) + 1. _d 0
84			tileMean(bi,bj) = tileMean(bi,bj) + tmpVal
85			tileVar (bi,bj) = tileVar (bi,bj) + tmpVal*tmpVal
86	heimbach	1.1	ENDIF
87			ENDDO
88			ENDDO
89			ENDDO
90			ENDDO
91			ENDDO
92
93	jmc	1.5	CALL GLOBAL_SUM_TILE_RL( tileNbPt, nbPnts, myThid )
94			CALL GLOBAL_SUM_TILE_RL( tileMean, theMean, myThid )
95			c CALL GLOBAL_SUM_TILE_RL( tileVar , theVar, myThid )
96
97			IF ( nbPnts.GT.zeroRL ) THEN
98			rNbPnts = 1. _d 0/nbPnts
99			theMean = theMean*rNbPnts
100			c theVar = theVar *rNbPnts
101
102			IF ( noPnts ) theMin = theMean
103			theMin = -theMin
104			_GLOBAL_MAX_RL( theMin, myThid )
105			theMin = -theMin
106			IF ( noPnts ) theMax = theMean
107			_GLOBAL_MAX_RL( theMax, myThid )
108	heimbach	1.1
109			DO bj=myByLo(myThid),myByHi(myThid)
110			DO bi=myBxLo(myThid),myBxHi(myThid)
111	jmc	1.5	tileSD(bi,bj) = 0.
112			DO k=1,myNr
113			DO j=1,sNy
114			DO i=1,sNx
115			tmpVal = arr(i,j,k,bi,bj)
116			IF ( tmpVal.NE.exclValue ) THEN
117			tileSD(bi,bj) = tileSD(bi,bj)
118			& + (tmpVal-theMean)*(tmpVal-theMean)
119	heimbach	1.1	ENDIF
120			ENDDO
121			ENDDO
122			ENDDO
123			ENDDO
124			ENDDO
125
126	jmc	1.5	CALL GLOBAL_SUM_TILE_RL( tileSD, theSD, myThid )
127	heimbach	1.1
128	jmc	1.5	theSD = SQRT( theSD*rNbPnts )
129			c theSD = SQRT( theVar - theMean*theMean )
130	heimbach	1.1	ENDIF
131
132			RETURN
133			END