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