/[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.7 by jmc, Tue Nov 18 21:41:06 2008 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,
# 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 porcess
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, km, 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            maskH(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 159  c        ELSEIF ( parsFld(10:10) .EQ. '1 Line 189  c        ELSEIF ( parsFld(10:10) .EQ. '1
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),
193         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),
197       I            maskW(1-Olx,1-Oly,km,bi,bj),rAw(1-Olx,1-Oly,bi,bj),       I            maskW(1-Olx,1-Oly,km,bi,bj),rAw(1-Olx,1-Oly,bi,bj),
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),
204         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),
208       I            maskS(1-Olx,1-Oly,km,bi,bj),rAs(1-Olx,1-Oly,bi,bj),       I            maskS(1-Olx,1-Oly,km,bi,bj),rAs(1-Olx,1-Oly,bi,bj),
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),
215         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),
219       I            maskH(1-Olx,1-Oly,bi,bj), rA(1-Olx,1-Oly,bi,bj),       I            maskH(1-Olx,1-Oly,bi,bj), rA(1-Olx,1-Oly,bi,bj),
220       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
221            ENDIF            ENDIF
# Line 184  c        ELSEIF ( parsFld(10:10) .EQ. '1 Line 223  c        ELSEIF ( parsFld(10:10) .EQ. '1
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)
# Line 195  C     Update cumulative statistics array Line 234  C     Update cumulative statistics array
234              DO i=0,iv              DO i=0,iv
235                statFld(i,n) = statFld(i,n) + statLoc(i)                statFld(i,n) = statFld(i,n) + statLoc(i)
236              ENDDO              ENDDO
237            ENDIF           ENDIF
   
         ENDIF  
238    
239  C---   processing region "n" ends here.  C---   processing region "n" ends here.
240         ENDIF         ENDIF
# Line 205  C---   processing region "n" ends here. Line 242  C---   processing region "n" ends here.
242    
243        RETURN        RETURN
244        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.7
  ViewVC Help
Powered by ViewVC 1.1.22