pkg/monitor/mon_stats_latbnd_rl.F

C $Header: /u/gcmpack/MITgcm/pkg/monitor/mon_stats_latbnd_rl.F,v 1.6 2005/11/04 01:33:05 jmc Exp $
C $Name:  $

#include "MONITOR_OPTIONS.h"

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

C     !INTERFACE:
      SUBROUTINE MON_STATS_LATBND_RL(
     I     myNr, mskNr, kLoc, nSepBnd, ySepBnd,
     I     arr, arrMask, arrhFac, arrArea, arrY, arrDr,
     O     theMin,theMax,theMean,theVar,theVol,
     I     myThid )

C     !DESCRIPTION:
C     Calculate bare statistics of global array "\_RL arr" on each
C     Latitude band (given by \texttt{ySepBnd}).

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
      INTEGER  NLATBND
      EXTERNAL NLATBND

C     !INPUT PARAMETERS:
C     nSepBnd :: Number of latitude bands
C     ySepBnd :: Southern latitude egde (from 2 to nSepBnd, 1 is not used)
      INTEGER myNr, mskNr, kLoc
      INTEGER nSepBnd
      _RS ySepBnd(nSepBnd)
      _RL arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
      _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,mskNr,nSx,nSy)
      _RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,mskNr,nSx,nSy)
      _RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
      _RS arrY(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
      _RS arrDr(myNr)
      _RL theMin(nSepBnd)
      _RL theMax(nSepBnd)
      _RL theMean(nSepBnd)
      _RL theVar(nSepBnd)
      _RL theVol(nSepBnd)
      INTEGER myThid
CEOP

C     !LOCAL VARIABLES:
C     msgBuf :: Informational/error meesage buffer
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER bi,bj,i,j,k,n
      INTEGER km, k1, k2
      LOGICAL noPnts(Ny)
      _RL tmpVal
      _RL tmpVol
      INTEGER nSepDim
      PARAMETER ( nSepDim = 200 )
      _RL tileVol (nSx,nSy,nSepDim)
      _RL tileMean(nSx,nSy,nSepDim)
      _RL tileVar (nSx,nSy,nSepDim)

C-    Check local Dim
      IF ( nSepBnd .GT. nSepDim ) THEN
        WRITE(msgBuf,'(A,I6,A)')
     &  'MON_STATS_LATBND_RL: local array Dim (nSepDim=',nSepDim,
     &  ' ) too small'
        CALL PRINT_ERROR( msgBuf , myThid)
        WRITE(msgBuf,'(A,I6)')
     &  'MON_STATS_LATBND_RL: Need nSepDim to be at least =', nSepBnd
        CALL PRINT_ERROR( msgBuf , myThid)
        STOP 'ABNORMAL END: S/R MON_STATS_LATBND_RL'
      ENDIF

      IF ( kLoc.EQ.0 ) THEN
        k1 = 1
        k2 = myNr
      ELSE
        k1 = kLoc
        k2 = kLoc
      ENDIF

      DO n=1,nSepBnd
       noPnts(n)=.TRUE.
       theMin(n)=0.
       theMax(n)=0.
       theMean(n)=0.
       theVar(n)=0.
       theVol(n)=0.
      ENDDO

      DO bj=myByLo(myThid),myByHi(myThid)
       DO bi=myBxLo(myThid),myBxHi(myThid)
        DO n=1,nSepBnd
         tileVol (bi,bj,n) = 0.
         tileMean(bi,bj,n) = 0.
         tileVar (bi,bj,n) = 0.
        ENDDO
        DO k=k1,k2
         km = MIN(k,mskNr)
         DO j=1,sNy
          DO i=1,sNx
           n = NLATBND(nSepBnd, ySepBnd, arrY(i,j,bi,bj) )
           tmpVal=arr(i,j,k,bi,bj)
           IF (arrMask(i,j,km,bi,bj).NE.0. .AND. noPnts(n)) THEN
            theMin(n)=tmpVal
            theMax(n)=tmpVal
            noPnts(n)=.FALSE.
           ENDIF
           IF (arrMask(i,j,km,bi,bj).NE.0.) THEN
            theMin(n)=MIN(theMin(n),tmpVal)
            theMax(n)=MAX(theMax(n),tmpVal)
            tmpVol = arrArea(i,j,bi,bj)*arrhFac(i,j,km,bi,bj)*arrDr(k)
     &                                 *arrMask(i,j,km,bi,bj)
            tileVol (bi,bj,n) = tileVol (bi,bj,n) + tmpVol
            tileMean(bi,bj,n) = tileMean(bi,bj,n) + tmpVol*tmpVal
            tileVar (bi,bj,n) = tileVar (bi,bj,n) + tmpVol*tmpVal*tmpVal
           ENDIF
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ENDDO

      DO n=1,nSepBnd
       CALL GLOBAL_SUM_TILE_RL( tileVol(1,1,n) , theVol(n) , myThid )
       CALL GLOBAL_SUM_TILE_RL( tileMean(1,1,n), theMean(n), myThid )
       CALL GLOBAL_SUM_TILE_RL( tileVar(1,1,n) , theVar(n) , myThid )
      ENDDO

      DO n=1,nSepBnd
       IF (theVol(n).GT.0.) THEN
        theMean(n)= theMean(n)/theVol(n)
        theVar(n) = theVar(n) /theVol(n)
        theVar(n) = theVar(n) -theMean(n)*theMean(n)
        IF ( noPnts(n) ) theMin(n) = theMean(n)
        theMin(n) = -theMin(n)
        _GLOBAL_MAX_R8(theMin(n), myThid)
        theMin(n)=-theMin(n)
        IF ( noPnts(n) ) theMax(n) = theMin(n)
        _GLOBAL_MAX_R8(theMax(n), myThid)
       ENDIF
      ENDDO

      RETURN
      END

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

C     !INTERFACE:
      INTEGER FUNCTION NLATBND( nBnd, yBnd, yLoc )
      IMPLICIT NONE

C     !DESCRIPTION:
C     Find the latidude band of yLoc in nSep strip

C     !INPUT PARAMETERS:
C     nBnd :: Number of latitude bands
C     yBnd :: latitude of southern boundary (for each lat. band)
C     yLoc :: current latitude
      INTEGER nBnd
      _RS yBnd(nBnd)
      _RS yLoc
CEOP

C     !LOCAL VARIABLES:
      INTEGER n

      NLATBND = 1
      DO n=2,nBnd
       IF (yLoc .GT. yBnd(n)) NLATBND = n
      ENDDO

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1	jmc	1.7	C $Header: /u/gcmpack/MITgcm/pkg/monitor/mon_stats_latbnd_rl.F,v 1.6 2005/11/04 01:33:05 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "MONITOR_OPTIONS.h"
5
6	edhill	1.5	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7			CBOP
8			C !ROUTINE: MON_STATS_LATBND_RL
9
10			C !INTERFACE:
11	jmc	1.1	SUBROUTINE MON_STATS_LATBND_RL(
12	edhill	1.5	I myNr, mskNr, kLoc, nSepBnd, ySepBnd,
13			I arr, arrMask, arrhFac, arrArea, arrY, arrDr,
14			O theMin,theMax,theMean,theVar,theVol,
15			I myThid )
16
17			C !DESCRIPTION:
18			C Calculate bare statistics of global array "\_RL arr" on each
19			C Latitude band (given by \texttt{ySepBnd}).
20
21			C !USES:
22	jmc	1.1	IMPLICIT NONE
23			#include "SIZE.h"
24			#include "EEPARAMS.h"
25	edhill	1.5	INTEGER NLATBND
26			EXTERNAL NLATBND
27	jmc	1.1
28	edhill	1.5	C !INPUT PARAMETERS:
29	jmc	1.1	C nSepBnd :: Number of latitude bands
30	jmc	1.3	C ySepBnd :: Southern latitude egde (from 2 to nSepBnd, 1 is not used)
31	jmc	1.2	INTEGER myNr, mskNr, kLoc
32	jmc	1.1	INTEGER nSepBnd
33			_RS ySepBnd(nSepBnd)
34			_RL arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,myNr,nSx,nSy)
35	jmc	1.2	_RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy,mskNr,nSx,nSy)
36			_RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,mskNr,nSx,nSy)
37	jmc	1.1	_RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
38			_RS arrY(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
39			_RS arrDr(myNr)
40			_RL theMin(nSepBnd)
41			_RL theMax(nSepBnd)
42			_RL theMean(nSepBnd)
43			_RL theVar(nSepBnd)
44			_RL theVol(nSepBnd)
45			INTEGER myThid
46	edhill	1.5	CEOP
47	jmc	1.1
48	edhill	1.5	C !LOCAL VARIABLES:
49	jmc	1.7	C msgBuf :: Informational/error meesage buffer
50			CHARACTER*(MAX_LEN_MBUF) msgBuf
51	jmc	1.1	INTEGER bi,bj,i,j,k,n
52	jmc	1.2	INTEGER km, k1, k2
53	jmc	1.1	LOGICAL noPnts(Ny)
54	jmc	1.6	_RL tmpVal
55	jmc	1.1	_RL tmpVol
56	jmc	1.7	INTEGER nSepDim
57			PARAMETER ( nSepDim = 200 )
58			_RL tileVol (nSx,nSy,nSepDim)
59			_RL tileMean(nSx,nSy,nSepDim)
60			_RL tileVar (nSx,nSy,nSepDim)
61
62			C- Check local Dim
63			IF ( nSepBnd .GT. nSepDim ) THEN
64			WRITE(msgBuf,'(A,I6,A)')
65			& 'MON_STATS_LATBND_RL: local array Dim (nSepDim=',nSepDim,
66			& ' ) too small'
67			CALL PRINT_ERROR( msgBuf , myThid)
68			WRITE(msgBuf,'(A,I6)')
69			& 'MON_STATS_LATBND_RL: Need nSepDim to be at least =', nSepBnd
70			CALL PRINT_ERROR( msgBuf , myThid)
71			STOP 'ABNORMAL END: S/R MON_STATS_LATBND_RL'
72			ENDIF
73	jmc	1.1
74	jmc	1.2	IF ( kLoc.EQ.0 ) THEN
75			k1 = 1
76			k2 = myNr
77			ELSE
78			k1 = kLoc
79			k2 = kLoc
80			ENDIF
81
82	jmc	1.1	DO n=1,nSepBnd
83			noPnts(n)=.TRUE.
84			theMin(n)=0.
85			theMax(n)=0.
86			theMean(n)=0.
87			theVar(n)=0.
88			theVol(n)=0.
89			ENDDO
90
91			DO bj=myByLo(myThid),myByHi(myThid)
92			DO bi=myBxLo(myThid),myBxHi(myThid)
93	jmc	1.7	DO n=1,nSepBnd
94			tileVol (bi,bj,n) = 0.
95			tileMean(bi,bj,n) = 0.
96			tileVar (bi,bj,n) = 0.
97			ENDDO
98	jmc	1.2	DO k=k1,k2
99			km = MIN(k,mskNr)
100	jmc	1.1	DO j=1,sNy
101			DO i=1,sNx
102			n = NLATBND(nSepBnd, ySepBnd, arrY(i,j,bi,bj) )
103			tmpVal=arr(i,j,k,bi,bj)
104	jmc	1.2	IF (arrMask(i,j,km,bi,bj).NE.0. .AND. noPnts(n)) THEN
105	jmc	1.1	theMin(n)=tmpVal
106			theMax(n)=tmpVal
107			noPnts(n)=.FALSE.
108			ENDIF
109	jmc	1.2	IF (arrMask(i,j,km,bi,bj).NE.0.) THEN
110	jmc	1.3	theMin(n)=MIN(theMin(n),tmpVal)
111			theMax(n)=MAX(theMax(n),tmpVal)
112	jmc	1.2	tmpVol = arrArea(i,j,bi,bj)arrhFac(i,j,km,bi,bj)arrDr(k)
113			& *arrMask(i,j,km,bi,bj)
114	jmc	1.7	tileVol (bi,bj,n) = tileVol (bi,bj,n) + tmpVol
115			tileMean(bi,bj,n) = tileMean(bi,bj,n) + tmpVol*tmpVal
116			tileVar (bi,bj,n) = tileVar (bi,bj,n) + tmpVoltmpValtmpVal
117	jmc	1.1	ENDIF
118			ENDDO
119			ENDDO
120			ENDDO
121			ENDDO
122			ENDDO
123
124			DO n=1,nSepBnd
125	jmc	1.7	CALL GLOBAL_SUM_TILE_RL( tileVol(1,1,n) , theVol(n) , myThid )
126			CALL GLOBAL_SUM_TILE_RL( tileMean(1,1,n), theMean(n), myThid )
127			CALL GLOBAL_SUM_TILE_RL( tileVar(1,1,n) , theVar(n) , myThid )
128	jmc	1.1	ENDDO
129
130			DO n=1,nSepBnd
131			IF (theVol(n).GT.0.) THEN
132			theMean(n)= theMean(n)/theVol(n)
133			theVar(n) = theVar(n) /theVol(n)
134	jmc	1.4	theVar(n) = theVar(n) -theMean(n)*theMean(n)
135			IF ( noPnts(n) ) theMin(n) = theMean(n)
136			theMin(n) = -theMin(n)
137			_GLOBAL_MAX_R8(theMin(n), myThid)
138			theMin(n)=-theMin(n)
139			IF ( noPnts(n) ) theMax(n) = theMin(n)
140			_GLOBAL_MAX_R8(theMax(n), myThid)
141	jmc	1.1	ENDIF
142			ENDDO
143
144			RETURN
145			END
146	jmc	1.7
147	edhill	1.5	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
148	jmc	1.1	CBOP
149			C !ROUTINE: NLATBND
150
151			C !INTERFACE:
152			INTEGER FUNCTION NLATBND( nBnd, yBnd, yLoc )
153			IMPLICIT NONE
154
155			C !DESCRIPTION:
156	edhill	1.5	C Find the latidude band of yLoc in nSep strip
157
158	jmc	1.1	C !INPUT PARAMETERS:
159	jmc	1.3	C nBnd :: Number of latitude bands
160			C yBnd :: latitude of southern boundary (for each lat. band)
161	jmc	1.1	C yLoc :: current latitude
162			INTEGER nBnd
163	jmc	1.7	_RS yBnd(nBnd)
164	jmc	1.1	_RS yLoc
165	edhill	1.5	CEOP
166	jmc	1.1
167			C !LOCAL VARIABLES:
168			INTEGER n
169
170	jmc	1.3	NLATBND = 1
171			DO n=2,nBnd
172			IF (yLoc .GT. yBnd(n)) NLATBND = n
173	jmc	1.1	ENDDO
174
175			RETURN
176			END
177	edhill	1.5
178			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|