/[MITgcm]/MITgcm/pkg/diagnostics/diagstats_local.F
ViewVC logotype

Diff of /MITgcm/pkg/diagnostics/diagstats_local.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by jmc, Fri May 20 07:28:52 2005 UTC revision 1.9 by jmc, Mon Dec 21 00:10:07 2009 UTC
# Line 8  C     !ROUTINE: DIAGSTATS_LOCAL Line 8  C     !ROUTINE: DIAGSTATS_LOCAL
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE DIAGSTATS_LOCAL(        SUBROUTINE DIAGSTATS_LOCAL(
10       U                  statFld,       U                  statFld,
11       I                  inpFld,       I                  inpFld, frcFld,
12         I                  scaleFact, power, useFract, sizF,
13       I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,
14       I                  iRun,jRun,kIn,biIn,bjIn,       I                  iRun,jRun,kIn,biIn,bjIn,
15       I                  k,bi,bj, region2fill, ndId, parsFld,       I                  k,bi,bj, region2fill, ndId, parsFld,
16       I                  myThid)       I                  myThid )
17    
18  C     !DESCRIPTION:  C     !DESCRIPTION:
19  C     Update array statFld  C     Update array statFld
20  C     by adding statistics over the range [1:iRun],[1:jRun]  C     by adding statistics over the range [1:iRun],[1:jRun]
21  C     from input field array inpFld  C     from input field array inpFld
22  C- note:  C- note:
23  C   a) this S/R should not see DIAGNOSTICS pkg commons blocks (in DIAGNOSTICS.h)  C   a) this S/R should not see DIAGNOSTICS pkg commons blocks (in DIAGNOSTICS.h)
24  C   b) for main grid variables, get area & weigting factors (to compute global mean)  C   b) for main grid variables, get area & weigting factors (to compute global mean)
25  C      from the main common blocks.  C      from the main common blocks.
26  C   c) for other type of grids, call a specifics S/R which include its own  C   c) for other type of grids, call a specifics S/R which include its own
27  C      grid common blocks  C      grid common blocks
28    
29  C     !USES:  C     !USES:
# Line 31  C     !USES: Line 32  C     !USES:
32  #include "EEPARAMS.h"  #include "EEPARAMS.h"
33  #include "SIZE.h"  #include "SIZE.h"
34  #include "DIAGNOSTICS_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
35    #include "DIAGSTATS_REGIONS.h"
36  #include "PARAMS.h"  #include "PARAMS.h"
37  #include "GRID.h"  #include "GRID.h"
38  #include "SURFACE.h"  c #include "SURFACE.h"
 #ifdef ALLOW_FIZHI  
 #include "fizhi_SIZE.h"  
 #include "gridalt_mapping.h"  
 #endif  
