/[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.3 by jmc, Sun Jul 10 00:57:18 2005 UTC revision 1.12 by jmc, Mon Aug 25 21:59:18 2014 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, frcFld, scaleFact, useFract,sizF,       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, 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 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  c #include "SURFACE.h"  c #include "SURFACE.h"
# Line 41  C     statFld     :: cumulative statisti Line 43  C     statFld     :: cumulative statisti
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  C     frcFld      :: fraction used for weighted-average diagnostics
45  C     scaleFact   :: scaling factor  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  C     useFract    :: if True, use fraction-weight
48  C     sizF        :: size of frcFld array: 3rd  dimension  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)
# Line 48  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 61  C     myThid      :: my Thread Id number Line 65  C     myThid      :: my Thread Id number
65        _RL     inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)        _RL     inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)
66        _RL     frcFld(sizI1:sizI2,sizJ1:sizJ2,sizF,sizTx,sizTy)        _RL     frcFld(sizI1:sizI2,sizJ1:sizJ2,sizF,sizTx,sizTy)
67        _RL     scaleFact        _RL     scaleFact
68          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, lReg
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 79  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)
113          IF ( n.EQ.0 ) THEN           lReg = 0
114             IF ( n.GE.1 ) THEN
115               lReg = 1
116               IF ( parsFld(2:2).EQ.'U' ) lReg = 2
117               IF ( parsFld(2:2).EQ.'V' ) lReg = 3
118             ENDIF
119    
120           IF ( parsFld(10:10) .EQ. 'R' ) THEN           IF ( parsFld(10:10) .EQ. 'R' ) THEN
121    
# Line 108  C-     case of a special region (no spec Line 125  C-     case of a special region (no spec
125            IF ( parsFld(9:9).EQ.'M') useWeight = .TRUE.            IF ( parsFld(9:9).EQ.'M') useWeight = .TRUE.
126    
127            IF     ( parsFld(2:2).EQ.'U' ) THEN            IF     ( parsFld(2:2).EQ.'U' ) THEN
128             CALL  DIAGSTATS_CALC(             CALL DIAGSTATS_CALC(
129       O            statLoc,       O            statLoc,
130       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
131       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
132       I            scaleFact, useFract,       I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
133       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
134       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),
135       I            hFacW(1-Olx,1-Oly,k,bi,bj), rAw(1-Olx,1-Oly,bi,bj),       I            maskInW(1-OLx,1-OLy,bi,bj),
136         I            hFacW(1-OLx,1-OLy,k,bi,bj), rAw(1-OLx,1-OLy,bi,bj),
137       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
138  c    I            drLoc, k,bi,bj, parsFld, myThid )  c    I            drLoc, k,bi,bj, parsFld, myThid )
139            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
140             CALL  DIAGSTATS_CALC(             CALL DIAGSTATS_CALC(
141       O            statLoc,       O            statLoc,
142       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
143       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
144       I            scaleFact, useFract,       I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
145       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
146       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),
147       I            hFacS(1-Olx,1-Oly,k,bi,bj), rAs(1-Olx,1-Oly,bi,bj),       I            maskInS(1-OLx,1-OLy,bi,bj),
148         I            hFacS(1-OLx,1-OLy,k,bi,bj), rAs(1-OLx,1-OLy,bi,bj),
149       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
150            ELSE            ELSE
151             CALL  DIAGSTATS_CALC(             CALL DIAGSTATS_CALC(
152       O            statLoc,       O            statLoc,
153       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
154       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
155       I            scaleFact, useFract,       I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
156       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
157       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),
158       I            hFacC(1-Olx,1-Oly,k,bi,bj), rA(1-Olx,1-Oly,bi,bj),       I            maskInC(1-OLx,1-OLy,bi,bj),
159         I            hFacC(1-OLx,1-OLy,k,bi,bj), rA(1-OLx,1-OLy,bi,bj),
160       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
161            ENDIF            ENDIF
162    
163           ELSEIF ( useFIZHI .AND.           ELSEIF ( useFIZHI .AND.
164       &           (parsFld(10:10).EQ.'L' .OR. parsFld(10:10).EQ.'M')       &           (parsFld(10:10).EQ.'L' .OR. parsFld(10:10).EQ.'M')
165       &          ) THEN       &          ) THEN
166             CALL  DIAGSTATS_LM_CALC(             CALL DIAGSTATS_LM_CALC(
167       O            statLoc,       O            statLoc,
168       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
169       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
170       I            scaleFact, useFract,       I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
171       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
172       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),
173       I            rA(1-Olx,1-Oly,bi,bj),       I            maskInC(1-OLx,1-OLy,bi,bj), rA(1-OLx,1-OLy,bi,bj),
174       I            specialVal, exclSpVal,       I            specialVal, exclSpVal,
175       I            k,bi,bj, parsFld, myThid )       I            k,bi,bj, parsFld, myThid )
176           ELSEIF ( useLand .AND.           ELSEIF ( useLand .AND.
177       &           (parsFld(10:10).EQ.'G' .OR. parsFld(10:10).EQ.'g')       &           (parsFld(10:10).EQ.'G' .OR. parsFld(10:10).EQ.'g')
178       &          ) THEN       &          ) THEN
179             CALL  DIAGSTATS_G_CALC(             CALL DIAGSTATS_G_CALC(
180       O            statLoc,       O            statLoc,
181       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
182       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
183       I            scaleFact, useFract,       I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
184       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
185       I            maskH(1-Olx,1-Oly,bi,bj),       I            diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
186       I            rA(1-Olx,1-Oly,bi,bj),       I            rA(1-OLx,1-OLy,bi,bj),
187       I            specialVal, exclSpVal,       I            specialVal, exclSpVal,
188       I            k,bi,bj, parsFld, myThid )       I            k,bi,bj, parsFld, myThid )
189  c        ELSEIF ( parsFld(10:10) .EQ. 'I' ) THEN  c        ELSEIF ( parsFld(10:10) .EQ. 'I' ) THEN
190  c        ELSEIF ( parsFld(10:10) .EQ. '1' ) THEN  c        ELSEIF ( parsFld(10:10) .EQ. '1' ) THEN
191           ELSE           ELSE
192    
           km = 1  
           IF ( usingPCoords ) km = Nr  
193            drLoc = 1. _d 0            drLoc = 1. _d 0
194            IF     ( parsFld(2:2).EQ.'U' ) THEN            IF     ( parsFld(2:2).EQ.'U' ) THEN
195             CALL  DIAGSTATS_CALC(             CALL DIAGSTATS_CALC(
196       O            statLoc,       O            statLoc,
197       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
198       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
199       I            scaleFact, useFract,       I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
200       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
201       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),
202       I            maskW(1-Olx,1-Oly,km,bi,bj),rAw(1-Olx,1-Oly,bi,bj),       I            maskInW(1-OLx,1-OLy,bi,bj),
203         I            maskInW(1-OLx,1-OLy,bi,bj),rAw(1-OLx,1-OLy,bi,bj),
204       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
205            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
206             CALL  DIAGSTATS_CALC(             CALL DIAGSTATS_CALC(
207       O            statLoc,       O            statLoc,
208       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
209       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
210       I            scaleFact, useFract,       I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
211       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
212       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),
213       I            maskS(1-Olx,1-Oly,km,bi,bj),rAs(1-Olx,1-Oly,bi,bj),       I            maskInS(1-OLx,1-OLy,bi,bj),
214         I            maskInS(1-OLx,1-OLy,bi,bj),rAs(1-OLx,1-OLy,bi,bj),
215       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
216            ELSE            ELSE
217             CALL  DIAGSTATS_CALC(             CALL DIAGSTATS_CALC(
218       O            statLoc,       O            statLoc,
219       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
220       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
221       I            scaleFact, useFract,       I            scaleFact, power, useFract, lReg, diagSt_vRegMsk(n),
222       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
223       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),
224       I            maskH(1-Olx,1-Oly,bi,bj), rA(1-Olx,1-Oly,bi,bj),       I            maskInC(1-OLx,1-OLy,bi,bj),
225         I            maskInC(1-OLx,1-OLy,bi,bj), rA(1-OLx,1-OLy,bi,bj),
226       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
227            ENDIF            ENDIF
228    
229           ENDIF           ENDIF
230    
231  C     Update cumulative statistics array  C     Update cumulative statistics array
232            IF ( statLoc(0).GT.0. ) THEN           IF ( statLoc(0).GT.0. ) THEN
233              IF ( statFld(0,n).LE.0. ) THEN             IF ( statFld(0,n).LE.0. ) THEN
234                statFld(im,n) = statLoc(im)               statFld(im,n) = statLoc(im)
235                statFld(ix,n) = statLoc(ix)               statFld(ix,n) = statLoc(ix)
236              ELSE             ELSE
237                statFld(im,n) = MIN( statFld(im,n), statLoc(im) )               statFld(im,n) = MIN( statFld(im,n), statLoc(im) )
238                statFld(ix,n) = MAX( statFld(ix,n), statLoc(ix) )               statFld(ix,n) = MAX( statFld(ix,n), statLoc(ix) )
239              ENDIF             ENDIF
240               IF ( bibjFlg.GE.0 ) THEN
241              DO i=0,iv              DO i=0,iv
242                statFld(i,n) = statFld(i,n) + statLoc(i)               statFld(i,n) = statFld(i,n) + statLoc(i)
243              ENDDO              ENDDO
244            ENDIF             ELSE
245                DO i=1,iv
246          ENDIF               statFld(i,n) = statFld(i,n) + statLoc(i)
247                ENDDO
248               ENDIF
249             ENDIF
250    
251  C---   processing region "n" ends here.  C---   processing region "n" ends here.
252         ENDIF         ENDIF
# Line 229  C---   processing region "n" ends here. Line 254  C---   processing region "n" ends here.
254    
255        RETURN        RETURN
256        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, 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     useFract    :: if True, use fraction-weight  
 C     scaleFact   :: scaling factor  
 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  
       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, 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, 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     useFract    :: if True, use fraction-weight  
 C     scaleFact   :: scaling factor  
 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  
       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, 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, 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     useFract    :: if True, use fraction-weight  
 C     scaleFact   :: scaling factor  
 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  
       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  
 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  
       _RL tmpVol  
       _RL tmpFld  
   
       im = nStats - 1  
       ix = nStats  
       DO n=0,nStats  
         statArr(n) = 0.  
       ENDDO  
   
       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  
             tmpFld = scaleFact*inpArr(i,j)  
             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  
             tmpFld = scaleFact*inpArr(i,j)  
             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  
             tmpFld = scaleFact*inpArr(i,j)  
             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  
             tmpFld = scaleFact*inpArr(i,j)  
             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.3  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22