/[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.2 by jmc, Mon May 23 02:18:40 2005 UTC revision 1.9 by jmc, Mon Dec 21 00:10:07 2009 UTC
# Line 8  C     !ROUTINE: DIAGSTATS_LOCAL Line 8  C     !ROUTINE: DIAGSTATS_LOCAL
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE DIAGSTATS_LOCAL(        SUBROUTINE DIAGSTATS_LOCAL(
10       U                  statFld,       U                  statFld,
11       I                  inpFld,       I                  inpFld, frcFld,
12         I                  scaleFact, power, useFract, sizF,
13       I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,
14       I                  iRun,jRun,kIn,biIn,bjIn,       I                  iRun,jRun,kIn,biIn,bjIn,
15       I                  k,bi,bj, region2fill, ndId, parsFld,       I                  k,bi,bj, region2fill, ndId, parsFld,
16       I                  myThid)       I                  myThid )
17    
18  C     !DESCRIPTION:  C     !DESCRIPTION:
19  C     Update array statFld  C     Update array statFld
# 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 39  C     !INPUT/OUTPUT PARAMETERS: Line 41  C     !INPUT/OUTPUT PARAMETERS:
41  C     == Routine Arguments ==  C     == Routine Arguments ==
42  C     statFld     :: cumulative statistics array (updated)  C     statFld     :: cumulative statistics array (updated)
43  C     inpFld      :: input field array to process (compute stats & add to statFld)  C     inpFld      :: input field array to process (compute stats & add to statFld)
44    C     frcFld      :: fraction used for weighted-average diagnostics
45    C     scaleFact   :: scaling factor
46    C     power       :: option to fill-in with the field square (power=2)
47    C     useFract    :: if True, use fraction-weight
48    C     sizF        :: size of frcFld array: 3rd  dimension
49  C     sizI1,sizI2 :: size of inpFld array: 1rst index range (min,max)  C     sizI1,sizI2 :: size of inpFld array: 1rst index range (min,max)
50  C     sizJ1,sizJ2 :: size of inpFld array: 2nd  index range (min,max)  C     sizJ1,sizJ2 :: size of inpFld array: 2nd  index range (min,max)
51  C     sizK        :: size of inpFld array: 3rd  dimension  C     sizK        :: size of inpFld array: 3rd  dimension
52  C     sizTx,sizTy :: size of inpFld array: tile dimensions  C     sizTx,sizTy :: size of inpFld array: tile dimensions
53  C     iRun,jRun   :: range of 1rst & 2nd index  C     iRun,jRun   :: range of 1rst & 2nd index
54  C     kIn         :: level index of inFld array to porcess  C     kIn         :: level index of inpFld array to process
55  C     biIn,bjIn   :: tile indices of inFld array to process  C     biIn,bjIn   :: tile indices of inpFld array to process
56  C     k,bi,bj     :: level and tile indices used for weighting (mask,area ...)  C     k,bi,bj     :: level and tile indices used for weighting (mask,area ...)
57  C     region2fill :: indicates whether to compute statistics over this region  C     region2fill :: indicates whether to compute statistics over this region
58  C     ndId        :: Diagnostics Id Number (in available diag. list)  C     ndId        :: Diagnostics Id Number (in available diag. list)
# Line 53  C     parsFld     :: parser field with c Line 60  C     parsFld     :: parser field with c
60  C     myThid      :: my Thread Id number  C     myThid      :: my Thread Id number
61        _RL     statFld(0:nStats,0:nRegions)        _RL     statFld(0:nStats,0:nRegions)
62        INTEGER sizI1,sizI2,sizJ1,sizJ2        INTEGER sizI1,sizI2,sizJ1,sizJ2
63        INTEGER sizK,sizTx,sizTy        INTEGER sizF,sizK,sizTx,sizTy
64        _RL     inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)        _RL     inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)
65          _RL     frcFld(sizI1:sizI2,sizJ1:sizJ2,sizF,sizTx,sizTy)
66          _RL     scaleFact
67          INTEGER power
68          LOGICAL useFract
69        INTEGER iRun, jRun, kIn, biIn, bjIn        INTEGER iRun, jRun, kIn, biIn, bjIn
70        INTEGER k, bi, bj, ndId        INTEGER k, bi, bj, ndId
71        INTEGER region2fill(0:nRegions)        INTEGER region2fill(0:nRegions)
# Line 62  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        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 72  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)
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 103  C-     case of a special region (no spec Line 120  C-     case of a special region (no spec
120             CALL  DIAGSTATS_CALC(             CALL  DIAGSTATS_CALC(
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),
124         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 112  c    I            drLoc, k,bi,bj, parsFl Line 132  c    I            drLoc, k,bi,bj, parsFl
132             CALL  DIAGSTATS_CALC(             CALL  DIAGSTATS_CALC(
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),
136         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
143             CALL  DIAGSTATS_CALC(             CALL  DIAGSTATS_CALC(
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),
147         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 132  c    I            drLoc, k,bi,bj, parsFl Line 158  c    I            drLoc, k,bi,bj, parsFl
158             CALL  DIAGSTATS_LM_CALC(             CALL  DIAGSTATS_LM_CALC(
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),
162         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 143  c    I            drLoc, k,bi,bj, parsFl Line 171  c    I            drLoc, k,bi,bj, parsFl
171             CALL  DIAGSTATS_G_CALC(             CALL  DIAGSTATS_G_CALC(
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),
175         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 152  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),
191         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),
202         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),
213         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 195  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 205  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,  
      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     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)  
       _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,  
      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,  
      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     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)  
       _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,  
      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,  
      I                  nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,  
      I                  regMask, arrMask, arrhFac, arrArea,  
      I                  arrDr, specialVal, exclSpVal, useWeight,  
      I                  myThid )  
 c    I                  arrDr, k,bi,bj, parsFld, myThid )  
   
 C     !DESCRIPTION:  
 C     Compute statistics for this tile, level, region  
   
 C     !USES:  
       IMPLICIT NONE  
   
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
   
 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     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)  
       _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  
   
       im = nStats - 1  
       ix = nStats  
       DO n=0,nStats  
         statArr(n) = 0.  
       ENDDO  
   
       IF ( exclSpVal ) THEN  
   
        DO j = 1,jRun  
         DO i = 1,iRun  
           IF (arrMask(i,j).NE.0. .AND. inpArr(i,j).NE.specialVal) THEN  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = inpArr(i,j)  
               statArr(ix) = inpArr(i,j)  
             ELSE  
               statArr(im) = MIN(inpArr(i,j),statArr(im))  
               statArr(ix) = MAX(inpArr(i,j),statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*inpArr(i,j)  
             statArr(2) = statArr(2) + tmpVol*inpArr(i,j)*inpArr(i,j)  
           ENDIF  
         ENDDO  
        ENDDO  
   
       ELSE  
   
        DO j = 1,jRun  
         DO i = 1,iRun  
 c         IF ( regMask(i,j).NE.0. .AND. arrMask(i,j).NE.0. ) THEN  
           IF ( arrMask(i,j).NE.0. ) THEN  
             IF ( statArr(0).EQ.0. ) THEN  
               statArr(im) = inpArr(i,j)  
               statArr(ix) = inpArr(i,j)  
             ELSE  
               statArr(im) = MIN(inpArr(i,j),statArr(im))  
               statArr(ix) = MAX(inpArr(i,j),statArr(ix))  
             ENDIF  
             IF ( useWeight ) THEN  
               tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)  
             ELSE  
               tmpVol = arrDr*arrArea(i,j)  
             ENDIF  
             statArr(0) = statArr(0) + tmpVol  
             statArr(1) = statArr(1) + tmpVol*inpArr(i,j)  
             statArr(2) = statArr(2) + tmpVol*inpArr(i,j)*inpArr(i,j)  
           ENDIF  
         ENDDO  
        ENDDO  
   
       ENDIF  
   
       RETURN  
       END  
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22