source: trunk/ToBeReviewed/PLOTS/DESSINE/pltbase.pro @ 67

Last change on this file since 67 was 67, checked in by pinsard, 18 years ago

miscellaneous modifications according to cerbere.lodyc.jussieu.fr: /usr/home/smasson/SAXO_RD/

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 14.8 KB
Line 
1;------------------------------------------------------------
2;------------------------------------------------------------
3;------------------------------------------------------------
4;+
5; NAME:pltbase
6;
7; PURPOSE: surcouche de contour pour tracer un champ eventuellement
8; masque. brique elementaire de plt, pltz et pltt.
9;
10; CATEGORY:un tarce vite fait et/ou delestage de l''ecriture de plt, pltz, pltt
11;
12; CALLING SEQUENCE: pltbase, z2d, x, y, mask,xm, ym, [, levels, colors],
13;
14; INPUTS:
15;        z2d:le tableau a tracer
16;
17;        x et y les axes. vecteurs ou tableaux de meme taille que
18;        z2d. Ce sont les coordonnees de z2d
19;
20;        mask: le tableau qui masque z2d (avec des 0 sur les points a
21;        masquer et des 1 sur les autres). si z2d n'est pas masque
22;        mettre cet argument egale a 1.
23;
24;        xm et ym les axes du mask. vecteurs ou tableaux de meme taille que
25;        mask. Ce sont les coordonnees de mask
26;
27;        levels et colors: (optionnels) les vecteurs qui contiennent
28;        les niveaus et les couleurs necessaires au contour. S''il ne
29;        sont pas donnes on prends 20 niveau entre le min et le max.
30;
31; KEYWORD PARAMETERS:
32;
33;        COLORTRICHAMP : la couleur que l''on veut utiliser pour
34;        dessiner la triangulation qui est utilisee pour faire les
35;        contour du champ
36;
37;        COLORTRIMASK : la couleur que l''on veut utiliser pour
38;        dessiner la triangulation qui est utilisee pour faire les
39;        contour du mask
40;
41;        COAST_COLOR: the color of the coastline.
42;                     defaut value is 0 => black
43;
44;        COAST_THICK: the thickness of the coastline.
45;                     defaut value is 1
46;
47;        COLOR_C: to draw the contour in color instead of in black
48;        with filling in color
49;
50;        /CONT_NOFILL: activer pour ne pas remplir les points masques
51;        pour les laisser en transparent!
52;        Rq: on trace qd meme le contour du mask
53;
54;        CONT_COLOR: the color of the continent. defaut value is
55;        (!d.n_colors - 1) < 255 => white
56;
57;        /DESSTRICHAMP: pour dessiner la triangulation qui est
58;        utilisee pour faire les contour du champ.
59;
60;        /DESSTRIMASK: pour dessiner la triangulation qui est
61;        utilisee pour faire les contour du mask
62;
63;        /FORPLT: a activer si on veut que le trace des cote soit
64;        realise par tracecote plutot que tracemask.
65;
66;        I_COLORS: un vecteur specifiant la couleur a utiliser pour
67;        tracer les contours. C''est la meme chose que c_colors qui
68;        ajit sur les contours.
69;
70;        MORE: chiffre a donner pour eviter les bug du style:
71;  % Out of range subscript encountered: <LONG      Array[38911]>.
72;  % Execution halted at:  PLTBASE           151
73;             par defaut more=10 si le bug existe tjs, augmenter la
74;             valeur de more! (l''explication et la justification de
75;             cette methode n''ont pas encore de fondements
76;             scientifiques)...
77;         
78;
79;
80;        /NOFILL: pour faire juste les isolignes
81;
82;        /NOCONTOUR: pour faire juste les couleurs
83;
84;        /UNSUR2: pour tarcer une isoligne sur 2
85;
86;        UNLABSUR: entier n. specifant qu''on ne labelle qu''un
87;        contour sur n
88;
89;        CONTOUR: pour etrte utilise depuis plt, pltz ou pltt. cf ces
90;        routines.
91;
92;        _EXTRA: mot cle magique d''idl pour faire passer tous lse
93;        mots cles acceptes par les routines et fonctions utilises ds
94;        ce programme sans les declarer explicitement.
95;
96; OUTPUTS:
97;
98; COMMON BLOCKS:
99;        common.pro
100;
101; SIDE EFFECTS:
102;
103; RESTRICTIONS:ds le cas ou z2d, x et y sont des tableaux de meme
104; taille il faut les metre sous forme de vecteur: z2d[*], x[*], y[*].
105;
106; EXAMPLE:
107;
108; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
109;                       ????
110;                       8/2/2000 check if the tri array is not equal to
111;                       -1. allow contour with out using a triangulation.
112;
113;-
114;------------------------------------------------------------
115;------------------------------------------------------------
116;------------------------------------------------------------
117PRO pltbase, z2d, x, y, mask, xm, ym, levels, colors, UNSUR2 = unsur2, CONTOUR = contour $
118             , NOCONTOUR = nocontour, NOFILL = nofill $
119             , TRICHAMP = trichamp, TRIMSK = trimsk $
120             , REALCONT = realcont, NAN = nan, usetri = usetri $
121             , COLORTRICHAMP = colortrichamp, COLORTRIMASK = colortrimask $
122             , COLORTRINAN = colortrinan $
123             , COLORPOINTS = colorpoints, DRAWPOINTS = drawpoints $
124             , TH_TRICHAMP = th_trichamp, TH_TRIMASK = th_trimask $
125             , DESSTRICHAMP = desstrichamp, DESSTRIMASK = desstrimask $
126             , DESSTRINAN = desstrinan, COLOR_C = color_c $
127             , I_COLORS = i_colors,  CONT_COLOR = CONT_COLOR $
128             , CONT_NOFILL = cont_nofill, UNLABSUR = unlabsur $
129             , COINMONTEMASK = coinmontemask, COINDESCENDMASK = coindescendmask $
130             , COINMONTENAN = coinmontenan, COINDESCENDNAN = coindescendnan $
131             , INDICEZOOMMASK = indicezoommask, INDICEZOOMNAN = indicezoomnan $
132             , MASKNAN = masknan, TRINAN = trinan $
133             , FORPLT = forplt, REALSECTION = realsection $
134             , MORE = more, EXCHANGE_XY = exchange_xy $
135             , _EXTRA = ex
136;---------------------------------------------------------
137@cm_4mesh
138  IF NOT keyword_set(key_forgetold) THEN BEGIN
139@updatenew
140@updatekwd
141  ENDIF
142;---------------------------------------------------------
143;
144; explication concernant contour. Ce mot cle est active qd on on trace
145; un contour en couleur different de celui en trait noir.
146; si il est active (cas n_elements(contour) NE 0), on passe 2 fois ds pltbase:
147;   1) on trace les couleurs puis on sort c''est le cas:
148;         n_elements(contour) NE 0 AND n_elements(contour) NE 4)
149;   2) on trace les contour en trait puis les continents c''est le cas
150;         n_elements(contour) NE 0 AND n_elements(contour) EQ 4)
151;
152;------------------------------------------------------------
153  tempsun = systime(1)          ; pour key_performance
154  if n_elements(mask) EQ 0 then mask = 1b
155  if n_elements(masknan) EQ 0 then masknan = 1b
156  IF total(mask) EQ n_elements(z2d) THEN mask = 1b
157;----------------------------------------------------------------------
158; si les niveaux et les couleurs ne sont pas donnes
159;----------------------------------------------------------------------
160  if n_params() EQ 4 then $
161    label, 0, min(z2d*mask), max(z2d*mask), ncontour, levels, colors
162; attention bidouille inexplicable pour que tout se passe bien avec les
163; postcript ds pltz!!!
164  if n_elements(contour) LE 4 AND !x.type EQ 0 THEN $
165    plot, [0], [0], xstyle = 5, ystyle = 5, /nodata, /noerase, title = '', subtitle = ''
166;----------------------------------------------------------------------
167; si cell_fill fait partit de _extra, on le desactive si il n''est pas
168; egale a 2
169;----------------------------------------------------------------------
170  IF chkstru(ex, 'CELL_FILL') THEN BEGIN
171    cell_fill = ex.CELL_FILL
172    if ex.CELL_FILL NE 2 then ex.CELL_FILL = 0
173  ENDIF ELSE cell_fill = 0      ;
174;----------------------------------------------------------------------
175; I) remplissage des contours en palette de couleur
176;----------------------------------------------------------------------
177  if NOT keyword_set(more) then more = 10
178  if NOT keyword_set(nofill) AND NOT keyword_set(color_c) then begin
179    if n_elements(contour) NE 4 THEN BEGIN
180      if usetri EQ 2 then BEGIN
181        IF size(x, /n_dimensions) EQ 1 THEN x = x#replicate(1, (size(z2d))[2])
182        IF size(y, /n_dimensions) EQ 1 THEN y = replicate(1, (size(z2d))[1])#y
183        contour, [z2d[*], fltarr(more)], [x[*], fltarr(more)] $
184          , [y[*], fltarr(more)], levels = levels, c_color = colors $
185          , /noerase, /fill, TRIANGULATION = trichamp, _extra = ex
186        ENDIF ELSE BEGIN
187        IF size(x, /n_dimensions) EQ 2 THEN x = x[*, 0]
188        IF size(y, /n_dimensions) EQ 2 THEN y = reform(y[0, *])
189        contour, z2d, x, y, levels = levels, c_color = colors, /noerase $
190          , /fill, _extra = ex
191      ENDELSE
192    ENDIF
193  ENDIF
194  if n_elements(contour) NE 0 AND n_elements(contour) NE 4 THEN GOTO, fini
195  IF chkstru(ex, 'C_ORIENTATION') THEN ex = extractstru(ex, 'C_ORIENTATION')
196  IF chkstru(ex, 'C_SPACING') THEN ex = extractstru(ex, 'C_SPACING')
197  IF chkstru(ex, 'C_COLORS') THEN ex = extractstru(ex, 'C_COLORS')
198;------------------------------------------------------------
199; II) trace des contours en trait
200;------------------------------------------------------------
201  if n_elements(contour) EQ 4 OR n_elements(contour) EQ 0 THEN BEGIN
202;
203; we put the masked values to NaN
204;
205    IF (n_elements(mask) GT 1 OR n_elements(masknan) GT 1) $
206      AND NOT keyword_set(cont_nofill) THEN BEGIN
207;      tonan = where((mask*masknan) EQ 0, count)
208      tonan = where(remplit(mask*masknan, nite = 1, mask = mask*masknan $
209                            , /basique, fillval = 0 $
210                            , fillxdir = keyword_set(realsection)) EQ 0, count)
211      IF count NE 0 THEN z2d[temporary(tonan)] = !values.f_nan
212    ENDIF   
213;
214; on ne passe pas si on doit faire des contours differents...
215; ds le cas on unsur2 est active on reduit levels
216    if NOT keyword_set(nocontour) then begin
217      IF keyword_set(unsur2) THEN levels = levels(where(zeroun(n_elements(levels) ) eq 1))
218; unlabsur est active?  C_LABEL est passe via _EXTRA?
219      if keyword_set(unlabsur) THEN IF chkstru(ex, 'C_LABELS') THEN $
220        ex.C_LABELS = 1-((indgen(n_elements(ex.C_LABELS)) MOD unlabsur) < 1)
221;
222; pour ne pas filler qd cell_fill est impose...
223      IF chkstru(ex, 'CELL_FILL') THEN ex.CELL_FILL = 0
224;
225      CASE 1 OF
226        keyword_set(color_c):c_colors = colors
227        keyword_set(i_colors):c_colors = i_colors
228        ELSE:
229      ENDCASE
230;
231      IF usetri EQ 2 THEN BEGIN
232        IF size(x, /n_dimensions) EQ 1 THEN x = x#replicate(1, (size(z2d))[2])
233        IF size(y, /n_dimensions) EQ 1 THEN y = replicate(1, (size(z2d))[1])#y
234        contour, [z2d[*], fltarr(more)], [x[*], fltarr(more)] $
235          , [y[*], fltarr(more)], levels = levels $
236          , overplot = 1-keyword_set(nofill), noerase = keyword_set(nofill) $
237          , c_colors = c_colors, TRIANGULATION = trichamp, _extra = ex
238      ENDIF ELSE BEGIN
239        IF size(x, /n_dimensions) EQ 2 THEN x = x[*, 0]
240        IF size(y, /n_dimensions) EQ 2 THEN y = reform(y[0, *])
241        contour, z2d, x, y, levels = levels $
242          , overplot = 1-keyword_set(nofill), noerase = keyword_set(nofill) $
243          , c_colors = c_colors, _extra = ex
244      ENDELSE
245    ENDIF
246;----------------------------------------------------------------------
247; III) remplissage des continents de couleur
248;----------------------------------------------------------------------
249    IF chkstru(ex, 'CELL_FILL') THEN ex.CELL_FILL = cell_fill < 1
250    IF chkstru(ex, 'LEVELS') THEN ex = extractstru(ex, 'LEVELS')
251    IF chkstru(ex, 'NODATA') THEN ex = extractstru(ex, 'NODATA')
252    IF NOT keyword_set(cont_color) THEN cont_color = (!d.n_colors-1) <  255   
253;
254; si il y a des points a nan
255; on trace en blanc les points a nan avant de dessiner les cotes avec
256; un trait.
257;
258    if keyword_set(trinan) THEN BEGIN
259      IF size(x, /n_dimensions) EQ 1 THEN x = x#replicate(1, (size(masknan))[2])
260      IF size(y, /n_dimensions) EQ 1 THEN y = replicate(1, (size(masknan))[1])#y
261      contour, [1b-masknan[*], fltarr(more)], [x[*], fltarr(more)] $
262        , [y[*], fltarr(more)], levels = 0.5, /overplot, /fill $
263        , c_colors = cont_color, TRIANGULATION = trinan, _extra = ex
264      IF keyword_set(forplt) THEN $
265        completecointerre, COINMONTE = coinmontenan $
266        , COINDESCEND = coindescendnan, INDICEZOOM = indicezoomnan $
267        , CONT_COLOR = cont_color, _EXTRA = ex $
268      ELSE fillcornermask, x[*, 0], y[0, *], COINMONTE = coinmontenan $
269        , COINDESCEND = coindescendnan, CONT_COLOR = cont_color, _extra = ex
270    ENDIF
271;
272; remplissage des continents
273;
274    if keyword_set(realcont) then if realcont EQ 1 then mask = 1b
275    if n_elements(mask) NE 1 then BEGIN ; si mask=1 on saute.
276;
277      if NOT keyword_set(cont_nofill) then BEGIN
278;
279; mask filling
280;
281        case 1 of
282          keyword_set(realsection):drawsectionbottom, mask, xm, ym $
283            , CONT_NOFILL = cont_nofill, CONT_COLOR = cont_color, _EXTRA = ex
284          usetri GE 1:BEGIN
285            if n_elements(trimsk) eq 0 then trimsk = trichamp
286            IF size(xm, /N_DIMENSIONS) EQ 1 THEN xm = xm#replicate(1, (size(mask))[2])
287            IF size(ym, /N_DIMENSIONS) EQ 1 THEN ym = replicate(1, (size(mask))[1])#ym
288            contour, [1b-mask[*], fltarr(more)], [xm[*], fltarr(more)] $
289              , [ym[*], fltarr(more)], LEVELS = 0.5, /OVERPLOT, /FILL $
290              , C_COLORS = cont_color, TRIANGULATION = trimsk, _extra = ex
291            IF keyword_set(forplt) THEN $
292              completecointerre, COINMONTE = coinmontemask $
293              , COINDESCEND = coindescendmask, INDICEZOOM = indicezoommask $
294              , CONT_COLOR = cont_color, _EXTRA = ex $
295            ELSE fillcornermask, xm[*, 0], ym[0, *], COINMONTE = coinmontemask $
296              , COINDESCEND = coindescendmask, CONT_COLOR = cont_color, _extra = ex
297          END
298          ELSE:BEGIN
299            IF size(xm, /n_dimensions) EQ 2 THEN xm = xm[*, 0]
300            IF size(ym, /n_dimensions) EQ 2 THEN ym = reform(ym[0, *])
301            contour, 1b-mask, xm, ym, LEVELS = 0.5, /OVERPLOT $
302              , /FILL, C_COLORS = cont_color, _EXTRA = ex
303          END
304        ENDCASE
305      ENDIF                     ; NOT keyword_set(cont_nofill)
306;------------------------------------------------------------
307; IV) trace les cotes en trait
308;------------------------------------------------------------
309      case 1 of
310        keyword_set(realsection) AND NOT keyword_set(cont_nofill):     
311        keyword_set(realsection) AND keyword_set(cont_nofill): $
312          drawsectionbottom, mask, xm, ym $
313          , CONT_NOFILL = cont_nofill, _extra = ex
314        (keyword_set(forplt) AND (!map.projection GT 0 OR key_irregular)) $
315          OR keyword_set(nan):tracecote, _extra = ex
316        ELSE:tracemask, mask, xm, ym, _extra = ex
317      endcase                   ;
318    ENDIF                       ; n_elements(mask) NE 1
319  ENDIF
320;------------------------------------------------------------
321; draw the triangulations
322;------------------------------------------------------------
323  if keyword_set(desstrichamp) then $
324    dessinetri, trichamp, x, y, color = colortrichamp, thick = th_trichamp
325  if keyword_set(desstrimask) then $
326    dessinetri, trimsk, xm, ym, color = colortrimask, thick = th_trimask
327  if keyword_set(desstrinan) then $
328    dessinetri, trinan, x, y, color = colortrinan
329  if keyword_set(drawpoints) then $
330    tracegrille, x, y, color = colorpoints
331;------------------------------------------------------------
332;
333fini:
334  IF keyword_set(key_performance) THEN print, 'temps pltbase', systime(1)-tempsun
335
336  return
337end
Note: See TracBrowser for help on using the repository browser.