/[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.1 by jmc, Fri May 20 07:28:52 2005 UTC revision 1.3 by jmc, Sun Jul 10 00:57:18 2005 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, scaleFact, useFract,sizF,
12       I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,
13       I                  iRun,jRun,kIn,biIn,bjIn,       I                  iRun,jRun,kIn,biIn,bjIn,
14       I                  k,bi,bj, region2fill, ndId, parsFld,       I                  k,bi,bj, region2fill, ndId, parsFld,
15       I                  myThid)       I                  myThid)
16    
17  C     !DESCRIPTION:  C     !DESCRIPTION:
18  C     Update array statFld  C     Update array statFld
19  C     by adding statistics over the range [1:iRun],[1:jRun]  C     by adding statistics over the range [1:iRun],[1:jRun]
20  C     from input field array inpFld  C     from input field array inpFld
21  C- note:  C- note:
22  C   a) this S/R should not see DIAGNOSTICS pkg commons blocks (in DIAGNOSTICS.h)  C   a) this S/R should not see DIAGNOSTICS pkg commons blocks (in DIAGNOSTICS.h)
23  C   b) for main grid variables, get area & weigting factors (to compute global mean)  C   b) for main grid variables, get area & weigting factors (to compute global mean)
24  C      from the main common blocks.  C      from the main common blocks.
25  C   c) for other type of grids, call a specifics S/R which include its own  C   c) for other type of grids, call a specifics S/R which include its own
26  C      grid common blocks  C      grid common blocks
27    
28  C     !USES:  C     !USES:
# Line 33  C     !USES: Line 33  C     !USES:
33  #include "DIAGNOSTICS_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
34  #include "PARAMS.h"  #include "PARAMS.h"
35  #include "GRID.h"  #include "GRID.h"
36  #include "SURFACE.h"  c #include "SURFACE.h"
 #ifdef ALLOW_FIZHI  
 #include "fizhi_SIZE.h"  
 #include "gridalt_mapping.h"  
 #endif  
