/[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.4 by jmc, Mon Jul 11 19:02:17 2005 UTC revision 1.9 by jmc, Mon Dec 21 00:10:07 2009 UTC
# Line 13  C     !INTERFACE: Line 13  C     !INTERFACE:
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
# 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 50  C     sizJ1,sizJ2 :: size of inpFld arra Line 51  C     sizJ1,sizJ2 :: size of inpFld arra
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 inpFld array to porcess  C     kIn         :: level index of inpFld array to process
55  C     biIn,bjIn   :: tile indices of inpFld 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
# Line 72  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, kFr        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 82  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)        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 115  C-     case of a special region (no spec Line 121  C-     case of a special region (no spec
121       O            statLoc,       O            statLoc,
122       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
123       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
124       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
125       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
126       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),
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),       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 )
# Line 126  c    I            drLoc, k,bi,bj, parsFl Line 133  c    I            drLoc, k,bi,bj, parsFl
133       O            statLoc,       O            statLoc,
134       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
135       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
136       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
137       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
138       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),
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),       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
# Line 136  c    I            drLoc, k,bi,bj, parsFl Line 144  c    I            drLoc, k,bi,bj, parsFl
144       O            statLoc,       O            statLoc,
145       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
146       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
147       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
148       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
149       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),
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
# Line 150  c    I            drLoc, k,bi,bj, parsFl Line 159  c    I            drLoc, k,bi,bj, parsFl
159       O            statLoc,       O            statLoc,
160       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
161       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
162       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
163       I            nStats,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            rA(1-Olx,1-Oly,bi,bj),       I            maskInC(1-Olx,1-Oly,bi,bj), rA(1-Olx,1-Oly,bi,bj),
166       I            specialVal, exclSpVal,       I            specialVal, exclSpVal,
167       I            k,bi,bj, parsFld, myThid )       I            k,bi,bj, parsFld, myThid )
168           ELSEIF ( useLand .AND.           ELSEIF ( useLand .AND.
# Line 163  c    I            drLoc, k,bi,bj, parsFl Line 172  c    I            drLoc, k,bi,bj, parsFl
172       O            statLoc,       O            statLoc,
173       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
174       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
175       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
176       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
177       I            maskH(1-Olx,1-Oly,bi,bj),       I            diagSt_regMask(1-Olx,1-Oly,kRegMsk,bi,bj),
178       I            rA(1-Olx,1-Oly,bi,bj),       I            rA(1-Olx,1-Oly,bi,bj),
179       I            specialVal, exclSpVal,       I            specialVal, exclSpVal,
180       I            k,bi,bj, parsFld, myThid )       I            k,bi,bj, parsFld, myThid )
# Line 173  c        ELSEIF ( parsFld(10:10) .EQ. 'I Line 182  c        ELSEIF ( parsFld(10:10) .EQ. 'I
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_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            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
191       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
192       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
193       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),
194       I            maskW(1-Olx,1-Oly,km,bi,bj),rAw(1-Olx,1-Oly,bi,bj),       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_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            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
202       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
203       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
204       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),
205       I            maskS(1-Olx,1-Oly,km,bi,bj),rAs(1-Olx,1-Oly,bi,bj),       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_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            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
213       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
214       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
215       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),
216       I            maskH(1-Olx,1-Oly,bi,bj), rA(1-Olx,1-Oly,bi,bj),       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 222  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
# Line 232  C---   processing region "n" ends here. Line 240  C---   processing region "n" ends here.
240    
241        RETURN        RETURN
242        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 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_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.4  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22