/[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.6 by jmc, Mon Jan 23 22:31:10 2006 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 porcess
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 68  CEOP Line 75  CEOP
75    
76  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
77  C     i,j    :: loop indices  C     i,j    :: loop indices
78        INTEGER i, n, km        INTEGER i, n, km, kFr, kRegMsk
79        INTEGER im, ix, iv        INTEGER im, ix, iv
80        PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )        PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )
81        LOGICAL exclSpVal        LOGICAL exclSpVal
# Line 86  C---+----1----+----2----+----3----+----4 Line 93  C---+----1----+----2----+----3----+----4
93        specialVal = 0.        specialVal = 0.
94        IF ( useFIZHI ) THEN        IF ( useFIZHI ) THEN
95          exclSpVal = .TRUE.          exclSpVal = .TRUE.
96          specialVal = getcon('UNDEF')          specialVal = getcon('UNDEF')
97        ENDIF        ENDIF
98                  kFr = MIN(kIn,sizF)
99    
100        DO n=0,nRegions        DO n=0,nRegions
101         IF (region2fill(n).NE.0) THEN         IF (region2fill(n).NE.0) THEN
102  C---   Compute statistics for this tile, level and region:  C---   Compute statistics for this tile, level and region:
103          
104  C-     case of a special region (no specific regional mask)           kRegMsk = diagSt_kRegMsk(n)
         IF ( n.EQ.0 ) THEN  