37    
38  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
39  C     == Routine Arguments ==  C     == Routine Arguments ==
40  C     statFld     :: cumulative statistics array (updated)  C     statFld     :: cumulative statistics array (updated)
41  C     inpFld      :: input field array to process (compute stats & add to statFld)  C     inpFld      :: input field array to process (compute stats & add to statFld)
42    C     frcFld      :: fraction used for weighted-average diagnostics
43    C     scaleFact   :: scaling factor
44    C     useFract    :: if True, use fraction-weight
45    C     sizF        :: size of frcFld array: 3rd  dimension
46  C     sizI1,sizI2 :: size of inpFld array: 1rst index range (min,max)  C     sizI1,sizI2 :: size of inpFld array: 1rst index range (min,max)
47  C     sizJ1,sizJ2 :: size of inpFld array: 2nd  index range (min,max)  C     sizJ1,sizJ2 :: size of inpFld array: 2nd  index range (min,max)
48  C     sizK        :: size of inpFld array: 3rd  dimension  C     sizK        :: size of inpFld array: 3rd  dimension
49  C     sizTx,sizTy :: size of inpFld array: tile dimensions  C     sizTx,sizTy :: size of inpFld array: tile dimensions
50  C     iRun,jRun   :: range of 1rst & 2nd index  C     iRun,jRun   :: range of 1rst & 2nd index
51  C     kIn         :: level index of inFld array to porcess  C     kIn         :: level index of inpFld array to porcess
52  C     biIn,bjIn   :: tile indices of inFld array to process  C     biIn,bjIn   :: tile indices of inpFld array to process
53  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 ...)
54  C     region2fill :: indicates whether to compute statistics over this region  C     region2fill :: indicates whether to compute statistics over this region
55  C     ndId        :: Diagnostics Id Number (in available diag. list)  C     ndId        :: Diagnostics Id Number (in available diag. list)
# Line 57  C     parsFld     :: parser field with c Line 57  C     parsFld     :: parser field with c
57  C     myThid      :: my Thread Id number  C     myThid      :: my Thread Id number
58        _RL     statFld(0:nStats,0:nRegions)        _RL     statFld(0:nStats,0:nRegions)
59        INTEGER sizI1,sizI2,sizJ1,sizJ2        INTEGER sizI1,sizI2,sizJ1,sizJ2
60        INTEGER sizK,sizTx,sizTy        INTEGER sizF,sizK,sizTx,sizTy
61        _RL     inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)        _RL     inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)
62          _RL     frcFld(sizI1:sizI2,sizJ1:sizJ2,sizF,sizTx,sizTy)
63          _RL     scaleFact
64          LOGICAL useFract
65        INTEGER iRun, jRun, kIn, biIn, bjIn        INTEGER iRun, jRun, kIn, biIn, bjIn
66        INTEGER k, bi, bj, ndId        INTEGER k, bi, bj, ndId
67        INTEGER region2fill(0:nRegions)        INTEGER region2fill(0:nRegions)
# Line 68  CEOP Line 71  CEOP
71    
72  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
73  C     i,j    :: loop indices  C     i,j    :: loop indices
74        INTEGER i, n, km        INTEGER i, n, km, kFr
75        INTEGER im, ix, iv        INTEGER im, ix, iv
76        PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )        PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )
77        LOGICAL exclSpVal        LOGICAL exclSpVal
# Line 86  C---+----1----+----2----+----3----+----4 Line 89  C---+----1----+----2----+----3----+----4
89        specialVal = 0.        specialVal = 0.
90        IF ( useFIZHI ) THEN        IF ( useFIZHI ) THEN
91          exclSpVal = .TRUE.          exclSpVal = .TRUE.
92          specialVal = getcon('UNDEF')          specialVal = getcon('UNDEF')
93        ENDIF        ENDIF
94                  kFr = MIN(kIn,sizF)
95    
96        DO n=0,nRegions        DO n=0,nRegions
97         IF (region2fill(n).NE.0) THEN         IF (region2fill(n).NE.0) THEN
98  C---   Compute statistics for this tile, level and region:  C---   Compute statistics for this tile, level and region:
99          
100  C-     case of a special region (no specific regional mask)  C-     case of a special region (no specific regional mask)
101          IF ( n.EQ.0 ) THEN          IF ( n.EQ.0 ) THEN
102    
# Line 104  C-     case of a special region (no spec Line 108  C-     case of a special region (no spec
108            IF ( parsFld(9:9).EQ.'M') useWeight = .TRUE.            IF ( parsFld(9:9).EQ.'M') useWeight = .TRUE.
109    
110            IF     ( parsFld(2:2).EQ.'U' ) THEN            IF     ( parsFld(2:2).EQ.'U' ) THEN
111             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
112       O            statLoc,       O            statLoc,
113       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
114       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
115         I            scaleFact, useFract,
116         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
117       I            maskH(1-Olx,1-Oly,bi,bj), maskW(1-Olx,1-Oly,k,bi,bj),       I            maskH(1-Olx,1-Oly,bi,bj), maskW(1-Olx,1-Oly,k,bi,bj),
118       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),
119       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
120  c    I            drLoc, k,bi,bj, parsFld, myThid )  c    I            drLoc, k,bi,bj, parsFld, myThid )
121            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
122             CALL  DIAGSTATS_R_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            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
126         I            scaleFact, useFract,
127         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
128       I            maskH(1-Olx,1-Oly,bi,bj), maskS(1-Olx,1-Oly,k,bi,bj),       I            maskH(1-Olx,1-Oly,bi,bj), maskS(1-Olx,1-Oly,k,bi,bj),
129       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),
130       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
131            ELSE            ELSE
132             CALL  DIAGSTATS_R_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            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
136         I            scaleFact, useFract,
137         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
138       I            maskH(1-Olx,1-Oly,bi,bj), maskC(1-Olx,1-Oly,k,bi,bj),       I            maskH(1-Olx,1-Oly,bi,bj), maskC(1-Olx,1-Oly,k,bi,bj),
139       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),
140       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
141            ENDIF            ENDIF
142    
143  #ifdef ALLOW_FIZHI           ELSEIF ( useFIZHI .AND.
144  c        ELSEIF ( parsFld(10:10) .EQ. 'L' ) THEN       &           (parsFld(10:10).EQ.'L' .OR. parsFld(10:10).EQ.'M')
145           ELSEIF ( parsFld(10:10) .EQ. 'M' ) THEN       &          ) THEN
146             drLoc = 1. _d 0             CALL  DIAGSTATS_LM_CALC(
            km = 1 + Nrphys - k  
            CALL  DIAGSTATS_R_CALC(  
147       O            statLoc,       O            statLoc,
148       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
149       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
150         I            scaleFact, useFract,
151         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
152       I            maskH(1-Olx,1-Oly,bi,bj), maskH(1-Olx,1-Oly,bi,bj),       I            maskH(1-Olx,1-Oly,bi,bj), maskH(1-Olx,1-Oly,bi,bj),
153       I            dpphys(1-Olx,1-Oly,km,bi,bj), rA(1-Olx,1-Oly,bi,bj),       I            rA(1-Olx,1-Oly,bi,bj),
154       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            specialVal, exclSpVal,
155  #endif       I            k,bi,bj, parsFld, myThid )
156  #ifdef ALLOW_LAND           ELSEIF ( useLand .AND.
157  c        ELSEIF ( parsFld(10:10) .EQ. 'G' ) THEN       &           (parsFld(10:10).EQ.'G' .OR. parsFld(10:10).EQ.'g')
158  #endif       &          ) THEN
159               CALL  DIAGSTATS_G_CALC(
160         O            statLoc,
161         I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
162         I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
163         I            scaleFact, useFract,
164         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
165         I            maskH(1-Olx,1-Oly,bi,bj),
166         I            rA(1-Olx,1-Oly,bi,bj),
167         I            specialVal, exclSpVal,
168         I            k,bi,bj, parsFld, myThid )
169  c        ELSEIF ( parsFld(10:10) .EQ. 'I' ) THEN  c        ELSEIF ( parsFld(10:10) .EQ. 'I' ) THEN
170  c        ELSEIF ( parsFld(10:10) .EQ. '1' ) THEN  c        ELSEIF ( parsFld(10:10) .EQ. '1' ) THEN
171           ELSE           ELSE
# Line 154  c        ELSEIF ( parsFld(10:10) .EQ. '1 Line 174  c        ELSEIF ( parsFld(10:10) .EQ. '1
174            IF ( usingPCoords ) km = Nr            IF ( usingPCoords ) km = Nr
175            drLoc = 1. _d 0            drLoc = 1. _d 0
176            IF     ( parsFld(2:2).EQ.'U' ) THEN            IF     ( parsFld(2:2).EQ.'U' ) THEN
177             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
178       O            statLoc,       O            statLoc,
179       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
180       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
181         I            scaleFact, useFract,
182         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
183       I            maskH(1-Olx,1-Oly,bi,bj), maskW(1-Olx,1-Oly,km,bi,bj),       I            maskH(1-Olx,1-Oly,bi,bj), maskW(1-Olx,1-Oly,km,bi,bj),
184       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),
185       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
186            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN            ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
187             CALL  DIAGSTATS_R_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            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
191         I            scaleFact, useFract,
192         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
193       I            maskH(1-Olx,1-Oly,bi,bj), maskS(1-Olx,1-Oly,km,bi,bj),       I            maskH(1-Olx,1-Oly,bi,bj), maskS(1-Olx,1-Oly,km,bi,bj),
194       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),
195       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
196            ELSE            ELSE
197             CALL  DIAGSTATS_R_CALC(             CALL  DIAGSTATS_CALC(
198       O            statLoc,       O            statLoc,
199       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),       I            inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
200       I            sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,       I            frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
201         I            scaleFact, useFract,
202         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
203       I            maskH(1-Olx,1-Oly,bi,bj), maskH(1-Olx,1-Oly,bi,bj),       I            maskH(1-Olx,1-Oly,bi,bj), maskH(1-Olx,1-Oly,bi,bj),
204       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),
205       I            drLoc, specialVal, exclSpVal, useWeight, myThid )       I            drLoc, specialVal, exclSpVal, useWeight, myThid )
# Line 201  C---   processing region "n" ends here. Line 227  C---   processing region "n" ends here.
227         ENDIF         ENDIF
228        ENDDO        ENDDO
229    
230        RETURN        RETURN
231          END
232    
233    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
234    
235    CBOP
236    C     !ROUTINE: DIAGSTATS_LM_CALC
237    C     !INTERFACE:
238          SUBROUTINE DIAGSTATS_LM_CALC(
239         O                  statArr,
240         I                  inpArr, frcArr, scaleFact, useFract,
241         I                  nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,
242         I                  regMask, arrMask, arrArea,
243         I                  specialVal, exclSpVal,
244         I                  k,bi,bj, parsFld, myThid )
245    
246    C     !DESCRIPTION:
247    C     Compute statistics for this tile, level, region
248    C     using FIZHI level thickness
249    
250    C     !USES:
251          IMPLICIT NONE
252    
253    #include "EEPARAMS.h"
254    #include "SIZE.h"
255    #ifdef ALLOW_FIZHI
256    #include "fizhi_SIZE.h"
257    #include "gridalt_mapping.h"
258    #endif
259    
260    C     !INPUT/OUTPUT PARAMETERS:
261    C     == Routine Arguments ==
262    C     statArr     :: output statistics array
263    C     inpArr      :: input field array to process (compute stats & add to statFld)
264    C     frcArr      :: fraction used for weighted-average diagnostics
265    C     useFract    :: if True, use fraction-weight
266    C     scaleFact   :: scaling factor
267    C     nStats      :: size of output statArr
268    C     sizI1,sizI2 :: size of inpArr array: 1rst index range (min,max)
269    C     sizJ1,sizJ2 :: size of inpArr array: 2nd  index range (min,max)
270    C     iRun,jRun   :: range of 1rst & 2nd index to process
271    C     regMask     :: regional mask
272    C     arrMask     :: mask for this input array
273    C     arrArea     :: Area weighting factor
274    C     specialVal  :: special value in input array (to exclude if exclSpVal=T)
275    C     exclSpVal   :: if T, exclude "specialVal" in input array
276    C     k,bi,bj     :: level and tile indices used for weighting (mask,area ...)
277    C     parsFld     :: parser field with characteristics of the diagnostics
278    C     myThid      :: my Thread Id number
279          INTEGER nStats,sizI1,sizI2,sizJ1,sizJ2
280          INTEGER iRun, jRun
281          _RL statArr(0:nStats)
282          _RL inpArr (sizI1:sizI2,sizJ1:sizJ2)
283          _RL frcArr (sizI1:sizI2,sizJ1:sizJ2)
284          _RL scaleFact
285          LOGICAL useFract
286          _RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
287          _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
288          _RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
289          _RL specialVal
290          LOGICAL exclSpVal
291          INTEGER k, bi, bj
292          CHARACTER*16 parsFld
293          INTEGER myThid
294    CEOP
295    
296    #ifdef ALLOW_FIZHI
297    C     !LOCAL VARIABLES:
298          LOGICAL useWeight
299          INTEGER kl
300          _RL drLoc
301    
302    c     IF ( useFIZHI ) THEN
303    
304            IF ( parsFld(10:10).EQ.'L' ) THEN
305              kl = 1 + Nrphys - k
306              useWeight = .TRUE.
307            ELSE
308              kl = 1
309              useWeight = .FALSE.
310            ENDIF
311            drLoc = 1. _d 0
312    
313    C- jmc: here we have a Problem if RL & RS are not the same:
314    C    since dpphys is RL but argument is RS. leave it like this for now
315    C    and will change it once the Regions are fully implemented.
316    
317            CALL  DIAGSTATS_CALC(
318         O            statArr,
319         I            inpArr, frcArr, scaleFact, useFract,
320         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
321         I            regMask, arrMask,
322         I            dpphys(1-Olx,1-Oly,kl,bi,bj), arrArea,
323         I            drLoc, specialVal, exclSpVal, useWeight, myThid )
324    
325    c     ENDIF
326    #endif /* ALLOW_FIZHI */
327    
328          RETURN
329          END
330    
331    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
332    
333    CBOP
334    C     !ROUTINE: DIAGSTATS_G_CALC
335    C     !INTERFACE:
336          SUBROUTINE DIAGSTATS_G_CALC(
337         O                  statArr,
338         I                  inpArr, frcArr, scaleFact, useFract,
339         I                  nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,
340         I                  regMask, arrArea,
341         I                  specialVal, exclSpVal,
342         I                  k,bi,bj, parsFld, myThid )
343    
344    C     !DESCRIPTION:
345    C     Compute statistics for this tile, level, region
346    C     using "ground" (land) type fraction
347    
348    C     !USES:
349          IMPLICIT NONE
350    
351    #include "EEPARAMS.h"
352    #ifdef ALLOW_LAND
353    # include "LAND_SIZE.h"
354    # include "LAND_PARAMS.h"
355    # ifdef ALLOW_AIM
356    #  include "AIM_FFIELDS.h"
357    # endif
358    #else
359    # include "SIZE.h"
360    #endif
361    
362    C     !INPUT/OUTPUT PARAMETERS:
363    C     == Routine Arguments ==
364    C     statArr     :: output statistics array
365    C     inpArr      :: input field array to process (compute stats & add to statFld)
366    C     frcArr      :: fraction used for weighted-average diagnostics
367    C     useFract    :: if True, use fraction-weight
368    C     scaleFact   :: scaling factor
369    C     nStats      :: size of output statArr
370    C     sizI1,sizI2 :: size of inpArr array: 1rst index range (min,max)
371    C     sizJ1,sizJ2 :: size of inpArr array: 2nd  index range (min,max)
372    C     iRun,jRun   :: range of 1rst & 2nd index to process
373    C     regMask     :: regional mask
374    C     arrArea     :: Area weighting factor
375    C     specialVal  :: special value in input array (to exclude if exclSpVal=T)
376    C     exclSpVal   :: if T, exclude "specialVal" in input array
377    C     k,bi,bj     :: level and tile indices used for weighting (mask,area ...)
378    C     parsFld     :: parser field with characteristics of the diagnostics
379    C     myThid      :: my Thread Id number
380          INTEGER nStats,sizI1,sizI2,sizJ1,sizJ2
381          INTEGER iRun, jRun
382          _RL statArr(0:nStats)
383          _RL inpArr (sizI1:sizI2,sizJ1:sizJ2)
384          _RL frcArr (sizI1:sizI2,sizJ1:sizJ2)
385          _RL scaleFact
386          LOGICAL useFract
387          _RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
388          _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
389          _RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
390          _RL specialVal
391          LOGICAL exclSpVal
392          INTEGER k, bi, bj
393          CHARACTER*16 parsFld
394          INTEGER myThid
395    CEOP
396    
397    #ifdef ALLOW_LAND
398    C     !LOCAL VARIABLES:
399          LOGICAL useWeight
400          INTEGER kl
401          _RL drLoc
402    
403    c     IF ( useLand ) THEN
404    
405            IF ( parsFld(10:10).EQ.'G' ) THEN
406              kl = MIN(k,land_nLev)
407              drLoc = land_dzF(kl)
408            ELSE
409              drLoc = 1. _d 0
410            ENDIF
411            useWeight = .TRUE.
412    
413            CALL  DIAGSTATS_CALC(
414         O            statArr,
415         I            inpArr, frcArr, scaleFact, useFract,
416         I            nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
417         I            regMask, aim_landFr(1-Olx,1-Oly,bi,bj),
418         I            aim_landFr(1-Olx,1-Oly,bi,bj), arrArea,
419         I            drLoc, specialVal, exclSpVal, useWeight, myThid )
420    
421    c     ENDIF
422    #endif /* ALLOW_LAND */
423    
424          RETURN
425        END        END
426    
427  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 209  C---+----1----+----2----+----3----+----4 Line 429  C---+----1----+----2----+----3----+----4
429  CBOP  CBOP
430  C     !ROUTINE: DIAGSTATS_CALC  C     !ROUTINE: DIAGSTATS_CALC
431  C     !INTERFACE:  C     !INTERFACE:
432        SUBROUTINE DIAGSTATS_R_CALC(        SUBROUTINE DIAGSTATS_CALC(
433       U                  statArr,       O                  statArr,
434       I                  inpArr,       I                  inpArr, frcArr, scaleFact, useFract,
435       I                  sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,       I                  nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,
436       I                  regMask, arrMask, arrhFac, arrArea,       I                  regMask, arrMask, arrhFac, arrArea,
437       I                  arrDr, specialVal, exclSpVal, useWeight,       I                  arrDr, specialVal, exclSpVal, useWeight,
438       I                  myThid )       I                  myThid )
 c    I                  arrDr, k,bi,bj, parsFld, myThid )  
