/[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.11 by jmc, Fri Aug 8 19:29:48 2014 UTC
# Line 12  C     !INTERFACE: Line 12  C     !INTERFACE:
12       I                  scaleFact, power, useFract, sizF,       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, bibjFlg, region2fill,
16       I                  myThid)       I                  ndId, parsFld, 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     bibjFlg     :: passed from calling S/R (see diagstats_fill.F)
58  C     region2fill :: indicates whether to compute statistics over this region  C     region2fill :: indicates whether to compute statistics over this region
59  C     ndId        :: Diagnostics Id Number (in available diag. list)  C     ndId        :: Diagnostics Id Number (in available diag. list)
60  C     parsFld     :: parser field with characteristics of the diagnostics  C     parsFld     :: parser field with characteristics of the diagnostics
# Line 66  C     myThid      :: my Thread Id number Line 68  C     myThid      :: my Thread Id number
68        INTEGER power        INTEGER power
69        LOGICAL useFract        LOGICAL useFract
70        INTEGER iRun, jRun, kIn, biIn, bjIn        INTEGER iRun, jRun, kIn, biIn, bjIn
71        INTEGER k, bi, bj, ndId        INTEGER k, bi, bj, bibjFlg
72        INTEGER region2fill(0:nRegions)        INTEGER region2fill(0:nRegions)
73          INTEGER ndId
74        CHARACTER*16 parsFld        CHARACTER*16 parsFld
75        INTEGER myThid        INTEGER myThid
76  CEOP  CEOP
77    
78    C     !FUNCTIONS:
79    #ifdef ALLOW_FIZHI
80          _RL   getcon
81          EXTERNAL getcon
82    #endif
83    
84  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
85  C     i,j    :: loop indices  C     i,j    :: loop indices
86        INTEGER i, n, km, kFr        INTEGER i, n, kFr, kRegMsk
87        INTEGER im, ix, iv        INTEGER im, ix, iv
88        PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )        PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )
89        LOGICAL exclSpVal        LOGICAL exclSpVal
# Line 82  C     i,j    :: loop indices Line 91  C     i,j    :: loop indices
91        _RL statLoc(0:nStats)        _RL statLoc(0:nStats)
92        _RL drLoc        _RL drLoc
93        _RL specialVal        _RL specialVal
       _RL getcon  
       EXTERNAL getcon  
94    
95  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
96    
97        useWeight = .FALSE.        useWeight = .FALSE.
98        exclSpVal = .FALSE.        exclSpVal = .FALSE.
99        specialVal = 0.        specialVal = 0.
100    #ifdef ALLOW_FIZHI
101        IF ( useFIZHI ) THEN        IF ( useFIZHI ) THEN
102          exclSpVal = .TRUE.          exclSpVal = .TRUE.
103          specialVal = getcon('UNDEF')          specialVal = getcon('UNDEF')
104        ENDIF        ENDIF
105    #endif
106        kFr = MIN(kIn,sizF)        kFr = MIN(kIn,sizF)
107    
108        DO n=0,nRegions        DO n=0,nRegions
109         IF (region2fill(n).NE.0) THEN         IF (region2fill(n).NE.0) THEN
110  C---   Compute statistics for this tile, level and region:  C---   Compute statistics for this tile, level and region:
111    
112  C-     case of a special region (no specific regional mask)           kRegMsk = diagSt_kRegMsk(n)
         IF ( n.EQ.0 ) THEN  
