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

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

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

Revision 1.1 - (hide annotations) (download)
Mon Jan 23 22:31:11 2006 UTC (18 years, 3 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint58e_post, mitgcm_mapl_00, checkpoint58u_post, checkpoint58w_post, checkpoint63d, checkpoint63e, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint58r_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint58q_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint59, checkpoint58f_post, checkpoint58d_post, checkpoint58c_post, checkpoint58a_post, checkpoint58i_post, checkpoint58g_post, checkpoint58o_post, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint58p_post, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y, checkpoint58b_post, checkpoint58m_post 
- split diagstats_local.F file in 3 ;
- compute statistics for each selected region.
1 jmc 1.1 C $Header: $
2     C $Name: $
3    
4     #include "DIAG_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: DIAGSTATS_CALC
8     C !INTERFACE:
9     SUBROUTINE DIAGSTATS_CALC(
10     O statArr,
11     I inpArr, frcArr, scaleFact, power, useFract,
12     I regId, regMskVal,
13     I nStats,sizI1,sizI2,sizJ1,sizJ2, iRun,jRun,
14     I regMask, arrMask, arrhFac, arrArea,
15     I arrDr, specialVal, exclSpVal, useWeight,
16     I myThid )
17    
18     C !DESCRIPTION:
19     C Compute statistics for this tile, level, region
20    
21     C !USES:
22     IMPLICIT NONE
23    
24     #include "EEPARAMS.h"
25     #include "SIZE.h"
26    
27     C !INPUT/OUTPUT PARAMETERS:
28     C == Routine Arguments ==
29     C statArr :: output statistics array
30     C inpArr :: input field array to process (compute stats & add to statFld)
31     C frcArr :: fraction used for weighted-average diagnostics
32     C scaleFact :: scaling factor
33     C power :: option to fill-in with the field square (power=2)
34     C useFract :: if True, use fraction-weight
35     C regId :: region number Id
36     C regMskVal :: region-mask identificator value
37     C (point i,j belong to region "regId" <=> regMask(i,j) = regMskVal)
38     C nStats :: size of output array: statArr
39     C sizI1,sizI2 :: size of inpArr array: 1rst index range (min,max)
40     C sizJ1,sizJ2 :: size of inpArr array: 2nd index range (min,max)
41     C iRun,jRun :: range of 1rst & 2nd index to process
42     C regMask :: regional mask
43     C arrMask :: mask for this input array
44     C arrhFac :: weight factor (horizontally varying)
45     C arrArea :: Area weighting factor
46     C arrDr :: uniform weighting factor
47     C specialVal :: special value in input array (to exclude if exclSpVal=T)
48     C exclSpVal :: if T, exclude "specialVal" in input array
49     C useWeight :: use weight factor "arrhFac"
50     Cc k,bi,bj :: level and tile indices used for weighting (mask,area ...)
51     Cc parsFld :: parser field with characteristics of the diagnostics
52     C myThid :: my Thread Id number
53     INTEGER nStats,sizI1,sizI2,sizJ1,sizJ2
54     INTEGER iRun, jRun
55     _RL statArr(0:nStats)
56     _RL inpArr (sizI1:sizI2,sizJ1:sizJ2)
57     _RL frcArr (sizI1:sizI2,sizJ1:sizJ2)
58     _RL scaleFact
59     INTEGER power
60     LOGICAL useFract
61     INTEGER regId
62     _RS regMskVal
63     _RS regMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
64     _RS arrMask(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
65     _RS arrhFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
66     _RS arrArea(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
67     _RL arrDr
68     _RL specialVal
69     LOGICAL exclSpVal
70     LOGICAL useWeight
71     INTEGER myThid
72     CEOP
73    
74     C !LOCAL VARIABLES:
75     C i,j :: loop indices
76     INTEGER i, j, n
77     INTEGER im, ix
78     _RL tmpVol
79     _RL tmpFld
80     _RL tmpFac
81    
82     im = nStats - 1
83     ix = nStats
84     DO n=0,nStats
85     statArr(n) = 0.
86     ENDDO
87     tmpFac = scaleFact
88     IF ( power.EQ.2) tmpFac = scaleFact*scaleFact
89    
90     IF ( regId.EQ.0 .AND. useFract .AND. exclSpVal ) THEN
91    
92     DO j = 1,jRun
93     DO i = 1,iRun
94     IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.
95     & .AND. inpArr(i,j).NE.specialVal ) THEN
96     IF ( power.EQ.2) THEN
97     tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)
98     ELSE
99     tmpFld = tmpFac*inpArr(i,j)
100     ENDIF
101     IF ( statArr(0).EQ.0. ) THEN
102     statArr(im) = tmpFld
103     statArr(ix) = tmpFld
104     ELSE
105     statArr(im) = MIN(tmpFld,statArr(im))
106     statArr(ix) = MAX(tmpFld,statArr(ix))
107     ENDIF
108     IF ( useWeight ) THEN
109     tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)*frcArr(i,j)
110     ELSE
111     tmpVol = arrDr*arrArea(i,j)*frcArr(i,j)
112     ENDIF
113     statArr(0) = statArr(0) + tmpVol
114     statArr(1) = statArr(1) + tmpVol*tmpFld
115     statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld
116     ENDIF
117     ENDDO
118     ENDDO
119    
120     ELSEIF ( regId.EQ.0 .AND. useFract ) THEN
121    
122     DO j = 1,jRun
123     DO i = 1,iRun
124     IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0. ) THEN
125     IF ( power.EQ.2) THEN
126     tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)
127     ELSE
128     tmpFld = tmpFac*inpArr(i,j)
129     ENDIF
130     IF ( statArr(0).EQ.0. ) THEN
131     statArr(im) = tmpFld
132     statArr(ix) = tmpFld
133     ELSE
134     statArr(im) = MIN(tmpFld,statArr(im))
135     statArr(ix) = MAX(tmpFld,statArr(ix))
136     ENDIF
137     IF ( useWeight ) THEN
138     tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)*frcArr(i,j)
139     ELSE
140     tmpVol = arrDr*arrArea(i,j)*frcArr(i,j)
141     ENDIF
142     statArr(0) = statArr(0) + tmpVol
143     statArr(1) = statArr(1) + tmpVol*tmpFld
144     statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld
145     ENDIF
146     ENDDO
147     ENDDO
148    
149     ELSEIF ( regId.EQ.0 .AND. exclSpVal ) THEN
150    
151     DO j = 1,jRun
152     DO i = 1,iRun
153     IF ( arrMask(i,j).NE.0.
154     & .AND. inpArr(i,j).NE.specialVal ) THEN
155     IF ( power.EQ.2) THEN
156     tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)
157     ELSE
158     tmpFld = tmpFac*inpArr(i,j)
159     ENDIF
160     IF ( statArr(0).EQ.0. ) THEN
161     statArr(im) = tmpFld
162     statArr(ix) = tmpFld
163     ELSE
164     statArr(im) = MIN(tmpFld,statArr(im))
165     statArr(ix) = MAX(tmpFld,statArr(ix))
166     ENDIF
167     IF ( useWeight ) THEN
168     tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)
169     ELSE
170     tmpVol = arrDr*arrArea(i,j)
171     ENDIF
172     statArr(0) = statArr(0) + tmpVol
173     statArr(1) = statArr(1) + tmpVol*tmpFld
174     statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld
175     ENDIF
176     ENDDO
177     ENDDO
178    
179     ELSEIF ( regId.EQ.0 ) THEN
180    
181     DO j = 1,jRun
182     DO i = 1,iRun
183     IF ( arrMask(i,j).NE.0. ) THEN
184     IF ( power.EQ.2) THEN
185     tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)
186     ELSE
187     tmpFld = tmpFac*inpArr(i,j)
188     ENDIF
189     IF ( statArr(0).EQ.0. ) THEN
190     statArr(im) = tmpFld
191     statArr(ix) = tmpFld
192     ELSE
193     statArr(im) = MIN(tmpFld,statArr(im))
194     statArr(ix) = MAX(tmpFld,statArr(ix))
195     ENDIF
196     IF ( useWeight ) THEN
197     tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)
198     ELSE
199     tmpVol = arrDr*arrArea(i,j)
200     ENDIF
201     statArr(0) = statArr(0) + tmpVol
202     statArr(1) = statArr(1) + tmpVol*tmpFld
203     statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld
204     ENDIF
205     ENDDO
206     ENDDO
207    
208     ELSEIF ( useFract .AND. exclSpVal ) THEN
209    
210     DO j = 1,jRun
211     DO i = 1,iRun
212     IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.
213     & .AND. inpArr(i,j).NE.specialVal
214     & .AND. regMask(i,j).EQ.regMskVal ) THEN
215     IF ( power.EQ.2) THEN
216     tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)
217     ELSE
218     tmpFld = tmpFac*inpArr(i,j)
219     ENDIF
220     IF ( statArr(0).EQ.0. ) THEN
221     statArr(im) = tmpFld
222     statArr(ix) = tmpFld
223     ELSE
224     statArr(im) = MIN(tmpFld,statArr(im))
225     statArr(ix) = MAX(tmpFld,statArr(ix))
226     ENDIF
227     IF ( useWeight ) THEN
228     tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)*frcArr(i,j)
229     ELSE
230     tmpVol = arrDr*arrArea(i,j)*frcArr(i,j)
231     ENDIF
232     statArr(0) = statArr(0) + tmpVol
233     statArr(1) = statArr(1) + tmpVol*tmpFld
234     statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld
235     ENDIF
236     ENDDO
237     ENDDO
238    
239     ELSEIF ( useFract ) THEN
240    
241     DO j = 1,jRun
242     DO i = 1,iRun
243     IF ( arrMask(i,j).NE.0. .AND. frcArr(i,j).NE.0.
244     & .AND. regMask(i,j).EQ.regMskVal ) THEN
245     IF ( power.EQ.2) THEN
246     tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)
247     ELSE
248     tmpFld = tmpFac*inpArr(i,j)
249     ENDIF
250     IF ( statArr(0).EQ.0. ) THEN
251     statArr(im) = tmpFld
252     statArr(ix) = tmpFld
253     ELSE
254     statArr(im) = MIN(tmpFld,statArr(im))
255     statArr(ix) = MAX(tmpFld,statArr(ix))
256     ENDIF
257     IF ( useWeight ) THEN
258     tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)*frcArr(i,j)
259     ELSE
260     tmpVol = arrDr*arrArea(i,j)*frcArr(i,j)
261     ENDIF
262     statArr(0) = statArr(0) + tmpVol
263     statArr(1) = statArr(1) + tmpVol*tmpFld
264     statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld
265     ENDIF
266     ENDDO
267     ENDDO
268    
269     ELSEIF ( exclSpVal ) THEN
270    
271     DO j = 1,jRun
272     DO i = 1,iRun
273     IF ( arrMask(i,j).NE.0.
274     & .AND. inpArr(i,j).NE.specialVal
275     & .AND. regMask(i,j).EQ.regMskVal ) THEN
276     IF ( power.EQ.2) THEN
277     tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)
278     ELSE
279     tmpFld = tmpFac*inpArr(i,j)
280     ENDIF
281     IF ( statArr(0).EQ.0. ) THEN
282     statArr(im) = tmpFld
283     statArr(ix) = tmpFld
284     ELSE
285     statArr(im) = MIN(tmpFld,statArr(im))
286     statArr(ix) = MAX(tmpFld,statArr(ix))
287     ENDIF
288     IF ( useWeight ) THEN
289     tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)
290     ELSE
291     tmpVol = arrDr*arrArea(i,j)
292     ENDIF
293     statArr(0) = statArr(0) + tmpVol
294     statArr(1) = statArr(1) + tmpVol*tmpFld
295     statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld
296     ENDIF
297     ENDDO
298     ENDDO
299    
300     ELSE
301    
302     DO j = 1,jRun
303     DO i = 1,iRun
304     IF ( arrMask(i,j).NE.0.
305     & .AND. regMask(i,j).EQ.regMskVal ) THEN
306     IF ( power.EQ.2) THEN
307     tmpFld = tmpFac*inpArr(i,j)*inpArr(i,j)
308     ELSE
309     tmpFld = tmpFac*inpArr(i,j)
310     ENDIF
311     IF ( statArr(0).EQ.0. ) THEN
312     statArr(im) = tmpFld
313     statArr(ix) = tmpFld
314     ELSE
315     statArr(im) = MIN(tmpFld,statArr(im))
316     statArr(ix) = MAX(tmpFld,statArr(ix))
317     ENDIF
318     IF ( useWeight ) THEN
319     tmpVol = arrDr*arrhFac(i,j)*arrArea(i,j)
320     ELSE
321     tmpVol = arrDr*arrArea(i,j)
322     ENDIF
323     statArr(0) = statArr(0) + tmpVol
324     statArr(1) = statArr(1) + tmpVol*tmpFld
325     statArr(2) = statArr(2) + tmpVol*tmpFld*tmpFld
326     ENDIF
327     ENDDO
328     ENDDO
329    
330     ENDIF
331    
332     RETURN
333     END
  ViewVC Help
Powered by ViewVC 1.1.22