439    
440  C     !DESCRIPTION:  C     !DESCRIPTION:
441  C     Compute statistics for this tile, level, region  C     Compute statistics for this tile, level, region
# Line 226  C     !USES: Line 445  C     !USES:
445    
446  #include "EEPARAMS.h"  #include "EEPARAMS.h"
447  #include "SIZE.h"  #include "SIZE.h"
 #include "DIAGNOSTICS_SIZE.h"  
 c #include "PARAMS.h"  
 c #include "GRID.h"  
 c #include "SURFACE.h"  
448    
449  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
450  C     == Routine Arguments ==  C     == Routine Arguments ==
451  C     statArr     :: cumulative statistics array (updated)  C     statArr     :: output statistics array
452  C     inpArr      :: input field array to process (compute stats & add to statFld)  C     inpArr      :: input field array to process (compute stats & add to statFld)
453    C     frcArr      :: fraction used for weighted-average diagnostics
454    C     useFract    :: if True, use fraction-weight
455    C     scaleFact   :: scaling factor
456    C     nStats      :: size of output array: statArr
457  C     sizI1,sizI2 :: size of inpArr array: 1rst index range (min,max)  C     sizI1,sizI2 :: size of inpArr array: 1rst index range (min,max)
458  C     sizJ1,sizJ2 :: size of inpArr array: 2nd  index range (min,max)  C     sizJ1,sizJ2 :: size of inpArr array: 2nd  index range (min,max)
459  C     iRun,jRun   :: range of 1rst & 2nd index to process  C     iRun,jRun   :: range of 1rst & 2nd index to process
# Line 249  C     useWeight   :: use weight factor " Line 468  C     useWeight   :: use weight factor "
468  Cc    k,bi,bj     :: level and tile indices used for weighting (mask,area ...)  Cc    k,bi,bj     :: level and tile indices used for weighting (mask,area ...)
469  Cc    parsFld     :: parser field with characteristics of the diagnostics  Cc    parsFld     :: parser field with characteristics of the diagnostics
470  C     myThid      :: my Thread Id number  C     myThid      :: my Thread Id number
471        _RL statArr(0:nStats)        INTEGER nStats,sizI1,sizI2,sizJ1,sizJ2
       INTEGER sizI1,sizI2,sizJ1,sizJ2  
