/[MITgcm]/MITgcm/pkg/diagnostics/diagstats_local.F
ViewVC logotype

Annotation of /MITgcm/pkg/diagnostics/diagstats_local.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.11 - (hide annotations) (download)
Fri Aug 8 19:29:48 2014 UTC (9 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint65b
Changes since 1.10: +20 -12 lines 
Stats-Diags: do not cumulate the full volume when DIAGNOSTICS_FILL is
 called with bibjFlg < 0 (no increment of the counter for 2D/3D diag);
 This fix the mean statistics when DIAGNOSTICS_FILL is called multiple
 times (but Min,Max and StD are still wrong).
1 jmc 1.11 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagstats_local.F,v 1.10 2012/09/03 20:29:47 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "DIAG_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: DIAGSTATS_LOCAL
8     C !INTERFACE:
9     SUBROUTINE DIAGSTATS_LOCAL(
10     U statFld,
11 jmc 1.4 I inpFld, frcFld,
12     I scaleFact, power, useFract, sizF,
13 jmc 1.1 I sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,
14     I iRun,jRun,kIn,biIn,bjIn,
15 jmc 1.11 I k,bi,bj, bibjFlg, region2fill,
16     I ndId, parsFld, myThid )
17 jmc 1.1
18     C !DESCRIPTION:
19 jmc 1.2 C Update array statFld
20 jmc 1.1 C by adding statistics over the range [1:iRun],[1:jRun]
21     C from input field array inpFld
22 jmc 1.2 C- note:
23 jmc 1.1 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)
25     C from the main common blocks.
26 jmc 1.2 C c) for other type of grids, call a specifics S/R which include its own
27 jmc 1.1 C grid common blocks
28    
29     C !USES:
30     IMPLICIT NONE
31    
32     #include "EEPARAMS.h"
33     #include "SIZE.h"
34     #include "DIAGNOSTICS_SIZE.h"
35 jmc 1.6 #include "DIAGSTATS_REGIONS.h"
36 jmc 1.1 #include "PARAMS.h"
37     #include "GRID.h"
38 jmc 1.2 c #include "SURFACE.h"
39 jmc 1.1
40     C !INPUT/OUTPUT PARAMETERS:
41     C == Routine Arguments ==
42     C statFld :: cumulative statistics array (updated)
43     C inpFld :: input field array to process (compute stats & add to statFld)
44 jmc 1.3 C frcFld :: fraction used for weighted-average diagnostics
45     C scaleFact :: scaling factor
46 jmc 1.4 C power :: option to fill-in with the field square (power=2)
47 jmc 1.3 C useFract :: if True, use fraction-weight
48     C sizF :: size of frcFld array: 3rd dimension
49 jmc 1.1 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)
51     C sizK :: size of inpFld array: 3rd dimension
52     C sizTx,sizTy :: size of inpFld array: tile dimensions
53     C iRun,jRun :: range of 1rst & 2nd index
54 jmc 1.8 C kIn :: level index of inpFld array to process
55 jmc 1.3 C biIn,bjIn :: tile indices of inpFld array to process
56 jmc 1.1 C k,bi,bj :: level and tile indices used for weighting (mask,area ...)
57 jmc 1.11 C bibjFlg :: passed from calling S/R (see diagstats_fill.F)
58 jmc 1.1 C region2fill :: indicates whether to compute statistics over this region
59     C ndId :: Diagnostics Id Number (in available diag. list)
60     C parsFld :: parser field with characteristics of the diagnostics
61     C myThid :: my Thread Id number
62     _RL statFld(0:nStats,0:nRegions)
63     INTEGER sizI1,sizI2,sizJ1,sizJ2
64 jmc 1.3 INTEGER sizF,sizK,sizTx,sizTy
65 jmc 1.1 _RL inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)
66 jmc 1.3 _RL frcFld(sizI1:sizI2,sizJ1:sizJ2,sizF,sizTx,sizTy)
67     _RL scaleFact
68 jmc 1.4 INTEGER power
69 jmc 1.3 LOGICAL useFract
70 jmc 1.1 INTEGER iRun, jRun, kIn, biIn, bjIn
71 jmc 1.11 INTEGER k, bi, bj, bibjFlg
72 jmc 1.1 INTEGER region2fill(0:nRegions)
73 jmc 1.11 INTEGER ndId
74 jmc 1.1 CHARACTER*16 parsFld
75     INTEGER myThid
76     CEOP
77    
78 jmc 1.7 C !FUNCTIONS:
79     #ifdef ALLOW_FIZHI
80     _RL getcon
81     EXTERNAL getcon
82     #endif
83    
84 jmc 1.1 C !LOCAL VARIABLES:
85     C i,j :: loop indices
86 jmc 1.9 INTEGER i, n, kFr, kRegMsk
87 jmc 1.1 INTEGER im, ix, iv
88     PARAMETER ( iv = nStats - 2 , im = nStats - 1 , ix = nStats )
89     LOGICAL exclSpVal
90     LOGICAL useWeight
91     _RL statLoc(0:nStats)
92     _RL drLoc
93     _RL specialVal
94    
95     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
96    
97     useWeight = .FALSE.
98     exclSpVal = .FALSE.
99     specialVal = 0.
100 jmc 1.7 #ifdef ALLOW_FIZHI
101 jmc 1.1 IF ( useFIZHI ) THEN
102     exclSpVal = .TRUE.
103 jmc 1.2 specialVal = getcon('UNDEF')
104 jmc 1.1 ENDIF
105 jmc 1.7 #endif
106 jmc 1.3 kFr = MIN(kIn,sizF)
107 jmc 1.2
108 jmc 1.1 DO n=0,nRegions
109     IF (region2fill(n).NE.0) THEN
110     C--- Compute statistics for this tile, level and region:
111 jmc 1.2
112 jmc 1.6 kRegMsk = diagSt_kRegMsk(n)
113 jmc 1.1
114     IF ( parsFld(10:10) .EQ. 'R' ) THEN
115    
116     drLoc = drF(k)
117     IF ( parsFld(9:9).EQ.'L') drLoc = drC(k)
118     IF ( parsFld(9:9).EQ.'U') drLoc = drC(MIN(k+1,Nr))
119     IF ( parsFld(9:9).EQ.'M') useWeight = .TRUE.
120    
121     IF ( parsFld(2:2).EQ.'U' ) THEN
122 jmc 1.10 CALL DIAGSTATS_CALC(
123 jmc 1.1 O statLoc,
124     I inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
125 jmc 1.3 I frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
126 jmc 1.6 I scaleFact, power, useFract, n, diagSt_vRegMsk(n),
127 jmc 1.2 I nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
128 jmc 1.10 I diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
129     I maskW(1-OLx,1-OLy,k,bi,bj),
130     I hFacW(1-OLx,1-OLy,k,bi,bj), rAw(1-OLx,1-OLy,bi,bj),
131 jmc 1.1 I drLoc, specialVal, exclSpVal, useWeight, myThid )
132     c I drLoc, k,bi,bj, parsFld, myThid )
133     ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
134 jmc 1.10 CALL DIAGSTATS_CALC(
135 jmc 1.1 O statLoc,
136     I inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
137 jmc 1.3 I frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
138 jmc 1.6 I scaleFact, power, useFract, n, diagSt_vRegMsk(n),
139 jmc 1.2 I nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
140 jmc 1.10 I diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
141     I maskS(1-OLx,1-OLy,k,bi,bj),
142     I hFacS(1-OLx,1-OLy,k,bi,bj), rAs(1-OLx,1-OLy,bi,bj),
143 jmc 1.1 I drLoc, specialVal, exclSpVal, useWeight, myThid )
144     ELSE
145 jmc 1.10 CALL DIAGSTATS_CALC(
146 jmc 1.1 O statLoc,
147     I inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
148 jmc 1.3 I frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
149 jmc 1.6 I scaleFact, power, useFract, n, diagSt_vRegMsk(n),
150 jmc 1.2 I nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
151 jmc 1.10 I diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
152     I maskC(1-OLx,1-OLy,k,bi,bj),
153     I hFacC(1-OLx,1-OLy,k,bi,bj), rA(1-OLx,1-OLy,bi,bj),
154 jmc 1.1 I drLoc, specialVal, exclSpVal, useWeight, myThid )
155     ENDIF
156    
157 jmc 1.2 ELSEIF ( useFIZHI .AND.
158     & (parsFld(10:10).EQ.'L' .OR. parsFld(10:10).EQ.'M')
159     & ) THEN
160 jmc 1.10 CALL DIAGSTATS_LM_CALC(
161 jmc 1.1 O statLoc,
162     I inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
163 jmc 1.3 I frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
164 jmc 1.6 I scaleFact, power, useFract, n, diagSt_vRegMsk(n),
165 jmc 1.2 I nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
166 jmc 1.10 I diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
167     I maskInC(1-OLx,1-OLy,bi,bj), rA(1-OLx,1-OLy,bi,bj),
168 jmc 1.2 I specialVal, exclSpVal,
169     I k,bi,bj, parsFld, myThid )
170     ELSEIF ( useLand .AND.
171     & (parsFld(10:10).EQ.'G' .OR. parsFld(10:10).EQ.'g')
172     & ) THEN
173 jmc 1.10 CALL DIAGSTATS_G_CALC(
174 jmc 1.2 O statLoc,
175     I inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
176 jmc 1.3 I frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
177 jmc 1.6 I scaleFact, power, useFract, n, diagSt_vRegMsk(n),
178 jmc 1.2 I nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
179 jmc 1.10 I diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
180     I rA(1-OLx,1-OLy,bi,bj),
181 jmc 1.2 I specialVal, exclSpVal,
182     I k,bi,bj, parsFld, myThid )
183 jmc 1.1 c ELSEIF ( parsFld(10:10) .EQ. 'I' ) THEN
184     c ELSEIF ( parsFld(10:10) .EQ. '1' ) THEN
185     ELSE
186    
187     drLoc = 1. _d 0
188     IF ( parsFld(2:2).EQ.'U' ) THEN
189 jmc 1.10 CALL DIAGSTATS_CALC(
190 jmc 1.1 O statLoc,
191     I inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
192 jmc 1.3 I frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
193 jmc 1.6 I scaleFact, power, useFract, n, diagSt_vRegMsk(n),
194 jmc 1.2 I nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
195 jmc 1.10 I diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
196     I maskInW(1-OLx,1-OLy,bi,bj),
197     I maskInW(1-OLx,1-OLy,bi,bj),rAw(1-OLx,1-OLy,bi,bj),
198 jmc 1.1 I drLoc, specialVal, exclSpVal, useWeight, myThid )
199     ELSEIF ( parsFld(2:2).EQ.'V' ) THEN
200 jmc 1.10 CALL DIAGSTATS_CALC(
201 jmc 1.1 O statLoc,
202     I inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
203 jmc 1.3 I frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
204 jmc 1.6 I scaleFact, power, useFract, n, diagSt_vRegMsk(n),
205 jmc 1.2 I nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
206 jmc 1.10 I diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
207     I maskInS(1-OLx,1-OLy,bi,bj),
208     I maskInS(1-OLx,1-OLy,bi,bj),rAs(1-OLx,1-OLy,bi,bj),
209 jmc 1.1 I drLoc, specialVal, exclSpVal, useWeight, myThid )
210     ELSE
211 jmc 1.10 CALL DIAGSTATS_CALC(
212 jmc 1.1 O statLoc,
213     I inpFld(sizI1,sizJ1,kIn,biIn,bjIn),
214 jmc 1.3 I frcFld(sizI1,sizJ1,kFr,biIn,bjIn),
215 jmc 1.6 I scaleFact, power, useFract, n, diagSt_vRegMsk(n),
216 jmc 1.2 I nStats,sizI1,sizI2,sizJ1,sizJ2,iRun,jRun,
217 jmc 1.10 I diagSt_regMask(1-OLx,1-OLy,kRegMsk,bi,bj),
218     I maskInC(1-OLx,1-OLy,bi,bj),
219     I maskInC(1-OLx,1-OLy,bi,bj), rA(1-OLx,1-OLy,bi,bj),
220 jmc 1.1 I drLoc, specialVal, exclSpVal, useWeight, myThid )
221     ENDIF
222    
223     ENDIF
224    
225     C Update cumulative statistics array
226 jmc 1.6 IF ( statLoc(0).GT.0. ) THEN
227 jmc 1.11 IF ( statFld(0,n).LE.0. ) THEN
228     statFld(im,n) = statLoc(im)
229     statFld(ix,n) = statLoc(ix)
230     ELSE
231     statFld(im,n) = MIN( statFld(im,n), statLoc(im) )
232     statFld(ix,n) = MAX( statFld(ix,n), statLoc(ix) )
233     ENDIF
234     IF ( bibjFlg.GE.0 ) THEN
235 jmc 1.1 DO i=0,iv
236 jmc 1.11 statFld(i,n) = statFld(i,n) + statLoc(i)
237 jmc 1.1 ENDDO
238 jmc 1.11 ELSE
239     DO i=1,iv
240     statFld(i,n) = statFld(i,n) + statLoc(i)
241     ENDDO
242     ENDIF
243 jmc 1.6 ENDIF
244 jmc 1.1
245     C--- processing region "n" ends here.
246     ENDIF
247     ENDDO
248    
249 jmc 1.2 RETURN
250     END
  ViewVC Help
Powered by ViewVC 1.1.22