/[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.5 by jmc, Fri Nov 4 01:30:33 2005 UTC revision 1.6 by jmc, Mon Jan 23 22:31:10 2006 UTC
# Line 32  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  c #include "SURFACE.h"  c #include "SURFACE.h"
# Line 74  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, kFr        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 100  C---+----1----+----2----+----3----+----4 Line 101  C---+----1----+----2----+----3----+----4
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 115  C-     case of a special region (no spec Line 115  C-     case of a special region (no spec
115       O            statLoc,       O            statLoc,
116       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
117       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
118       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
119       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
120       I            maskH(1-Olx,1-Oly,bi,bj), maskW(1-Olx,1-Oly,k,bi,bj),       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),       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 )
# Line 126  c    I            drLoc, k,bi,bj, parsFl Line 127  c    I            drLoc, k,bi,bj, parsFl
127       O            statLoc,       O            statLoc,
128       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
129       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
130       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
131       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
132       I            maskH(1-Olx,1-Oly,bi,bj), maskS(1-Olx,1-Oly,k,bi,bj),       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),       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
# Line 136  c    I            drLoc, k,bi,bj, parsFl Line 138  c    I            drLoc, k,bi,bj, parsFl
138       O            statLoc,       O            statLoc,
139       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
140       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
141       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
142       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
143       I            maskH(1-Olx,1-Oly,bi,bj), maskC(1-Olx,1-Oly,k,bi,bj),       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
# Line 150  c    I            drLoc, k,bi,bj, parsFl Line 153  c    I            drLoc, k,bi,bj, parsFl
153       O            statLoc,       O            statLoc,
154       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
155       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
156       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
157       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
158       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),
159       I            rA(1-Olx,1-Oly,bi,bj),       I            maskH(1-Olx,1-Oly,bi,bj), rA(1-Olx,1-Oly,bi,bj),
160       I            specialVal, exclSpVal,       I            specialVal, exclSpVal,
161       I            k,bi,bj, parsFld, myThid )       I            k,bi,bj, parsFld, myThid )
162           ELSEIF ( useLand .AND.           ELSEIF ( useLand .AND.
# Line 163  c    I            drLoc, k,bi,bj, parsFl Line 166  c    I            drLoc, k,bi,bj, parsFl
166       O            statLoc,       O            statLoc,
167       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
168       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
169       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
170       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
171       I            maskH(1-Olx,1-Oly,bi,bj),       I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
172       I            rA(1-Olx,1-Oly,bi,bj),       I            rA(1-Olx,1-Oly,bi,bj),
173       I            specialVal, exclSpVal,       I            specialVal, exclSpVal,
174       I            k,bi,bj, parsFld, myThid )       I            k,bi,bj, parsFld, myThid )
# Line 181  c        ELSEIF ( parsFld(10:10) .EQ. '1 Line 184  c        ELSEIF ( parsFld(10:10) .EQ. '1
184       O            statLoc,       O            statLoc,
185       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
186       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
187       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
188       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
189       I            maskH(1-Olx,1-Oly,bi,bj), maskW(1-Olx,1-Oly,km,bi,bj),       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),       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
# Line 191  c        ELSEIF ( parsFld(10:10) .EQ. '1 Line 195  c        ELSEIF ( parsFld(10:10) .EQ. '1
195       O            statLoc,       O            statLoc,
196       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
197       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
198       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
199       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
200       I            maskH(1-Olx,1-Oly,bi,bj), maskS(1-Olx,1-Oly,km,bi,bj),       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),       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
# Line 201  c        ELSEIF ( parsFld(10:10) .EQ. '1 Line 206  c        ELSEIF ( parsFld(10:10) .EQ. '1
206       O            statLoc,       O            statLoc,
207       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
208       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
209       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
210       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
211       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),
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 211  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 222  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
# Line 232  C---   processing region "n" ends here. Line 236  C---   processing region "n" ends here.
236    
237        RETURN        RETURN
238        END        END
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
 CBOP  
 C     !ROUTINE: DIAGSTATS_LM_CALC  
 C     !INTERFACE:  
       SUBROUTINE DIAGSTATS_LM_CALC(  
      O                  statArr,  
      I                  inpArr, frcArr, scaleFact, power, useFract,  
      I                  nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,  
      I                  regMask, arrMask, arrArea,  
      I                  specialVal, exclSpVal,  
      I                  k,bi,bj, parsFld, myThid )  
   
 C     !DESCRIPTION:  
 C     Compute statistics for this tile, level, region  
 C     using FIZHI level thickness  
   
 C     !USES:  
       IMPLICIT NONE  
   
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
 #ifdef ALLOW_FIZHI  
 #include "fizhi_SIZE.h"  
 #include "gridalt_mapping.h"  
 #endif  
   
 C     !INPUT/OUTPUT PARAMETERS:  
 C     == Routine Arguments ==  
 C     statArr     :: output statistics array  
 C     inpArr      :: input field array to process (compute stats & add to statFld)  
 C     frcArr      :: fraction used for weighted-average diagnostics  
 C     scaleFact   :: scaling factor  
 C     power       :: option to fill-in with the field square (power=2)  
 C     useFract    :: if True, use fraction-weight  
 C     nStats      :: size of output statArr  
 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     arrArea     :: Area weighting factor  
 C     specialVal  :: special value in input array (to exclude if exclSpVal=T)  
 C     exclSpVal   :: if T, exclude "specialVal" in input array  
 C     k,bi,bj     :: level and tile indices used for weighting (mask,area ...)  
 C     parsFld     :: parser field with characteristics of the diagnostics  
 C     myThid      :: my Thread Id number  
       INTEGER nStats,sizI1,sizI2,sizJ1,sizJ2  
       INTEGER iRun, jRun  
       _RL statArr(0:nStats)  
       _RL inpArr (sizI1:sizI2,sizJ1:sizJ2)  
       _RL frcArr (sizI1:sizI2,sizJ1:sizJ2)  
       _RL scaleFact  
       INTEGER power  
       LOGICAL useFract  
       _RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL specialVal  
       LOGICAL exclSpVal  
       INTEGER k, bi, bj  
       CHARACTER*16 parsFld  
       INTEGER myThid  
 CEOP  
   
 #ifdef ALLOW_FIZHI  
 C     !LOCAL VARIABLES:  
       LOGICAL useWeight  
       INTEGER kl  
       _RL drLoc  
   
 c     IF ( useFIZHI ) THEN  
   
         IF ( parsFld(10:10).EQ.'L' ) THEN  
           kl = 1 + Nrphys - k  
           useWeight = .TRUE.  
         ELSE  
           kl = 1  
           useWeight = .FALSE.  
         ENDIF  
         drLoc = 1. _d 0  
   
 C- jmc: here we have a Problem if RL & RS are not the same:  
 C    since dpphys is RL but argument is RS. leave it like this for now  
 C    and will change it once the Regions are fully implemented.  
   
         CALL  DIAGSTATS_CALC(  
      O            statArr,  
      I            inpArr, frcArr, scaleFact, power, useFract,  
      I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,  
      I            regMask, arrMask,  
      I            dpphys(1-Olx,1-Oly,kl,bi,bj), arrArea,  
      I            drLoc, specialVal, exclSpVal, useWeight, myThid )  
   
 c     ENDIF  
 #endif /* ALLOW_FIZHI */  
   
       RETURN  
       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
 CBOP  
 C     !ROUTINE: DIAGSTATS_G_CALC  
 C     !INTERFACE:  
       SUBROUTINE DIAGSTATS_G_CALC(  
      O                  statArr,  
      I                  inpArr, frcArr, scaleFact, power, useFract,  
      I                  nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,  
      I                  regMask, arrArea,  
      I                  specialVal, exclSpVal,  
      I                  k,bi,bj, parsFld, myThid )  
   
 C     !DESCRIPTION:  
 C     Compute statistics for this tile, level, region  
 C     using "ground" (land) type fraction  
   
 C     !USES:  
       IMPLICIT NONE  
   
 #include "EEPARAMS.h"  
 #ifdef ALLOW_LAND  
 # include "LAND_SIZE.h"  
 # include "LAND_PARAMS.h"  
 # ifdef ALLOW_AIM  
 #  include "AIM_FFIELDS.h"  
 # endif  
 #else  
 # include "SIZE.h"  
 #endif  
   
 C     !INPUT/OUTPUT PARAMETERS:  
 C     == Routine Arguments ==  
 C     statArr     :: output statistics array  
 C     inpArr      :: input field array to process (compute stats & add to statFld)  
 C     frcArr      :: fraction used for weighted-average diagnostics  
 C     scaleFact   :: scaling factor  
 C     power       :: option to fill-in with the field square (power=2)  
 C     useFract    :: if True, use fraction-weight  
 C     nStats      :: size of output statArr  
 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     arrArea     :: Area weighting factor  
 C     specialVal  :: special value in input array (to exclude if exclSpVal=T)  
 C     exclSpVal   :: if T, exclude "specialVal" in input array  
 C     k,bi,bj     :: level and tile indices used for weighting (mask,area ...)  
 C     parsFld     :: parser field with characteristics of the diagnostics  
 C     myThid      :: my Thread Id number  
       INTEGER nStats,sizI1,sizI2,sizJ1,sizJ2  
       INTEGER iRun, jRun  
       _RL statArr(0:nStats)  
       _RL inpArr (sizI1:sizI2,sizJ1:sizJ2)  
       _RL frcArr (sizI1:sizI2,sizJ1:sizJ2)  
       _RL scaleFact  
       INTEGER power  
       LOGICAL useFract  
       _RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL specialVal  
       LOGICAL exclSpVal  
       INTEGER k, bi, bj  
       CHARACTER*16 parsFld  
       INTEGER myThid  
 CEOP  
   
 #ifdef ALLOW_LAND  
 C     !LOCAL VARIABLES:  
       LOGICAL useWeight  
       INTEGER kl  
       _RL drLoc  
   
 c     IF ( useLand ) THEN  
   
         IF ( parsFld(10:10).EQ.'G' ) THEN  
           kl = MIN(k,land_nLev)  
           drLoc = land_dzF(kl)  
         ELSE  
           drLoc = 1. _d 0  
         ENDIF  
         useWeight = .TRUE.  
   
         CALL  DIAGSTATS_CALC(  
      O            statArr,  
      I            inpArr, frcArr, scaleFact, power, useFract,  
      I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,  
      I            regMask, aim_landFr(1-Olx,1-Oly,bi,bj),  
      I            aim_landFr(1-Olx,1-Oly,bi,bj), arrArea,  
      I            drLoc, specialVal, exclSpVal, useWeight, myThid )  
   
 c     ENDIF  
 #endif /* ALLOW_LAND */  
   
       RETURN  
       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
 CBOP  
 C     !ROUTINE: DIAGSTATS_CALC  
 C     !INTERFACE:  
       SUBROUTINE DIAGSTATS_CALC(  
      O                  statArr,  
      I                  inpArr, frcArr, scaleFact, power, useFract,  
      I                  nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,  
      I                  regMask, arrMask, arrhFac, arrArea,  
      I                  arrDr, specialVal, exclSpVal, useWeight,  
      I                  myThid )  
   
 C     !DESCRIPTION:  
 C     Compute statistics for this tile, level, region  
   
 C     !USES:  
       IMPLICIT NONE  
   
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
   
 C     !INPUT/OUTPUT PARAMETERS:  
 C     == Routine Arguments ==  
 C     statArr     :: output statistics array  
 C     inpArr      :: input field array to process (compute stats & add to statFld)  
 C     frcArr      :: fraction used for weighted-average diagnostics  
 C     scaleFact   :: scaling factor  
 C     power       :: option to fill-in with the field square (power=2)  
 C     useFract    :: if True, use fraction-weight  
 C     nStats      :: size of output array: statArr  
 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  
       INTEGER nStats,sizI1,sizI2,sizJ1,sizJ2  
       INTEGER iRun, jRun  
       _RL statArr(0:nStats)  
       _RL inpArr (sizI1:sizI2,sizJ1:sizJ2)  
       _RL frcArr (sizI1:sizI2,sizJ1:sizJ2)  
       _RL scaleFact  
       INTEGER power  
       LOGICAL useFract  
       _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  
       INTEGER myThid  
 CEOP  
   
 C     !LOCAL VARIABLES:  
 C     i,j    :: loop indices  
       INTEGER i, j, n  
       INTEGER im, ix  
       _RL tmpVol  
       _RL tmpFld  
       _RL tmpFac  
   
       im = nStats - 1  
       ix = nStats  
       DO n=0,nStats  
         statArr(n) = 0.  
       ENDDO  
       tmpFac = scaleFact  
       IF ( power.EQ.2) tmpFac = scaleFact*scaleFact  
   
       IF ( useFract .AND. exclSpVal ) THEN  
   
        DO j = 1,jRun  
         DO i = 1,iRun  
           IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.  
      &                     .AND. inpArr(i,j).NE.specialVal ) THEN  
             IF ( power.EQ.2) THEN  
               tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)  
             ELSE  
               tmpFld = tmpFac*inpArr(i,j)  
             ENDIF  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = tmpFld  
               statArr(ix) = tmpFld  
             ELSE  
               statArr(im) = MIN(tmpFld,statArr(im))  
               statArr(ix) = MAX(tmpFld,statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)*frcArr(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)*frcArr(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*tmpFld  
             statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld  
           ENDIF  
         ENDDO  
        ENDDO  
   
       ELSEIF ( useFract ) THEN  
   
        DO j = 1,jRun  
         DO i = 1,iRun  
           IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0. ) THEN  
             IF ( power.EQ.2) THEN  
               tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)  
             ELSE  
               tmpFld = tmpFac*inpArr(i,j)  
             ENDIF  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = tmpFld  
               statArr(ix) = tmpFld  
             ELSE  
               statArr(im) = MIN(tmpFld,statArr(im))  
               statArr(ix) = MAX(tmpFld,statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)*frcArr(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)*frcArr(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*tmpFld  
             statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld  
           ENDIF  
         ENDDO  
        ENDDO  
   
       ELSEIF ( exclSpVal ) THEN  
   
        DO j = 1,jRun  
         DO i = 1,iRun  
           IF ( arrMask(i,j).NE.0.  
      &                     .AND. inpArr(i,j).NE.specialVal ) THEN  
             IF ( power.EQ.2) THEN  
               tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)  
             ELSE  
               tmpFld = tmpFac*inpArr(i,j)  
             ENDIF  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = tmpFld  
               statArr(ix) = tmpFld  
             ELSE  
               statArr(im) = MIN(tmpFld,statArr(im))  
               statArr(ix) = MAX(tmpFld,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*tmpFld  
             statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld  
           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 ( power.EQ.2) THEN  
               tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)  
             ELSE  
               tmpFld = tmpFac*inpArr(i,j)  
             ENDIF  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = tmpFld  
               statArr(ix) = tmpFld  
             ELSE  
               statArr(im) = MIN(tmpFld,statArr(im))  
               statArr(ix) = MAX(tmpFld,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*tmpFld  
             statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld  
           ENDIF  
         ENDDO  
        ENDDO  
   
       ENDIF  
   
       RETURN  
       END  
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22