source: trunk/CALCULS/moyenne.pro @ 2

Last change on this file since 2 was 2, checked in by opalod, 22 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 21.8 KB
Line 
1;------------------------------------------------------------
2;------------------------------------------------------------
3;------------------------------------------------------------
4;+
5; NAME: moyenne
6;
7; PURPOSE:  averages a 2- or 3-d field over a selected
8;           geographical area and along one ore more
9;           selected axes (x, y or z)
10;
11; CATEGORY:
12;
13; CALLING SEQUENCE: result = moyenne(tab,'direc',BOITE=boite)
14;
15; INPUTS:       tab = 2 or 3d field
16;               direc = 'x' 'y' 'z' 'xy' 'xz' 'yz' or 'xyz'
17;
18; KEYWORD PARAMETERS:
19;
20;               BOITE = [xmin,xmax,ymin,ymax (,(zmin,)zmax)] pour plus
21;               de detail cf domdef.
22;               boite peut prendre 5 formes:
23;               [prof2], [prof1, prof2],[lon1, lon2, lat1, lat2], 
24;               [lon1, lon2, lat1, lat2, prof2],[lon1, lon2, lat1,
25;               lat2, prof1,prof2]
26;
27;               NAN: not a number, a activer si l''on peut faire veut
28;               faire une moyenne sans tenir compte de certaines
29;               valeurs masques de tab.
30;               si les valeurs masques de tab sont la valeur consacree
31;               par IDL (!values.f_nan), il suffit de mettre /NAN.
32;               si les valeurs masques de tab on pour valeur a (a doit
33;               etre differente de 1 (correspond a nan =
34;               !values.f_nan) et de 0 (qui desactive nan)
35;               il faut mettre NAN=a.
36;               Rq: en sorties les points de result qui sont NAN
37;               auront pour valeur a ou !values.f_nan.
38;
39;               NODOMDEF: activer si l''on ne veut pas passer ds
40;               domdef bien que le mot cle boite soit present (comme
41;               c''est le cas qd moyenne est appelee via checkfield)
42;           
43;               INTEGRATION: pour faire une integrale plutot qu''une moyenne
44;           
45; OUTPUTS:  result:un tableau
46;
47; COMMON BLOCKS:
48;       common   domdef
49;
50; SIDE EFFECTS:met les valeurs correspondants a la terre a 1e20
51;
52; RESTRICTIONS:
53;
54; EXAMPLE:
55;
56; MODIFICATION HISTORY: Jerome Vialard (jv@lodyc.jussieu.fr)
57;                       2/7/98
58;                       Sebastien Masson (smasson@lodyc.jussieu.fr)
59;                       mise au propre de certains truc (les terres...)
60;                       14/8/98
61;                       15/1/98
62;                       11/3/99 adaptation pour NAN
63;                       28/7/99 moyennes tableaux 1d
64;-
65;------------------------------------------------------------
66;------------------------------------------------------------
67; PLAN DU PROGRAMME:
68;------------------------------------------------------------
69;------------------------------------------------------------
70;I) preliminaires
71;   I.1) determination des directions de moyennes d''apres direc
72;   I.2) verification de la taille du tableau d''entree
73;   I.3) obtention des facteurs d''echelles et du masque sur le sous
74;   domaine concerne par la moyenne
75;  ) moyennes pour les tableaux 1d (x,y)
76;II) moyennes pour les tableaux 2d (x,y)
77;   II.1) verification de la coherence de la taille du tableau a
78;   moyenner
79;   II.2) differents types de moyennes possibles
80;III) moyennes pour les tableaux 3d (x,y,z)
81;   III.1) verification de la coherence de la taille du tableau a
82;   moyenner
83;   III.2) differents types de moyennes possibles
84;IV ) finitions
85;   IV.1) on masque les terres par une valeur a 1e+20
86;   IV.2) on remplace, quand nan ne 1, !values.f_nan par nan
87;   IV.3) on revient au sous domaine initial.
88;------------------------------------------------------------
89;------------------------------------------------------------
90function moyenne ,tab,direc,BOITE=boite, INTEGRATION=integration $
91                  , NAN = nan, NODOMDEF = nodomdef, _extra = ex
92@common
93   tempsun = systime(1)         ; pour key_performance
94;------------------------------------------------------------
95;I) preliminaires
96;------------------------------------------------------------
97   dirt = 0
98   dirx = 0
99   diry = 0
100   dirz = 0
101;------------------------------------------------------------
102; I.1) direction(s) suivants lesquelles on integre
103;------------------------------------------------------------
104   if ( strpos(direc,'t') ge 0 ) then dirt = 1
105   if ( strpos(direc,'x') ge 0 ) then dirx = 1
106   if ( strpos(direc,'y') ge 0 ) then diry = 1
107   if ( strpos(direc,'z') ge 0 ) then dirz = 1
108   if (dirx eq 0 and diry eq 0 and dirz eq 0) then BEGIN
109      IF keyword_set(bavard) then $
110       IF dirt NE 1 THEN ras = report('MOYENNE: aucune valeur de direc ne convient, le champ reste inchange')
111      return, tab
112   ENDIF
113;------------------------------------------------------------
114; I.2) verification de la taille du tableau d'entree
115;------------------------------------------------------------
116   taille = size(tab)
117   case 1 of
118      taille[0] eq 1 :dim = '1d'
119      taille[0] eq 2 :BEGIN
120         dim = '2d'
121         if dirx eq 0 and diry eq 0 then return, tab
122      END
123      taille[0] eq 3 :BEGIN
124         dim = '3d'
125         if dirx eq 0 and diry eq 0 and dirz eq 0 then return, tab
126      END
127      else : return, report('Le tableau d''entree doit etre a 2 ou 3 dimensions s''il contient une dim temporelle utiliser grossemoyenne')
128   endcase
129;------------------------------------------------------------
130;   I.3) obtention des facteurs d''echelles et du masque sur le sous
131;   domaine concerne par la moyenne
132; redefinition du domaine ajuste a boite (a 6 elements)
133; ceci va nous permetre de faire les calcules que sur le sous domaine
134; comcerne par la moyenne. domdef, suivit de grille nous donne tous
135; les tableaux de la grille sur le sous domaine
136;------------------------------------------------------------
137   if keyword_set(boite) then BEGIN
138      Case 1 Of
139         N_Elements(Boite) Eq 1:bte=[lon1, lon2, lat1, lat2, 0.,boite[0]]
140         N_Elements(Boite) Eq 2:bte=[lon1, lon2, lat1, lat2, boite[0],boite[1]]
141         N_Elements(Boite) Eq 4:bte=[Boite, prof1, prof2]
142         N_Elements(Boite) Eq 5:bte=[Boite[0:3], 0, Boite[4]]
143         N_Elements(Boite) Eq 6:bte=Boite
144         Else: return, report('Mauvaise Definition de Boite')
145      endcase
146      oldboite = [lon1, lon2, lat1, lat2, prof1, prof2]
147      if NOT keyword_set(nodomdef) then domdef, bte,GRILLE=vargrid, _extra = ex
148   ENDIF
149;---------------------------------------------------------------
150; attribution du mask et des tableaux de longitude et latitude...
151;---------------------------------------------------------------
152   grille, mask, glam, gphi, gdep, nx, ny,nz,premierx,premiery,premierz,dernierx, derniery, dernierz,e1,e2,e3
153;------------------------------------------------------------
154;------------------------------------------------------------
155; II) Cas du tableau 1d
156;------------------------------------------------------------
157;------------------------------------------------------------
158   if dim EQ '1d' then BEGIN
159      if n_elements(tab) NE nx*ny AND n_elements(tab) NE nx*ny*nz then $
160       return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
161      case 1 of
162         nx EQ 1 AND ny EQ 1:BEGIN ;vecteur suivant z
163            case n_elements(tab) of
164               jpk:res = tab[premierz:dernierz]
165               nz:res = tab
166               ELSE:return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
167            ENDCASE
168            if dirz EQ 1 then BEGIN
169               dim = '3d'
170               taille = size(reform(res, nx, ny, nz))
171            ENDIF ELSE return, res
172         END
173         ny EQ 1:BEGIN          ;vecteur suivant x
174            case n_elements(tab) of
175               jpi:res = tab[premierx:dernierx]
176               nx:res = tab
177               ELSE:return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
178            ENDCASE
179            if dirx EQ 1 then BEGIN
180               dim = '2d'
181               taille = size(reform(res, nx, ny))
182            ENDIF ELSE return, res
183         END
184         nx EQ 1:BEGIN          ;vecteur suivant y
185            case n_elements(tab) of
186               jpj:res = tab[premiery:derniery]
187               ny:res = tab
188               ELSE:return, report('Probleme d''adequation entre les tailles du domaine et de la boite.')
189            ENDCASE
190            if diry EQ 1 then BEGIN
191               dim = '2d'
192               taille = size(reform(res, nx, ny))
193            ENDIF ELSE return, res
194         END
195      endcase
196   endif
197;------------------------------------------------------------
198;------------------------------------------------------------
199; II) Cas du tableau 2d
200;------------------------------------------------------------
201;------------------------------------------------------------
202   if (dim eq '2d') then begin
203;---------------------------------------------------------------
204;   II.1) verification de la coherence de la taille du tableau a
205;   moyenner
206; verification de la coherence entre la taille du tableau et le
207; domaine definit par domdef
208; le tableau en entree doit avoir soit la taille du domaine total
209; (jpi,jpj) soit celle du domaine reduit (nx,ny)
210;---------------------------------------------------------------
211      case 1 of
212         taille[1] eq jpi and taille[2] eq jpj: $
213          res = tab[premierx:dernierx, premiery:derniery]
214         taille[1] eq  nx and taille[2] eq  ny:res = tab
215         else:return, report('Probleme d''adequation entre les tailles du domaine nx*ny '+strtrim(nx, 1)+'*'+strtrim(ny, 1)+' et du tableau '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1))
216      ENDCASE
217      if keyword_set(nan) NE 0 then BEGIN
218         if nan NE 1 then BEGIN ; si nan n''est pas !values.f_nan
219; on le met a !values.f_nan
220            if abs(nan) LT 1e6 then notanumber = where(res EQ nan) $
221            ELSE notanumber = where(abs(res) GT abs(nan)/10.)
222            if notanumber[0] NE -1 then res[temporary(notanumber)] = !values.f_nan
223         ENDIF
224      ENDIF
225;---------------------------------------------------------------
226; rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER = 1, ET
227; S'ASSURER QU'ELLE EXISTE BIEN. D'OU LES reform(...,nx,ny,...) QUI
228; PEUVENT SEMBLER INUTILE AU DEPART
229;---------------------------------------------------------------
230      if nx EQ 1 OR ny EQ 1 then BEGIN
231         res = reform(res, nx, ny, /over)
232         mask =  reform(mask, nx, ny, nz, /over)
233         e1 =  reform(e1, nx, ny, /over)
234         e2 =  reform(e2, nx, ny, /over)
235      endif
236;---------------------------------------------------------------
237; II.3) differents types de moyennes
238;---------------------------------------------------------------
239      if nz eq jpk then mask = mask[*, *,niveau-1] ELSE mask = mask[*, *,nz-1]
240      if keyword_set(nan) NE 0 then begin
241         msknan = replicate(1., nx, ny)
242         notanumber = where(finite(res) EQ 0)
243         if notanumber[0] NE -1 then msknan[notanumber] = !values.f_nan
244      ENDIF ELSE msknan = 1
245      case 1 of
246         (dirx eq 1) and (diry eq 0) : begin
247            e = e1*mask
248            if keyword_set(integration) then divi=1 $
249            else begin
250               divi = e*msknan
251               if ny EQ 1 then divi = reform(divi,nx,ny, /over)
252               divi = total(divi,1, nan = nan)
253            endelse
254            res = res*e
255            if ny EQ 1 then res = reform(res,nx,ny, /over)
256            res = total(res,1, nan = nan)/(divi > 1.)
257            if keyword_set(nan) then begin
258               testnan  = finite(msknan)+(1-mask)
259               if ny EQ 1 then testnan  = reform(testnan,nx,ny, /over)
260               testnan = total(testnan,1)
261            endif
262         end
263         (dirx eq 0) and (diry eq 1) : begin
264            e = e2*mask
265            if keyword_set(integration) then divi=1 $
266            else begin
267               divi = e*msknan
268               if ny EQ 1 then divi = reform(divi,nx,ny, /over)
269               divi = total(divi,2, nan = nan)
270            endelse
271            res = res*e
272            if ny EQ 1 then res = reform(res,nx,ny, /over)
273            res = total(res,2, nan = nan)/(divi > 1.)
274            if keyword_set(nan) then begin
275               testnan  = finite(msknan)+(1-mask)
276               if ny EQ 1 then testnan  = reform(testnan,nx,ny, /over)
277               testnan = total(testnan,2)
278            endif
279         end
280         (dirx eq 1) and (diry eq 1) : begin
281            if keyword_set(integration) then divi=1 else divi = total(e1*e2*mask*msknan, nan = nan)
282            res = total(res*e1*e2*mask, nan = nan)/(divi > 1.)
283            if keyword_set(nan) then begin
284               testnan  = finite(msknan)+(1-mask)
285               testnan = total(testnan)
286            endif
287         end
288      endcase
289   endif
290;------------------------------------------------------------
291;------------------------------------------------------------
292; III) Cas du tableau 3d
293;------------------------------------------------------------
294;------------------------------------------------------------
295   if (dim eq '3d') then begin
296;---------------------------------------------------------------
297; III.1) verification de la coherence de la taille du tableau a
298; moyenner
299; verification de la coherence entre la taille du tableau et le
300; domaine definit par domdef
301; le tableau en entree doit avoir soit la taille du domaine total
302; (jpi,jpj,jpk) soit celle du domaine reduit (nx,ny,ny)
303;---------------------------------------------------------------
304      case 1 of
305         taille[1] eq jpi and taille[2] eq jpj and taille[3] eq jpk: $
306          res=tab[premierx:dernierx, premiery:derniery, premierz:dernierz]
307         taille[1] eq jpi and taille[2] eq jpj and taille[3] eq nz: $
308          res=tab[premierx:dernierx, premiery:derniery, *]
309         taille[1] EQ  nx and taille[2] eq  ny and taille[3] eq nz :res=tab
310         taille[1] EQ  nx and taille[2] eq  ny and taille[3] eq jpk : $
311          res=tab[*, *, premierz:dernierz]
312         else:return, report('Probleme d''adequation entre les tailles du domaine nx*ny*nz '+strtrim(nx, 1)+'*'+strtrim(ny, 1)+'*'+strtrim(nz, 1)+' et du tableau '+strtrim(taille[1], 1)+'*'+strtrim(taille[2], 1)+'*'+strtrim(taille[3], 1))
313      endcase
314      if keyword_set(nan) NE 0 then BEGIN
315         if nan NE 1 then BEGIN ; si nan n''est pas !values.f_nan
316; on le met a !values.f_nan
317            if abs(nan) LT 1e6 then notanumber = where(res EQ nan) $
318            ELSE notanumber = where(abs(res) GT abs(nan)/10.)
319            if notanumber[0] NE -1 then res[temporary(notanumber)] = !values.f_nan
320         ENDIF
321      ENDIF
322;---------------------------------------------------------------
323; rq IL FAUT FAIRE ATTENTION AUX CAS OU LA DIM A MOYENNER = 1, ET
324; S'ASSURER QU'ELLE EXISTE BIEN. D'OU LES reform(...,nx,ny,...) QUI
325; PEUVENT SEMBLER INUTILE AU DEPART
326;---------------------------------------------------------------
327      if nx EQ 1 OR ny EQ 1 OR nz EQ 1 then BEGIN
328         res = reform(res, nx, ny, nz, /over)
329         mask =  reform(mask, nx, ny, nz, /over)
330         e1 =  reform(e1, nx, ny, /over)
331         e2 =  reform(e2, nx, ny, /over)
332      endif
333;---------------------------------------------------------------
334; III.2) differents types de moyennes
335;---------------------------------------------------------------
336      if keyword_set(nan) NE 0 then begin
337         msknan = replicate(1., nx, ny, nz)
338         notanumber = where(finite(res) EQ 0)
339         if notanumber[0] NE -1 then msknan[notanumber] = !values.f_nan
340      ENDIF ELSE msknan = 1
341      case 1 of
342         (dirx eq 1) and (diry eq 0) and (dirz eq 0) : begin
343            e13 = e1[*]#replicate(1.,nz)
344            e13 = reform(e13,nx,ny,nz, /over)
345            if keyword_set(integration) then divi = 1 else begin
346               divi = e13*mask*msknan
347               if nz EQ 1 then divi = reform(divi,nx,ny,nz, /over)
348               divi = total(divi,1, nan = nan)
349            endelse
350            res = res*e13*mask
351            if nz EQ 1 then res = reform(res,nx,ny,nz, /over)
352            res = total(res,1, nan = nan)/(divi > 1.)
353            e13 = 1
354            if keyword_set(nan) then begin
355               testnan  = finite(msknan)+(1-mask)
356               if nz EQ 1 then testnan  = reform(testnan,nx,ny,nz, /over)
357               testnan = total(testnan,1)
358            endif
359         end
360         (dirx eq 0) and (diry eq 1) and (dirz eq 0) : begin
361            e23 = e2[*]#replicate(1.,nz)
362            e23 = reform(e23,nx,ny,nz, /over)
363            if keyword_set(integration) then divi =1 else begin
364               divi = e23*mask*msknan
365               if nz EQ 1 then divi = reform(divi,nx,ny,nz, /over)
366               divi = total(divi,2, nan = nan)
367            endelse
368            res = res*e23*mask
369            if nz EQ 1 then res = reform(res,nx,ny,nz, /over)
370            res = total(res,2, nan = nan)/(divi > 1.)
371            e23 = 1
372            if keyword_set(nan) then begin
373               testnan  = finite(msknan)+(1-mask)
374               if nz EQ 1 then testnan  = reform(testnan,nx,ny,nz, /over)
375               testnan = total(testnan,2)
376            endif
377         end
378         (dirx eq 0) and (diry eq 0) and (dirz eq 1) : begin
379            e33 = replicate(1,1.*nx*ny)#e3
380            e33 = reform(e33,nx,ny,nz, /over)
381            if keyword_set(integration) then divi =1 else begin
382               divi = e33*mask*msknan
383               if nz EQ 1 then divi = reform(divi,nx,ny,nz, /over)
384               divi = total(divi,3, nan = nan)
385            endelse
386            res = res*e33*mask
387            if nz EQ 1 then res = reform(res,nx,ny,nz, /over)
388            res = total(res,3, nan = nan)/(divi > 1.)
389            e33 = 1
390            if keyword_set(nan) then begin
391               testnan  = finite(msknan)+(1-mask)
392               if nz EQ 1 then testnan  = reform(testnan,nx,ny,nz, /over)
393               testnan = total(testnan,3)
394            endif
395         end
396         (dirx eq 1) and (diry eq 1) and (dirz eq 0) : begin
397            e123 = (e1*e2)[*]#replicate(1.,nz)
398            e123 = reform(e123,nx,ny,nz, /over)
399            if keyword_set(integration) then divi =1 else $
400             divi = e123*mask*msknan
401            if nz EQ 1 then divi = reform(divi,nx,ny,nz, /over)
402            divi = total(total(divi,1, nan = nan),1, nan = nan)
403            res = res*e123*mask
404            if nz EQ 1 then res = reform(res,nx,ny,nz, /over)
405            res = total(total(res,1, nan = nan),1, nan = nan) / (divi > 1.)
406            e123 = 1
407            if keyword_set(nan) then begin
408               testnan  = finite(msknan)+(1-mask)
409               if nz EQ 1 then testnan  = reform(testnan,nx,ny,nz, /over)
410               testnan = total(total(testnan,1),1)
411            endif
412         end
413         (dirx eq 1) and (diry eq 0) and (dirz eq 1) : begin
414            e133 = e1[*]#e3
415            e133 = reform(e133,nx,ny,nz, /over)
416            divi = e133*mask*msknan
417            if nz EQ 1 then divi = reform(divi,nx,ny,nz, /over)
418            if keyword_set(integration) then divi =1 else $
419             divi = total(total(divi,1, nan = nan),2, nan = nan)
420            res = res*e133*mask
421            if nz EQ 1 then res = reform(res,nx,ny,nz, /over)
422            res = total(total(res,1, nan = nan),2, nan = nan) / (divi > 1.)
423            e133 = 1
424            if keyword_set(nan) then begin
425               testnan  = finite(msknan)+(1-mask)
426               if nz EQ 1 then testnan  = reform(testnan,nx,ny,nz, /over)
427               testnan = total(total(testnan,1),2)
428            endif
429         end
430         (dirx eq 0) and (diry eq 1) and (dirz eq 1) : begin
431            e233 = e2[*]#e3
432            e233 = reform(e233,nx,ny,nz, /over)
433            divi = e233*mask*msknan
434            if nz EQ 1 then divi = reform(divi,nx,ny,nz, /over)
435            if keyword_set(integration) then divi =1 else $
436             divi = total(total(divi,2, nan = nan),2, nan = nan)
437            res = res*e233*mask
438            if nz EQ 1 then res = reform(res,nx,ny,nz, /over)
439            res = total(total(res,2, nan = nan),2, nan = nan) / (divi > 1.)
440            e233 = 1
441            if keyword_set(nan) then begin
442               testnan  = finite(msknan)+(1-mask)
443               if nz EQ 1 then testnan  = reform(testnan,nx,ny,nz, /over)
444               testnan = total(total(testnan,2),2)
445            endif
446         end
447         (dirx eq 1) and (diry eq 1) and (dirz eq 1) : begin
448            e1233 = (e1*e2)[*]#e3
449            e1233 = reform(e1233,nx,ny,nz, /over)
450            if keyword_set(integration) then divi =1 else divi = total(e1233*mask*msknan, nan = nan)
451            res = total(res*e1233*mask, nan = nan) / (divi > 1.)
452            e1233 = 1
453            if keyword_set(nan) then begin
454               testnan  = finite(msknan)+(1-mask)
455               testnan = total(testnan)
456            endif
457         end
458      endcase
459   endif
460;------------------------------------------------------------
461;------------------------------------------------------------
462;IV ) finitions
463;------------------------------------------------------------
464;------------------------------------------------------------
465; IV.1) on masque les terres par une valeur a 1e+20
466;------------------------------------------------------------
467   valmask = 1e+20
468   terre = where(divi EQ 0)
469   IF terre[0] NE -1 THEN BEGIN
470      res(terre) = 1e+20
471   ENDIF 
472;------------------------------------------------------------
473; IV.2) on remplace, quand nan ne 1, !values.f_nan par nan
474;------------------------------------------------------------
475   if keyword_set(nan) NE 0 then BEGIN
476      puttonan = where(testnan EQ 0)
477      if puttonan[0] NE -1 then res[puttonan] = !values.f_nan
478      if nan NE 1 then BEGIN
479         notanumber = where(finite(res) eq 0)
480         if notanumber[0] NE -1 then res[notanumber] = nan
481      ENDIF
482   ENDIF
483;------------------------------------------------------------
484; IV.3) on se remplace ds le sous domaine qui etait definit a l''entree de
485; moyenne
486;------------------------------------------------------------
487   if keyword_set(boite) AND NOT keyword_set(nodomdef) then domdef, oldboite,GRILLE=vargrid
488;------------------------------------------------------------
489   if keyword_set(key_performance) THEN print, 'temps moyenne', systime(1)-tempsun
490   return, res
491;------------------------------------------------------------
492;------------------------------------------------------------
493end
Note: See TracBrowser for help on using the repository browser.