113    
114           IF ( parsFld(10:10) .EQ. 'R' ) THEN           IF ( parsFld(10:10) .EQ. 'R' ) THEN
115    
# Line 111  C-     case of a special region (no spec Line 119  C-     case of a special region (no spec
119            IF ( parsFld(9:9).EQ.'M') useWeight = .TRUE.            IF ( parsFld(9:9).EQ.'M') useWeight = .TRUE.
120    
121            IF     ( parsFld(2:2).EQ.'U' ) THEN            IF     ( parsFld(2:2).EQ.'U' ) THEN
122             CALL  DIAGSTATS_CALC(             CALL DIAGSTATS_CALC(
123       O            statLoc,       O            statLoc,
124       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
125       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
126       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
127       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
128       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),
129       I            hFacW(1-Olx,1-Oly,k,bi,bj), rAw(1-Olx,1-Oly,bi,bj),       I            maskW(1-OLx,1-OLy,k,bi,bj),
130         I            hFacW(1-OLx,1-OLy,k,bi,bj), rAw(1-OLx,1-OLy,bi,bj),
131       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
132  c    I            drLoc, k,bi,bj, parsFld, myThid )  c    I            drLoc, k,bi,bj, parsFld, myThid )
133            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
134             CALL  DIAGSTATS_CALC(             CALL DIAGSTATS_CALC(
135       O            statLoc,       O            statLoc,
136       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
137       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
138       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
139       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
140       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),
141       I            hFacS(1-Olx,1-Oly,k,bi,bj), rAs(1-Olx,1-Oly,bi,bj),       I            maskS(1-OLx,1-OLy,k,bi,bj),
142         I            hFacS(1-OLx,1-OLy,k,bi,bj), rAs(1-OLx,1-OLy,bi,bj),
143       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
144            ELSE            ELSE
145             CALL  DIAGSTATS_CALC(             CALL DIAGSTATS_CALC(
146       O            statLoc,       O            statLoc,
147       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
148       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
149       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
150       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
151       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),
152       I            hFacC(1-Olx,1-Oly,k,bi,bj), rA(1-Olx,1-Oly,bi,bj),       I            maskC(1-OLx,1-OLy,k,bi,bj),
153         I            hFacC(1-OLx,1-OLy,k,bi,bj), rA(1-OLx,1-OLy,bi,bj),
154       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
155            ENDIF            ENDIF
156    
157           ELSEIF ( useFIZHI .AND.           ELSEIF ( useFIZHI .AND.
158       &           (parsFld(10:10).EQ.'L' .OR. parsFld(10:10).EQ.'M')       &           (parsFld(10:10).EQ.'L' .OR. parsFld(10:10).EQ.'M')
159       &          ) THEN       &          ) THEN
160             CALL  DIAGSTATS_LM_CALC(             CALL DIAGSTATS_LM_CALC(
161       O            statLoc,       O            statLoc,
162       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
163       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
164       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
165       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
166       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),
167       I            rA(1-Olx,1-Oly,bi,bj),       I            maskInC(1-OLx,1-OLy,bi,bj), rA(1-OLx,1-OLy,bi,bj),
168       I            specialVal, exclSpVal,       I            specialVal, exclSpVal,
169       I            k,bi,bj, parsFld, myThid )       I            k,bi,bj, parsFld, myThid )
170           ELSEIF ( useLand .AND.           ELSEIF ( useLand .AND.
171       &           (parsFld(10:10).EQ.'G' .OR. parsFld(10:10).EQ.'g')       &           (parsFld(10:10).EQ.'G' .OR. parsFld(10:10).EQ.'g')
172       &          ) THEN       &          ) THEN
173             CALL  DIAGSTATS_G_CALC(             CALL DIAGSTATS_G_CALC(
174       O            statLoc,       O            statLoc,
175       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
176       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
177       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
178       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
179       I            maskH(1-Olx,1-Oly,bi,bj),       I            diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
180       I            rA(1-Olx,1-Oly,bi,bj),       I            rA(1-OLx,1-OLy,bi,bj),
181       I            specialVal, exclSpVal,       I            specialVal, exclSpVal,
182       I            k,bi,bj, parsFld, myThid )       I            k,bi,bj, parsFld, myThid )
183  c        ELSEIF ( parsFld(10:10) .EQ. 'I' ) THEN  c        ELSEIF ( parsFld(10:10) .EQ. 'I' ) THEN
184  c        ELSEIF ( parsFld(10:10) .EQ. '1' ) THEN  c        ELSEIF ( parsFld(10:10) .EQ. '1' ) THEN
185           ELSE           ELSE
186    
           km = 1  
           IF ( usingPCoords ) km = Nr  
187            drLoc = 1. _d 0            drLoc = 1. _d 0
188            IF     ( parsFld(2:2).EQ.'U' ) THEN            IF     ( parsFld(2:2).EQ.'U' ) THEN
189             CALL  DIAGSTATS_CALC(             CALL DIAGSTATS_CALC(
190       O            statLoc,       O            statLoc,
191       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
192       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
193       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
194       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
195       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),
196       I            maskW(1-Olx,1-Oly,km,bi,bj),rAw(1-Olx,1-Oly,bi,bj),       I            maskInW(1-OLx,1-OLy,bi,bj),
197         I            maskInW(1-OLx,1-OLy,bi,bj),rAw(1-OLx,1-OLy,bi,bj),
198       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
199            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
200             CALL  DIAGSTATS_CALC(             CALL DIAGSTATS_CALC(
201       O            statLoc,       O            statLoc,
202       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
203       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
204       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
205       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
206       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),
207       I            maskS(1-Olx,1-Oly,km,bi,bj),rAs(1-Olx,1-Oly,bi,bj),       I            maskInS(1-OLx,1-OLy,bi,bj),
208         I            maskInS(1-OLx,1-OLy,bi,bj),rAs(1-OLx,1-OLy,bi,bj),
209       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
210            ELSE            ELSE
211             CALL  DIAGSTATS_CALC(             CALL DIAGSTATS_CALC(
212       O            statLoc,       O            statLoc,
213       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
214       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
215       I            scaleFact, power, useFract,       I            scaleFact, power, useFract, n, diagSt_vRegMsk(n),
216       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
217       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),
218       I            maskH(1-Olx,1-Oly,bi,bj), rA(1-Olx,1-Oly,bi,bj),       I            maskInC(1-OLx,1-OLy,bi,bj),
219         I            maskInC(1-OLx,1-OLy,bi,bj), rA(1-OLx,1-OLy,bi,bj),
220       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
221            ENDIF            ENDIF
222    
223           ENDIF           ENDIF
224    
225  C     Update cumulative statistics array  C     Update cumulative statistics array
226            IF ( statLoc(0).GT.0. ) THEN           IF ( statLoc(0).GT.0. ) THEN
227              IF ( statFld(0,n).LE.0. ) THEN             IF ( statFld(0,n).LE.0. ) THEN
228                statFld(im,n) = statLoc(im)               statFld(im,n) = statLoc(im)
229                statFld(ix,n) = statLoc(ix)               statFld(ix,n) = statLoc(ix)
230              ELSE             ELSE
231                statFld(im,n) = MIN( statFld(im,n), statLoc(im) )               statFld(im,n) = MIN( statFld(im,n), statLoc(im) )
232                statFld(ix,n) = MAX( statFld(ix,n), statLoc(ix) )               statFld(ix,n) = MAX( statFld(ix,n), statLoc(ix) )
233              ENDIF             ENDIF
234               IF ( bibjFlg.GE.0 ) THEN
235              DO i=0,iv              DO i=0,iv
236                statFld(i,n) = statFld(i,n) + statLoc(i)               statFld(i,n) = statFld(i,n) + statLoc(i)
237              ENDDO              ENDDO
238            ENDIF             ELSE
239                DO i=1,iv
240          ENDIF               statFld(i,n) = statFld(i,n) + statLoc(i)
241                ENDDO
242               ENDIF
243             ENDIF
244    
245  C---   processing region "n" ends here.  C---   processing region "n" ends here.
246         ENDIF         ENDIF
# Line 232  C---   processing region "n" ends here. Line 248  C---   processing region "n" ends here.
248    
249        RETURN        RETURN
250        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.11
  ViewVC Help
Powered by ViewVC 1.1.22