39    
40  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
41  C     == Routine Arguments ==  C     == Routine Arguments ==
42  C     statFld     :: cumulative statistics array (updated)  C     statFld     :: cumulative statistics array (updated)
43  C     inpFld      :: input field array to process (compute stats & add to statFld)  C     inpFld      :: input field array to process (compute stats & add to statFld)
44    C     frcFld      :: fraction used for weighted-average diagnostics
45    C     scaleFact   :: scaling factor
46    C     power       :: option to fill-in with the field square (power=2)
47    C     useFract    :: if True, use fraction-weight
48    C     sizF        :: size of frcFld array: 3rd  dimension
49  C     sizI1,sizI2 :: size of inpFld array: 1rst index range (min,max)  C     sizI1,sizI2 :: size of inpFld array: 1rst index range (min,max)
50  C     sizJ1,sizJ2 :: size of inpFld array: 2nd  index range (min,max)  C     sizJ1,sizJ2 :: size of inpFld array: 2nd  index range (min,max)
51  C     sizK        :: size of inpFld array: 3rd  dimension  C     sizK        :: size of inpFld array: 3rd  dimension
52  C     sizTx,sizTy :: size of inpFld array: tile dimensions  C     sizTx,sizTy :: size of inpFld array: tile dimensions
53  C     iRun,jRun   :: range of 1rst & 2nd index  C     iRun,jRun   :: range of 1rst & 2nd index
54  C     kIn         :: level index of inFld array to porcess  C     kIn         :: level index of inpFld array to process
55  C     biIn,bjIn   :: tile indices of inFld array to process  C     biIn,bjIn   :: tile indices of inpFld array to process
56  C     k,bi,bj     :: level and tile indices used for weighting (mask,area ...)  C     k,bi,bj     :: level and tile indices used for weighting (mask,area ...)
57  C     region2fill :: indicates whether to compute statistics over this region  C     region2fill :: indicates whether to compute statistics over this region
58  C     ndId        :: Diagnostics Id Number (in available diag. list)  C     ndId        :: Diagnostics Id Number (in available diag. list)
# Line 57  C     parsFld     :: parser field with c Line 60  C     parsFld     :: parser field with c
60  C     myThid      :: my Thread Id number  C     myThid      :: my Thread Id number
61        _RL     statFld(0:nStats,0:nRegions)        _RL     statFld(0:nStats,0:nRegions)
62        INTEGER sizI1,sizI2,sizJ1,sizJ2        INTEGER sizI1,sizI2,sizJ1,sizJ2
63        INTEGER sizK,sizTx,sizTy        INTEGER sizF,sizK,sizTx,sizTy
64        _RL     inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)        _RL     inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)
65          _RL     frcFld(sizI1:sizI2,sizJ1:sizJ2,sizF,sizTx,sizTy)
66          _RL     scaleFact
67          INTEGER power
68          LOGICAL useFract
69        INTEGER iRun, jRun, kIn, biIn, bjIn        INTEGER iRun, jRun, kIn, biIn, bjIn
70        INTEGER k, bi, bj, ndId        INTEGER k, bi, bj, ndId
71        INTEGER region2fill(0:nRegions)        INTEGER region2fill(0:nRegions)
# Line 66  C     myThid      :: my Thread Id number Line 73  C     myThid      :: my Thread Id number
73        INTEGER myThid        INTEGER myThid
74  CEOP  CEOP
75    
76    C     !FUNCTIONS:
77    #ifdef ALLOW_FIZHI
78          _RL   getcon
79          EXTERNAL getcon
80    #endif
81    
82  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
83  C     i,j    :: loop indices  C     i,j    :: loop indices
84        INTEGER i, n, km        INTEGER i, n, kFr, kRegMsk
85        INTEGER im, ix, iv        INTEGER im, ix, iv
86        PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )        PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )
87        LOGICAL exclSpVal        LOGICAL exclSpVal
# Line 76  C     i,j    :: loop indices Line 89  C     i,j    :: loop indices
89        _RL statLoc(0:nStats)        _RL statLoc(0:nStats)
90        _RL drLoc        _RL drLoc
91        _RL specialVal        _RL specialVal
       _RL getcon  
       EXTERNAL getcon  
92    
93  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
94    
95        useWeight = .FALSE.        useWeight = .FALSE.
96        exclSpVal = .FALSE.        exclSpVal = .FALSE.
97        specialVal = 0.        specialVal = 0.
98    #ifdef ALLOW_FIZHI
99        IF ( useFIZHI ) THEN        IF ( useFIZHI ) THEN
100          exclSpVal = .TRUE.          exclSpVal = .TRUE.
101          specialVal = getcon('UNDEF')          specialVal = getcon('UNDEF')
102        ENDIF        ENDIF
103            #endif
104          kFr = MIN(kIn,sizF)
105    
106        DO n=0,nRegions        DO n=0,nRegions
107         IF (region2fill(n).NE.0) THEN         IF (region2fill(n).NE.0) THEN
108  C---   Compute statistics for this tile, level and region:  C---   Compute statistics for this tile, level and region:
109          
110  C-     case of a special region (no specific regional mask)           kRegMsk = diagSt_kRegMsk(n)
         IF ( n.EQ.0 ) THEN  
