source: trunk/ToBeReviewed/PLOTS/DIVERS/checkfield.pro @ 69

Last change on this file since 69 was 69, checked in by smasson, 18 years ago

debug + new xxx
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 14.7 KB
Line 
1;------------------------------------------------------------
2;------------------------------------------------------------
3;------------------------------------------------------------
4;+
5; NAME:checkfield
6;
7; PURPOSE:en entree de plt, pltz, pltt et plt1d, verifie que le
8; champ donne a bien une taille compatible avec le domaine et fait au
9; besoin les moyennes pour ressortir en fin de fonction un tableau 2d
10; si on fait un plot du type: 'xy', 'xz', 'xt', 'yz', 'yt', 'zt' ou un
11; tableau 1d si on fait un plot du type 'x', 'y', 'z', 't'.
12;
13; CATEGORY:en entree de plt, pltz, pltt et plt1d
14;
15; CALLING SEQUENCE:res=checkfield(field, procedure)
16;
17; INPUTS:
18;        filed: un champ recomdant aux criteres de litchamp.pro, cf.
19;        IDL>xhelp,'litchamp'
20;
21; KEYWORD PARAMETERS:
22;
23;         /WDEPTH: to specify that the field is at W depth instad of T
24;         depth (automatically activated if vargrid eq 'W')
25;
26; OUTPUTS:
27;
28; COMMON BLOCKS:common.pro
29;
30; SIDE EFFECTS:
31;
32; RESTRICTIONS:
33;
34; EXAMPLE:
35;
36; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
37;                      08/02/2000
38;-
39;------------------------------------------------------------
40;------------------------------------------------------------
41FUNCTION err_1d, type, n1, name, n2
42  return, report(['Error in "' + type + '" type plot with a 1D input array:' $
43                  , 'the number of elements of the input vector ('+strtrim(n1, 1)+') ' $
44                  , 'is not equal to ' + name + ' ('+strtrim(n2, 1)+')'], /simple)
45END
46;
47FUNCTION err_2d, type, sz, nx, ny, nz
48  @cm_4mesh
49  @cm_4cal
50  return, report(['Error in "' + type + '" type plot with a 2D input array:' $
51                  , 'the array dimensions ' + tostr(sz[1:2]) + ' are incompatible' $
52                  , 'with the the domain dimensions ' $
53                  , '[jpi/nx, jpj/ny, jpk/nz, jpt] = [' $
54                  + strtrim(jpi, 1) + '/' + strtrim(nx, 1) $
55                  + ', ' + strtrim(jpj, 1) + '/' + strtrim(ny, 1) $
56                  + ', ' + strtrim(jpk, 1) + '/' + strtrim(nz, 1) $
57                  + ', ' + strtrim(jpt, 1) + ']'], /simple)
58END
59;
60FUNCTION err_3d, type, sz, nx, ny, nz
61  @cm_4mesh
62  @cm_4cal
63  return, report(['Error in "' + type + '" type plot with a 3D input array:' $
64                  , 'the array dimensions ' + tostr(sz[1:3]) + ' are incompatible' $
65                  , 'with the the domain dimensions ' $
66                  , '[jpi/nx, jpj/ny, jpk/nz, jpt] = [' $
67                  + strtrim(jpi, 1) + '/' + strtrim(nx, 1) $
68                  + ', ' + strtrim(jpj, 1) + '/' + strtrim(ny, 1) $
69                  + ', ' + strtrim(jpk, 1) + '/' + strtrim(nz, 1) $
70                  + ', ' + strtrim(jpt, 1) + ']'], /simple)
71END
72;--------------------------------------------------------------
73;
74FUNCTION checkfield, field, procedure, TYPE = type, BOXZOOM = boxzoom, DIREC = direc, NOQUESTION = noquestion, VECTEUR = vecteur, WDEPTH = wdepth, _EXTRA = ex
75;--------------------------------------------------------------
76; include commons
77@cm_4mesh
78@cm_4cal
79@cm_4data
80  IF NOT keyword_set(key_forgetold) THEN BEGIN
81@updatenew
82@updatekwd
83  ENDIF
84;--------------------------------------------------------------
85; I1) lecture du champ
86;--------------------------------------------------------------
87  if n_elements(field) EQ 0 then return, report('field undefined')
88  arr = litchamp(field)
89; first check
90  IF n_elements(arr) EQ 1 THEN BEGIN
91    if arr EQ -1 then $
92      return, report('Error: input array = -1. Maybe the reading did ont perform well...', /simple) $
93    ELSE return, report('Error: input array is a scalar', /simple)     
94  ENDIF
95  nan = total(finite(arr, /nan)) < 1
96;---------------------------------------------------------------
97; redefinition du domaine
98;---------------------------------------------------------------
99  minprof = 0.
100  profdefault = 200.
101;
102  Case n_elements(boxzoom) OF
103    0:
104    1:localbox = [minprof, boxzoom[0]]
105    2:localbox = boxzoom
106    4:if strpos(type, 'z') NE -1 THEN $
107      localbox = [boxzoom, minprof, profdefault] ELSE localbox = boxzoom
108    5:localbox = [Boxzoom[0:3], minprof, Boxzoom[4]]
109    6:localbox = boxzoom
110    Else: return, report('Bad definition of boxzoom')
111  ENDCASE
112;
113  if keyword_set(localbox) then BEGIN
114    if keyword_set(vecteur) then grillechoice = [vargrid, 'T', 'U', 'V'] $
115    ELSE grillechoice = [vargrid, 'T']
116    if keyword_set(wdepth) then grillechoice = [grillechoice, 'W']
117    domdef, localbox, GRIDTYPE = grillechoice, _extra = ex
118  ENDIF
119;
120; la procedure domdef determine les elements qui sont a l''interieur
121; de la boxzoom.
122; si on fait un plot contenant l''axe z:
123; Suivant l''axe z si on veut par ex faire un dessin
124; entre 0 et 1000 il se peut que l''on selectionne les niveaux
125; correspondants aux profondeurs comprises entre 0 et 900m (vu la
126; discretisation assez lache de cet axe qd on atteint des profondeurs
127; elevees). Pour ne pas que le dessin s''arrete a 900 mais bien a
128; 1000, on va aller chercher le niveau au dessous de 1000, d''ou la
129; manip suivante sur la boxzoom: l''approfondir de 1 niveau sur la
130; verticale (si possible) sans changer les y range.
131  if strpos(type, 'z') NE -1 THEN BEGIN
132    if NOT keyword_set(localbox) then BEGIN
133      localbox = [minprof, profdefault]
134      if keyword_set(wdepth) then grillechoice = 'W' $
135      ELSE grillechoice = vargrid
136      domdef, localbox, GRIDTYPE = grillechoice
137    END
138    nelbox = n_elements(localbox)
139;on garde les yranges (axe z) avant de changer la boxzoom.
140    !y.range = [localbox[nelbox-1], localbox[nelbox-2]]
141    if vargrid EQ 'W' OR keyword_set(wdepth) then BEGIN
142      firstzw = 0 > (firstzw-1)
143      lastzw = (lastzw+1) < (jpk-1)
144      nzw = lastzw - firstzw + 1
145    ENDIF ELSE BEGIN
146      firstzt = 0 > (firstzt-1)
147      lastzt = (lastzt+1) < (jpk-1)
148      nzt = lastzt - firstzt + 1
149    ENDELSE
150    @updateold
151  ENDIF
152; make the automatic definition of type for pltz if type is not specified.
153  IF type EQ 'z' AND procedure EQ 'pltz' THEN $
154    if (lon2-lon1) gt (lat2-lat1) then type = 'xz' else type = 'yz'
155; make the automatic definition of type for pltt if type is not specified.
156  IF type EQ 'unkownpltt' AND procedure EQ 'pltt' THEN $
157    if (lon2-lon1) gt (lat2-lat1) then type = 'xt' else type = 'yt'
158;--------------------------------------------------------------
159; verification de la taille du tableau d''entree et de la valeur de type
160;--------------------------------------------------------------
161  grille, -1, -1, -1, -1, nx, ny, nz, firstx, firsty $
162    , firstz, lastx, lasty, lastz, WDEPTH = wdepth
163;--------------------------------------------------------------
164; basic checks
165;--------------------------------------------------------------
166  CASE 1 OF
167    nx EQ 1: IF strpos(type, 'x') NE -1 THEN return, report('Error: impossible to make a "' + type + '" type plot with nx = 1 ', /simple)
168    ny EQ 1: IF strpos(type, 'y') NE -1 THEN return, report('Error: impossible to make a "' + type + '" type plot with ny = 1 ', /simple)
169    nz EQ 1: IF strpos(type, 'z') NE -1 THEN return, report('Error: impossible to make a "' + type + '" type plot with nz = 1 ', /simple)
170    jpt EQ 1: IF strpos(type, 't') NE -1 THEN return, report('Error: impossible to make a "' + type + '" type plot with jpt = 1 ', /simple)
171    ELSE:
172  ENDCASE
173;--------------------------------------------------------------
174; is the size of the array compatible with teh domain?
175;--------------------------------------------------------------
176  arr = fitintobox(temporary(arr), nx, ny, nz, firstx, firsty $
177    , firstz, lastx, lasty, lastz)
178;--------------------------------------------------------------
179  sz = size(arr)
180  case sz[0] of
181;--------------------------------------------------------------
182    0:return, arr
183;--------------------------------------------------------------
184    1:BEGIN
185      nele = n_elements(arr)
186      case type of
187        't':if jpt NE nele THEN return, err_1d(type, nele, 'jpt', jpt)
188        'x':IF  nx NE nele THEN return, err_1d(type, nele,  'nx',  nx)
189        'y':IF  ny NE nele THEN return, err_1d(type, nele,  'ny',  ny)
190        'z':IF  nz NE nele THEN return, err_1d(type, nele,  'nz',  nx)
191        ELSE:return, report(['Error: ' $
192                            , 'Impossible to make a "'+type+'" plot with a 1D array'], /simple)
193      ENDCASE
194    END
195;--------------------------------------------------------------
196    2:BEGIN
197      case type of
198        'x':BEGIN
199          case 1 of
200            sz[1] EQ nx AND sz[2] EQ ny:direc = 'y' ; xy array
201            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz:direc = 'z' ; x(y)z array
202            sz[1] EQ nx AND sz[2] EQ jpt:direc = 't' ; xt array
203            ELSE:return, err_2d(type, sz, nx, ny, nz)
204          endcase
205        end
206        'y':BEGIN
207          case 1 of
208            sz[1] EQ nx AND sz[2] EQ ny:direc = 'x' ; xy array
209            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz:direc = 'z' ; (x)yz array
210            sz[1] EQ ny AND sz[2] EQ jpt:direc = 't' ; yt array
211            ELSE:return, err_2d(type, sz, nx, ny, nz)
212          endcase
213        END
214        'z':BEGIN
215          case 1 of
216            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz:direc = 'x' ; x(y)z array
217            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz:direc = 'y' ; (x)yz array
218            sz[1] EQ nz AND sz[2] EQ jpt:direc = 't' ; zt array
219            ELSE:return, err_2d(type, sz, nx, ny, nz)
220          endcase
221        END
222        't':BEGIN
223          case 1 OF
224            sz[1] EQ nx AND sz[2] EQ jpt:direc = 'x' ; xt array
225            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ jpt:direc = 'y' ; (x)yt array
226            nx EQ 1 AND ny EQ 1 AND sz[1] EQ nz AND sz[2] EQ jpt:direc = 'z' ; (x)(y)zt array
227            ELSE:return, err_2d(type, sz, nx, ny, nz)
228          ENDCASE
229        END
230        'xy':IF sz[1] NE nx OR sz[2] ne  ny THEN return, err_2d(type, sz, nx, ny, nz) ; xy array
231        'xz':IF sz[1] NE nx OR sz[2] ne  nz THEN return, err_2d(type, sz, nx, ny, nz) ; xz array
232        'yz':IF sz[1] NE ny OR sz[2] NE  nz THEN return, err_2d(type, sz, nx, ny, nz) ; yz array
233        'xt':IF sz[1] NE nx OR sz[2] NE jpt THEN return, err_2d(type, sz, nx, ny, nz) ; xt array
234        'yt':IF sz[1] NE ny OR sz[2] NE jpt THEN return, err_2d(type, sz, nx, ny, nz) ; yt array
235        'zt':IF sz[1] NE nz OR sz[2] NE jpt THEN return, err_2d(type, sz, nx, ny, nz) ; zt array
236      ENDCASE
237    END
238;--------------------------------------------------------------
239    3:BEGIN
240      case type of
241        'x':BEGIN
242          case 1 of
243            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ nz:direc = 'yz' ; xyz array
244            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'zt' ; x(y)zt array
245            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ jpt:direc = 'yt' ; xyt array
246            ELSE:return, err_3d(type, sz, nx, ny, nz)
247          endcase
248        END
249        'y':BEGIN
250          case 1 of
251            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ nz:direc = 'xz' ; xyz array
252            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'zt' ; (x)yzt array
253            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ jpt:direc = 'xt' ; xyt array
254            ELSE:return, err_3d(type, sz, nx, ny, nz)
255          endcase
256        END
257        'z':BEGIN
258          case 1 of
259            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ nz:direc = 'xy' ; xyz array
260            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'yt' ; (x)yzt array
261            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'xt' ; x(y)zt array
262            ELSE:return, err_3d(type, sz, nx, ny, nz)
263          endcase
264        END
265        't':BEGIN
266          case 1 of
267            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ jpt:direc = 'xy' ; xyt array
268            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'yz' ; (x)yzt array
269            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'xz' ; x(y)zt array
270            ELSE:return, err_3d(type, sz, nx, ny, nz)
271          endcase
272        END
273        'xy':BEGIN
274          case 1 OF
275            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ  nz:direc = 'z' ; xyz array
276            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ jpt:direc = 't' ; xyt array
277            ELSE:return, err_3d(type, sz, nx, ny, nz)
278          endcase
279        END
280        'xz':BEGIN
281          case 1 of
282            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ  nz:direc = 'y' ; xyz array
283            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 't' ; x(y)zt
284            ELSE:return, err_3d(type, sz, nx, ny, nz)
285          endcase
286        END
287        'yz':BEGIN
288          case 1 of
289            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ  nz:direc = 'x' ; xyz array
290            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 't' ; (x)yzt
291            ELSE:return, err_3d(type, sz, nx, ny, nz)
292          endcase
293        END
294        'xt':BEGIN
295          case 1 of
296            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ jpt:direc = 'y' ; xyt array
297            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'z' ; x(y)zt array
298            ELSE:return, err_3d(type, sz, nx, ny, nz)
299          endcase
300        END
301        'yt':BEGIN
302          case 1 of
303            sz[1] EQ nx AND sz[2] EQ ny AND sz[3] EQ jpt:direc = 'x' ; xyt array
304            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'z' ; (x)yzt array
305            ELSE:return, err_3d(type, sz, nx, ny, nz)
306          endcase
307        END
308        'zt':BEGIN
309          case 1 of
310            sz[1] EQ nx AND ny EQ 1 AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'x' ; x(y)zt array
311            nx EQ 1 AND sz[1] EQ ny AND sz[2] EQ nz AND sz[3] EQ jpt:direc = 'y' ; (x)yzt array
312            ELSE:return, err_3d(type, sz, nx, ny, nz)
313          ENDCASE
314        END
315      ENDCASE
316    END
317;--------------------------------------------------------------
318    4:BEGIN
319      CASE type OF
320        'x':direc = 'yzt'
321        'y':direc = 'xzt'
322        'z':direc = 'xyt'
323        't':direc = 'xyz'
324        'xy':direc = 'zt'
325        'xz':direc = 'yt'
326        'yz':direc = 'xt'
327        'xt':direc = 'yz'
328        'yt':direc = 'xz'
329        'zt':direc = 'xy'
330      ENDCASE
331    END
332  ENDCASE
333;--------------------------------------------------------------
334  IF keyword_set(direc) THEN BEGIN
335    IF strpos(direc, 't') NE -1 OR strpos(type, 't') NE -1 THEN $
336      arr = grossemoyenne(temporary(arr), direc, boxzoom = localbox $
337                          , NAN = nan, /NODOMDEF, WDEPTH = wdepth, _extra = ex) $
338    ELSE arr = moyenne(temporary(arr), direc, boxzoom = localbox $
339                       , NAN = nan, /NODOMDEF, WDEPTH = wdepth, _extra = ex)
340  ENDIF
341;--------------------------------------------------------------
342;--------------------------------------------------------------
343;--------------------------------------------------------------
344;--------------------------------------------------------------
345  RETURN, arr
346END
Note: See TracBrowser for help on using the repository browser.