105    
106           IF ( parsFld(10:10) .EQ. 'R' ) THEN           IF ( parsFld(10:10) .EQ. 'R' ) THEN
107    
# Line 104  C-     case of a special region (no spec Line 111  C-     case of a special region (no spec
111            IF ( parsFld(9:9).EQ.'M') useWeight = .TRUE.            IF ( parsFld(9:9).EQ.'M') useWeight = .TRUE.
112    
113            IF     ( parsFld(2:2).EQ.'U' ) THEN            IF     ( parsFld(2:2).EQ.'U' ) THEN
114             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
115       O            statLoc,       O            statLoc,
116       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
117       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
118       I            maskH(1-Olx,1-Oly,bi,bj), maskW(1-Olx,1-Oly,k,bi,bj),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
119       I            hFacW(1-Olx,1-Oly,k,bi,bj), rAw(1-Olx,1-Oly,bi,bj),       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
120         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
121         I            maskW(1-Olx,1-Oly,k,bi,bj),
122         I            hFacW(1-Olx,1-Oly,k,bi,bj), rAw(1-Olx,1-Oly,bi,bj),
123       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
124  c    I            drLoc, k,bi,bj, parsFld, myThid )  c    I            drLoc, k,bi,bj, parsFld, myThid )
125            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
126             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
127       O            statLoc,       O            statLoc,
128       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
129       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
130       I            maskH(1-Olx,1-Oly,bi,bj), maskS(1-Olx,1-Oly,k,bi,bj),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
131       I            hFacS(1-Olx,1-Oly,k,bi,bj), rAs(1-Olx,1-Oly,bi,bj),       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
132         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
133         I            maskS(1-Olx,1-Oly,k,bi,bj),
134         I            hFacS(1-Olx,1-Oly,k,bi,bj), rAs(1-Olx,1-Oly,bi,bj),
135       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
136            ELSE            ELSE
137             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
138       O            statLoc,       O            statLoc,
139       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
140       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
141       I            maskH(1-Olx,1-Oly,bi,bj), maskC(1-Olx,1-Oly,k,bi,bj),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
142         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
143         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
144         I            maskC(1-Olx,1-Oly,k,bi,bj),
145       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),
146       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
147            ENDIF            ENDIF
148    
149  #ifdef ALLOW_FIZHI           ELSEIF ( useFIZHI .AND.
150  c        ELSEIF ( parsFld(10:10) .EQ. 'L' ) THEN       &           (parsFld(10:10).EQ.'L' .OR. parsFld(10:10).EQ.'M')
151           ELSEIF ( parsFld(10:10) .EQ. 'M' ) THEN       &          ) THEN
152             drLoc = 1. _d 0             CALL  DIAGSTATS_LM_CALC(
            km = 1 + Nrphys - k  
            CALL  DIAGSTATS_R_CALC(  
153       O            statLoc,       O            statLoc,
154       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
155       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
156       I            maskH(1-Olx,1-Oly,bi,bj), maskH(1-Olx,1-Oly,bi,bj),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
157       I            dpphys(1-Olx,1-Oly,km,bi,bj), rA(1-Olx,1-Oly,bi,bj),       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
158       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
159  #endif       I            maskH(1-Olx,1-Oly,bi,bj), rA(1-Olx,1-Oly,bi,bj),
160  #ifdef ALLOW_LAND       I            specialVal, exclSpVal,
161  c        ELSEIF ( parsFld(10:10) .EQ. 'G' ) THEN       I            k,bi,bj, parsFld, myThid )
162  #endif           ELSEIF ( useLand .AND.
163         &           (parsFld(10:10).EQ.'G' .OR. parsFld(10:10).EQ.'g')
164         &          ) THEN
165               CALL  DIAGSTATS_G_CALC(
166         O            statLoc,
167         I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
168         I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
169         I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
170         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
171         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
172         I            rA(1-Olx,1-Oly,bi,bj),
173         I            specialVal, exclSpVal,
174         I            k,bi,bj, parsFld, myThid )
175  c        ELSEIF ( parsFld(10:10) .EQ. 'I' ) THEN  c        ELSEIF ( parsFld(10:10) .EQ. 'I' ) THEN
176  c        ELSEIF ( parsFld(10:10) .EQ. '1' ) THEN  c        ELSEIF ( parsFld(10:10) .EQ. '1' ) THEN
177           ELSE           ELSE
# Line 154  c        ELSEIF ( parsFld(10:10) .EQ. '1 Line 180  c        ELSEIF ( parsFld(10:10) .EQ. '1
180            IF ( usingPCoords ) km = Nr            IF ( usingPCoords ) km = Nr
181            drLoc = 1. _d 0            drLoc = 1. _d 0
182            IF     ( parsFld(2:2).EQ.'U' ) THEN            IF     ( parsFld(2:2).EQ.'U' ) THEN
183             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
184       O            statLoc,       O            statLoc,
185       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
186       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
187       I            maskH(1-Olx,1-Oly,bi,bj), maskW(1-Olx,1-Oly,km,bi,bj),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
188       I            maskW(1-Olx,1-Oly,km,bi,bj),rAw(1-Olx,1-Oly,bi,bj),       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
189         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
190         I            maskW(1-Olx,1-Oly,km,bi,bj),
191         I            maskW(1-Olx,1-Oly,km,bi,bj),rAw(1-Olx,1-Oly,bi,bj),
192       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
193            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
194             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
195       O            statLoc,       O            statLoc,
196       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
197       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
198       I            maskH(1-Olx,1-Oly,bi,bj), maskS(1-Olx,1-Oly,km,bi,bj),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
199       I            maskS(1-Olx,1-Oly,km,bi,bj),rAs(1-Olx,1-Oly,bi,bj),       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
200         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
201         I            maskS(1-Olx,1-Oly,km,bi,bj),
202         I            maskS(1-Olx,1-Oly,km,bi,bj),rAs(1-Olx,1-Oly,bi,bj),
203       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
204            ELSE            ELSE
205             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
206       O            statLoc,       O            statLoc,
207       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
208       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
209       I            maskH(1-Olx,1-Oly,bi,bj), maskH(1-Olx,1-Oly,bi,bj),       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
210         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
211         I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
212         I            maskH(1-Olx,1-Oly,bi,bj),
213       I            maskH(1-Olx,1-Oly,bi,bj), rA(1-Olx,1-Oly,bi,bj),       I            maskH(1-Olx,1-Oly,bi,bj), rA(1-Olx,1-Oly,bi,bj),
214       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
215            ENDIF            ENDIF
# Line 182  c        ELSEIF ( parsFld(10:10) .EQ. '1 Line 217  c        ELSEIF ( parsFld(10:10) .EQ. '1
217           ENDIF           ENDIF
218    
219  C     Update cumulative statistics array  C     Update cumulative statistics array
220            IF ( statLoc(0).GT.0. ) THEN           IF ( statLoc(0).GT.0. ) THEN
221              IF ( statFld(0,n).LE.0. ) THEN              IF ( statFld(0,n).LE.0. ) THEN
222                statFld(im,n) = statLoc(im)                statFld(im,n) = statLoc(im)
223                statFld(ix,n) = statLoc(ix)                statFld(ix,n) = statLoc(ix)
# Line 193  C     Update cumulative statistics array Line 228  C     Update cumulative statistics array
228              DO i=0,iv              DO i=0,iv
229                statFld(i,n) = statFld(i,n) + statLoc(i)                statFld(i,n) = statFld(i,n) + statLoc(i)
230              ENDDO              ENDDO
231            ENDIF           ENDIF
   
         ENDIF  
232    
233  C---   processing region "n" ends here.  C---   processing region "n" ends here.
234         ENDIF         ENDIF
235        ENDDO        ENDDO
236    
237        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  
238        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22