111    
112           IF ( parsFld(10:10) .EQ. 'R' ) THEN           IF ( parsFld(10:10) .EQ. 'R' ) THEN
113    
# Line 104  C-     case of a special region (no spec Line 117  C-     case of a special region (no spec
117            IF ( parsFld(9:9).EQ.'M') useWeight = .TRUE.            IF ( parsFld(9:9).EQ.'M') useWeight = .TRUE.
118    
119            IF     ( parsFld(2:2).EQ.'U' ) THEN            IF     ( parsFld(2:2).EQ.'U' ) THEN
120             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
121       O            statLoc,       O            statLoc,
122       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
123       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
124       I            maskH(1-Olx,1-Oly,bi,bj), maskW(1-Olx,1-Oly,k,bi,bj),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
125       I            hFacW(1-Olx,1-Oly,k,bi,bj), rAw(1-Olx,1-Oly,bi,bj),       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
126         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
127         I            maskW(1-Olx,1-Oly,k,bi,bj),
128         I            hFacW(1-Olx,1-Oly,k,bi,bj), rAw(1-Olx,1-Oly,bi,bj),
129       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
130  c    I            drLoc, k,bi,bj, parsFld, myThid )  c    I            drLoc, k,bi,bj, parsFld, myThid )
131            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
132             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
133       O            statLoc,       O            statLoc,
134       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
135       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
136       I            maskH(1-Olx,1-Oly,bi,bj), maskS(1-Olx,1-Oly,k,bi,bj),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
137       I            hFacS(1-Olx,1-Oly,k,bi,bj), rAs(1-Olx,1-Oly,bi,bj),       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
138         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
139         I            maskS(1-Olx,1-Oly,k,bi,bj),
140         I            hFacS(1-Olx,1-Oly,k,bi,bj), rAs(1-Olx,1-Oly,bi,bj),
141       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
142            ELSE            ELSE
143             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
144       O            statLoc,       O            statLoc,
145       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
146       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
147       I            maskH(1-Olx,1-Oly,bi,bj), maskC(1-Olx,1-Oly,k,bi,bj),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
148         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
149         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
150         I            maskC(1-Olx,1-Oly,k,bi,bj),
151       I            hFacC(1-Olx,1-Oly,k,bi,bj), rA(1-Olx,1-Oly,bi,bj),       I            hFacC(1-Olx,1-Oly,k,bi,bj), rA(1-Olx,1-Oly,bi,bj),
152       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
153            ENDIF            ENDIF
154    
155  #ifdef ALLOW_FIZHI           ELSEIF ( useFIZHI .AND.
156  c        ELSEIF ( parsFld(10:10) .EQ. 'L' ) THEN       &           (parsFld(10:10).EQ.'L' .OR. parsFld(10:10).EQ.'M')
157           ELSEIF ( parsFld(10:10) .EQ. 'M' ) THEN       &          ) THEN
158             drLoc = 1. _d 0             CALL  DIAGSTATS_LM_CALC(
159             km = 1 + Nrphys - k       O            statLoc,
160             CALL  DIAGSTATS_R_CALC(       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
161       O            statLoc,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
162       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
163       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
164       I            maskH(1-Olx,1-Oly,bi,bj), maskH(1-Olx,1-Oly,bi,bj),       I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
165       I            dpphys(1-Olx,1-Oly,km,bi,bj), rA(1-Olx,1-Oly,bi,bj),       I            maskInC(1-Olx,1-Oly,bi,bj), rA(1-Olx,1-Oly,bi,bj),
166       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            specialVal, exclSpVal,
167  #endif       I            k,bi,bj, parsFld, myThid )
168  #ifdef ALLOW_LAND           ELSEIF ( useLand .AND.
169  c        ELSEIF ( parsFld(10:10) .EQ. 'G' ) THEN       &           (parsFld(10:10).EQ.'G' .OR. parsFld(10:10).EQ.'g')
170  #endif       &          ) THEN
171               CALL  DIAGSTATS_G_CALC(
172         O            statLoc,
173         I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
174         I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
175         I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
176         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
177         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
178         I            rA(1-Olx,1-Oly,bi,bj),
179         I            specialVal, exclSpVal,
180         I            k,bi,bj, parsFld, myThid )
181  c        ELSEIF ( parsFld(10:10) .EQ. 'I' ) THEN  c        ELSEIF ( parsFld(10:10) .EQ. 'I' ) THEN
182  c        ELSEIF ( parsFld(10:10) .EQ. '1' ) THEN  c        ELSEIF ( parsFld(10:10) .EQ. '1' ) THEN
183           ELSE           ELSE
184    
           km = 1  
           IF ( usingPCoords ) km = Nr  
185            drLoc = 1. _d 0            drLoc = 1. _d 0
186            IF     ( parsFld(2:2).EQ.'U' ) THEN            IF     ( parsFld(2:2).EQ.'U' ) THEN
187             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
188       O            statLoc,       O            statLoc,
189       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
190       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
191       I            maskH(1-Olx,1-Oly,bi,bj), maskW(1-Olx,1-Oly,km,bi,bj),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
192       I            maskW(1-Olx,1-Oly,km,bi,bj),rAw(1-Olx,1-Oly,bi,bj),       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
193         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
194         I            maskInW(1-Olx,1-Oly,bi,bj),
195         I            maskInW(1-Olx,1-Oly,bi,bj),rAw(1-Olx,1-Oly,bi,bj),
196       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
197            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
198             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
199       O            statLoc,       O            statLoc,
200       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
201       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
202       I            maskH(1-Olx,1-Oly,bi,bj), maskS(1-Olx,1-Oly,km,bi,bj),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
203       I            maskS(1-Olx,1-Oly,km,bi,bj),rAs(1-Olx,1-Oly,bi,bj),       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
204         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
205         I            maskInS(1-Olx,1-Oly,bi,bj),
206         I            maskInS(1-Olx,1-Oly,bi,bj),rAs(1-Olx,1-Oly,bi,bj),
207       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
208            ELSE            ELSE
209             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
210       O            statLoc,       O            statLoc,
211       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
212       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
213       I            maskH(1-Olx,1-Oly,bi,bj), maskH(1-Olx,1-Oly,bi,bj),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
214       I            maskH(1-Olx,1-Oly,bi,bj), rA(1-Olx,1-Oly,bi,bj),       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
215         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
216         I            maskInC(1-Olx,1-Oly,bi,bj),
217         I            maskInC(1-Olx,1-Oly,bi,bj), rA(1-Olx,1-Oly,bi,bj),
218       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
219            ENDIF            ENDIF
220    
221           ENDIF           ENDIF
222    
223  C     Update cumulative statistics array  C     Update cumulative statistics array
224            IF ( statLoc(0).GT.0. ) THEN           IF ( statLoc(0).GT.0. ) THEN
225              IF ( statFld(0,n).LE.0. ) THEN              IF ( statFld(0,n).LE.0. ) THEN
226                statFld(im,n) = statLoc(im)                statFld(im,n) = statLoc(im)
227                statFld(ix,n) = statLoc(ix)                statFld(ix,n) = statLoc(ix)
# Line 193  C     Update cumulative statistics array Line 232  C     Update cumulative statistics array
232              DO i=0,iv              DO i=0,iv
233                statFld(i,n) = statFld(i,n) + statLoc(i)                statFld(i,n) = statFld(i,n) + statLoc(i)
234              ENDDO              ENDDO
235            ENDIF           ENDIF
   
         ENDIF  
236    
237  C---   processing region "n" ends here.  C---   processing region "n" ends here.
238         ENDIF         ENDIF
239        ENDDO        ENDDO
240    
241        RETURN        RETURN
       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
 CBOP  
 C     !ROUTINE: DIAGSTATS_CALC  
 C     !INTERFACE:  
       SUBROUTINE DIAGSTATS_R_CALC(  
      U                  statArr,  
      I                  inpArr,  
      I                  sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,  
      I                  regMask, arrMask, arrhFac, arrArea,  
      I                  arrDr, specialVal, exclSpVal, useWeight,  
      I                  myThid )  
 c    I                  arrDr, k,bi,bj, parsFld, myThid )  
   
 C     !DESCRIPTION:  
 C     Compute statistics for this tile, level, region  
   
 C     !USES:  
       IMPLICIT NONE  
   
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
 #include "DIAGNOSTICS_SIZE.h"  
 c #include "PARAMS.h"  
 c #include "GRID.h"  
 c #include "SURFACE.h"  
   
 C     !INPUT/OUTPUT PARAMETERS:  
 C     == Routine Arguments ==  
 C     statArr     :: cumulative statistics array (updated)  
 C     inpArr      :: input field array to process (compute stats & add to statFld)  
 C     sizI1,sizI2 :: size of inpArr array: 1rst index range (min,max)  
 C     sizJ1,sizJ2 :: size of inpArr array: 2nd  index range (min,max)  
 C     iRun,jRun   :: range of 1rst & 2nd index to process  
 C     regMask     :: regional mask  
 C     arrMask     :: mask for this input array  
 C     arrhFac     :: weight factor (horizontally varying)  
 C     arrArea     :: Area weighting factor  
 C     arrDr       :: uniform weighting factor  
 C     specialVal  :: special value in input array (to exclude if exclSpVal=T)  
 C     exclSpVal   :: if T, exclude "specialVal" in input array  
 C     useWeight   :: use weight factor "arrhFac"  
 Cc    k,bi,bj     :: level and tile indices used for weighting (mask,area ...)  
 Cc    parsFld     :: parser field with characteristics of the diagnostics  
 C     myThid      :: my Thread Id number  
       _RL statArr(0:nStats)  
       INTEGER sizI1,sizI2,sizJ1,sizJ2  
       INTEGER iRun, jRun  
       _RL inpArr (sizI1:sizI2,sizJ1:sizJ2)  
       _RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL arrDr  
       _RL specialVal  
       LOGICAL exclSpVal  
       LOGICAL useWeight  
 c     INTEGER k, bi, bj  
 c     CHARACTER*16 parsFld  
       INTEGER myThid  
 CEOP  
   
 C     !LOCAL VARIABLES:  
 C     i,j    :: loop indices  
       INTEGER i, j, n  
       INTEGER im, ix, iv  
       PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )  
       _RL tmpVol  
   
       DO n=0,nStats  
         statArr(n) = 0.  
       ENDDO  
   
       IF ( exclSpVal ) THEN  
   
        DO j = 1,jRun  
         DO i = 1,iRun  
           IF (arrMask(i,j).NE.0. .AND. inpArr(i,j).NE.specialVal) THEN  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = inpArr(i,j)  
               statArr(ix) = inpArr(i,j)  
             ELSE  
               statArr(im) = MIN(inpArr(i,j),statArr(im))  
               statArr(ix) = MAX(inpArr(i,j),statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*inpArr(i,j)  
             statArr(2) = statArr(2) + tmpVol*inpArr(i,j)*inpArr(i,j)  
           ENDIF  
         ENDDO  
        ENDDO  
   
       ELSE  
   
        DO j = 1,jRun  
         DO i = 1,iRun  
 c         IF ( regMask(i,j).NE.0. .AND. arrMask(i,j).NE.0. ) THEN  
           IF ( arrMask(i,j).NE.0. ) THEN  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = inpArr(i,j)  
               statArr(ix) = inpArr(i,j)  
             ELSE  
               statArr(im) = MIN(inpArr(i,j),statArr(im))  
               statArr(ix) = MAX(inpArr(i,j),statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*inpArr(i,j)  
             statArr(2) = statArr(2) + tmpVol*inpArr(i,j)*inpArr(i,j)  
           ENDIF  
         ENDDO  
        ENDDO  
   
       ENDIF  
   
       RETURN  
242        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22