472        INTEGER iRun, jRun        INTEGER iRun, jRun
473          _RL statArr(0:nStats)
474        _RL inpArr (sizI1:sizI2,sizJ1:sizJ2)        _RL inpArr (sizI1:sizI2,sizJ1:sizJ2)
475          _RL frcArr (sizI1:sizI2,sizJ1:sizJ2)
476          _RL scaleFact
477          LOGICAL useFract
478        _RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
479        _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
480        _RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
# Line 269  CEOP Line 491  CEOP
491  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
492  C     i,j    :: loop indices  C     i,j    :: loop indices
493        INTEGER i, j, n        INTEGER i, j, n
494        INTEGER im, ix, iv        INTEGER im, ix
       PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )  
495        _RL tmpVol        _RL tmpVol
496          _RL tmpFld
497    
498          im = nStats - 1
499          ix = nStats
500        DO n=0,nStats        DO n=0,nStats
501          statArr(n) = 0.          statArr(n) = 0.
502        ENDDO        ENDDO
503    
504        IF ( exclSpVal ) THEN        IF ( useFract .AND. exclSpVal ) THEN
505    
506           DO j = 1,jRun
507            DO i = 1,iRun
508              IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.
509         &                     .AND. inpArr(i,j).NE.specialVal ) THEN
510                tmpFld = scaleFact*inpArr(i,j)
511                IF ( statArr(0).EQ.0. ) THEN
512                  statArr(im) = tmpFld
513                  statArr(ix) = tmpFld
514                ELSE
515                  statArr(im) = MIN(tmpFld,statArr(im))
516                  statArr(ix) = MAX(tmpFld,statArr(ix))
517                ENDIF
518                IF ( useWeight ) THEN
519                  tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)*frcArr(i,j)
520                ELSE
521                  tmpVol = arrDr*arrArea(i,j)*frcArr(i,j)
522                ENDIF
523                statArr(0) = statArr(0) + tmpVol
524                statArr(1) = statArr(1) + tmpVol*tmpFld
525                statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld
526              ENDIF
527            ENDDO
528           ENDDO
529    
530          ELSEIF ( useFract ) THEN
531    
532           DO j = 1,jRun
533            DO i = 1,iRun
534              IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0. ) THEN
535                tmpFld = scaleFact*inpArr(i,j)
536                IF ( statArr(0).EQ.0. ) THEN
537                  statArr(im) = tmpFld
538                  statArr(ix) = tmpFld
539                ELSE
540                  statArr(im) = MIN(tmpFld,statArr(im))
541                  statArr(ix) = MAX(tmpFld,statArr(ix))
542                ENDIF
543                IF ( useWeight ) THEN
544                  tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)*frcArr(i,j)
545                ELSE
546                  tmpVol = arrDr*arrArea(i,j)*frcArr(i,j)
547                ENDIF
548                statArr(0) = statArr(0) + tmpVol
549                statArr(1) = statArr(1) + tmpVol*tmpFld
550                statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld
551              ENDIF
552            ENDDO
553           ENDDO
554    
555          ELSEIF ( exclSpVal ) THEN
556    
557         DO j = 1,jRun         DO j = 1,jRun
558          DO i = 1,iRun          DO i = 1,iRun
559            IF (arrMask(i,j).NE.0. .AND. inpArr(i,j).NE.specialVal) THEN            IF ( arrMask(i,j).NE.0.
560         &                     .AND. inpArr(i,j).NE.specialVal ) THEN
561                tmpFld = scaleFact*inpArr(i,j)
562              IF ( statArr(0).EQ.0. ) THEN              IF ( statArr(0).EQ.0. ) THEN
563                statArr(im) = inpArr(i,j)                statArr(im) = tmpFld
564                statArr(ix) = inpArr(i,j)                statArr(ix) = tmpFld
565              ELSE              ELSE
566                statArr(im) = MIN(inpArr(i,j),statArr(im))                statArr(im) = MIN(tmpFld,statArr(im))
567                statArr(ix) = MAX(inpArr(i,j),statArr(ix))                statArr(ix) = MAX(tmpFld,statArr(ix))
568              ENDIF              ENDIF
569              IF ( useWeight ) THEN              IF ( useWeight ) THEN
570                tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)                tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)
# Line 295  C     i,j    :: loop indices Line 572  C     i,j    :: loop indices
572                tmpVol = arrDr*arrArea(i,j)                tmpVol = arrDr*arrArea(i,j)
573              ENDIF              ENDIF
574              statArr(0) = statArr(0) + tmpVol              statArr(0) = statArr(0) + tmpVol
575              statArr(1) = statArr(1) + tmpVol*inpArr(i,j)              statArr(1) = statArr(1) + tmpVol*tmpFld
576              statArr(2) = statArr(2) + tmpVol*inpArr(i,j)*inpArr(i,j)              statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld
577            ENDIF            ENDIF
578          ENDDO          ENDDO
579         ENDDO         ENDDO
# Line 307  C     i,j    :: loop indices Line 584  C     i,j    :: loop indices
584          DO i = 1,iRun          DO i = 1,iRun
585  c         IF ( regMask(i,j).NE.0. .AND. arrMask(i,j).NE.0. ) THEN  c         IF ( regMask(i,j).NE.0. .AND. arrMask(i,j).NE.0. ) THEN
586            IF ( arrMask(i,j).NE.0. ) THEN            IF ( arrMask(i,j).NE.0. ) THEN
587                tmpFld = scaleFact*inpArr(i,j)
588              IF ( statArr(0).EQ.0. ) THEN              IF ( statArr(0).EQ.0. ) THEN
589                statArr(im) = inpArr(i,j)                statArr(im) = tmpFld
590                statArr(ix) = inpArr(i,j)                statArr(ix) = tmpFld
591              ELSE              ELSE
592                statArr(im) = MIN(inpArr(i,j),statArr(im))                statArr(im) = MIN(tmpFld,statArr(im))
593                statArr(ix) = MAX(inpArr(i,j),statArr(ix))                statArr(ix) = MAX(tmpFld,statArr(ix))
594              ENDIF              ENDIF
595              IF ( useWeight ) THEN              IF ( useWeight ) THEN
596                tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)                tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)
# Line 320  c         IF ( regMask(i,j).NE.0. .AND. Line 598  c         IF ( regMask(i,j).NE.0. .AND.
598                tmpVol = arrDr*arrArea(i,j)                tmpVol = arrDr*arrArea(i,j)
599              ENDIF              ENDIF
600              statArr(0) = statArr(0) + tmpVol              statArr(0) = statArr(0) + tmpVol
601              statArr(1) = statArr(1) + tmpVol*inpArr(i,j)              statArr(1) = statArr(1) + tmpVol*tmpFld
602              statArr(2) = statArr(2) + tmpVol*inpArr(i,j)*inpArr(i,j)              statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld
603            ENDIF            ENDIF
604          ENDDO          ENDDO
605         ENDDO         ENDDO
606    
607        ENDIF        ENDIF
608    
609        RETURN        RETURN
610        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22