Ignore:
Timestamp:
05/09/06 17:04:13 (18 years ago)
Author:
pinsard
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ToBeReviewed/PLOTS/DESSINE/pltbase.pro

    r35 r67  
    3939;        contour du mask 
    4040; 
     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; 
    4150;        /CONT_NOFILL: activer pour ne pas remplir les points masques 
    42 ;        a la couleur c_cont mais pour les laisser en transparent! Rq 
    43 ;        on trace qd meme le contour du mask de la couleur c_cote 
    44 ; 
    45 ;        CONT_THICK: l''epaisseur du trait pour tracer les 
    46 ;        continents. par defaut c''est 1. 
     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 
    4756; 
    4857;        /DESSTRICHAMP: pour dessiner la triangulation qui est 
     
    6978; 
    7079; 
    71 ;        /NOCOULEUR: pour faire juste les isolignes 
     80;        /NOFILL: pour faire juste les isolignes 
    7281; 
    7382;        /NOCONTOUR: pour faire juste les couleurs 
     
    106115;------------------------------------------------------------ 
    107116;------------------------------------------------------------ 
    108 PRO pltbase, z2d, x, y, mask,xm, ym, levels, colors,UNSUR2 = unsur2, CONTOUR = contour $ 
    109              , NOCONTOUR = nocontour, NOCOULEUR = nocouleur, TRICHAMP = trichamp, TRIMSK = trimsk $ 
    110              , CARTE = carte, NAN = nan $ 
     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 $ 
    111121             , COLORTRICHAMP = colortrichamp, COLORTRIMASK = colortrimask $ 
    112122             , COLORTRINAN = colortrinan $ 
     123             , COLORPOINTS = colorpoints, DRAWPOINTS = drawpoints $ 
    113124             , TH_TRICHAMP = th_trichamp, TH_TRIMASK = th_trimask $ 
    114125             , DESSTRICHAMP = desstrichamp, DESSTRIMASK = desstrimask $ 
    115              , DESSTRINAN = desstrinan $ 
    116              , I_COLORS = i_colors $ 
    117              , CONT_THICK = cont_thick,CONT_NOFILL = cont_nofill, UNLABSUR = unlabsur $ 
     126             , DESSTRINAN = desstrinan, COLOR_C = color_c $ 
     127             , I_COLORS = i_colors,  CONT_COLOR = CONT_COLOR $ 
     128             , CONT_NOFILL = cont_nofill, UNLABSUR = unlabsur $ 
    118129             , COINMONTEMASK = coinmontemask, COINDESCENDMASK = coindescendmask $ 
    119130             , COINMONTENAN = coinmontenan, COINDESCENDNAN = coindescendnan $ 
    120131             , INDICEZOOMMASK = indicezoommask, INDICEZOOMNAN = indicezoomnan $ 
    121              , MASKNAN = masknan, TRINAN = trinan, XNAN = xnan, YNAN = ynan, FORPLT = forplt $ 
    122              , MORE = more, _EXTRA = ex 
    123 @common 
     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;--------------------------------------------------------- 
    124143; 
    125144; explication concernant contour. Ce mot cle est active qd on on trace 
     
    132151; 
    133152;------------------------------------------------------------ 
    134    tempsun = systime(1)         ; pour key_performance 
    135    if n_elements(masknan) EQ 0 then masknan = 1 
     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 
    136157;---------------------------------------------------------------------- 
    137158; si les niveaux et les couleurs ne sont pas donnes 
    138159;---------------------------------------------------------------------- 
    139    if n_params() EQ 4 then BEGIN  
    140       label,0,min(z2d*mask),max(z2d*mask),ncontour,levels 
    141       colors = couleur 
    142    endif 
     160  if n_params() EQ 4 then $  
     161    label, 0, min(z2d*mask), max(z2d*mask), ncontour, levels, colors 
    143162; attention bidouille inexplicable pour que tout se passe bien avec les 
    144163; postcript ds pltz!!! 
    145    if n_elements(contour) LE 4 AND !x.type EQ 0 THEN $ 
    146     plot, [0], [0], xstyle = 5, ystyle = 5,/noerase, title = '', subtitle = '' 
     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 = '' 
    147166;---------------------------------------------------------------------- 
    148167; si cell_fill fait partit de _extra, on le desactive si il n''est pas 
    149168; egale a 2 
    150169;---------------------------------------------------------------------- 
    151    IF chkstru(ex, 'CELL_FILL') THEN BEGIN  
    152       cell_fill = ex.CELL_FILL 
    153       if ex.CELL_FILL NE 2 then ex.CELL_FILL = 0 
    154    ENDIF ELSE cell_fill = 0     ; 
    155 ; do we use the triangulation?? 
    156    usetri = n_elements(trichamp) NE 0 AND (testvar(var = trichamp))[0] NE -1 
     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      ; 
    157174;---------------------------------------------------------------------- 
    158175; I) remplissage des contours en palette de couleur  
    159176;---------------------------------------------------------------------- 
    160    if NOT keyword_set(more) then more = 10 
    161    if NOT keyword_set(nocouleur) then begin 
    162       if n_elements(contour) NE 4 THEN BEGIN  
    163          if usetri then $ 
    164           contour,[z2d[*], fltarr(more)],[x[*], fltarr(more)],[y[*], fltarr(more)],levels=levels,c_color=colors,/noerase,/fill,/closed $ 
    165           ,TRIANGULATION=trichamp, _extra = ex $ 
    166          else $ 
    167           contour,z2d,x,y,levels=levels,c_color=colors,/noerase,/fill,/closed, _extra = ex  
    168       endif 
    169    endif 
    170    if n_elements(contour) NE 0 AND n_elements(contour) NE 4 THEN GOTO, fini  
    171    IF chkstru(ex, 'C_ORIENTATION') THEN ex = extractstru(ex, 'C_ORIENTATION') 
    172    IF chkstru(ex, 'C_SPACING') THEN ex = extractstru(ex, 'C_SPACING') 
    173 ;------------------------------------------------------------ 
    174 ; II) trace des contours en trait de couleur c_lab 
    175 ;------------------------------------------------------------ 
    176    if n_elements(contour) EQ 4 OR n_elements(contour) EQ 0 THEN BEGIN 
     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; 
    177214; on ne passe pas si on doit faire des contours differents... 
    178215; ds le cas on unsur2 est active on reduit levels 
    179       if NOT keyword_set(nocontour) then begin 
    180          IF keyword_set(unsur2) THEN levels = levels(where(zeroun(n_elements(levels) ) eq 1)) 
     216    if NOT keyword_set(nocontour) then begin 
     217      IF keyword_set(unsur2) THEN levels = levels(where(zeroun(n_elements(levels) ) eq 1)) 
    181218; unlabsur est active?  C_LABEL est passe via _EXTRA? 
    182          if keyword_set(unlabsur) THEN IF chkstru(ex, 'C_LABELS') THEN $ 
    183           ex.C_LABELS = 1-((indgen(n_elements(ex.C_LABELS)) MOD unlabsur) < 1) 
     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) 
    184221; 
    185222; pour ne pas filler qd cell_fill est impose... 
    186          IF chkstru(ex, 'CELL_FILL') THEN ex.CELL_FILL = 0 
    187          IF chkstru(ex, 'C_COLORS') THEN ex = extractstru(ex, 'C_COLORS') 
    188 ; 
    189          if usetri then $ 
    190           contour, [z2d[*], fltarr(more)], [x[*], fltarr(more)],[y[*], fltarr(more)],levels=levels, overplot = 1-keyword_set(nocouleur) $ 
    191           ,noerase = keyword_set(nocouleur), c_color=c_lab*(1-keyword_set(i_colors))+testvar(var = i_colors),TRIANGULATION=trichamp, _extra = ex $ 
    192          else $ 
    193           contour, z2d, x,y,levels=levels, overplot = 1-keyword_set(nocouleur) $ 
    194           ,noerase = keyword_set(nocouleur), c_color=c_lab*(1-keyword_set(i_colors))+testvar(var = i_colors), _extra = ex 
    195 ; 
    196       endif 
    197 ; 
    198       if keyword_set(carte) then if carte EQ 1 then mask = 1 
    199       if n_elements(mask) NE 1 then BEGIN ; si mask=1 on saute. 
    200 ;---------------------------------------------------------------------- 
    201 ; III) remplissage des continents de couleur c_cont 
    202 ;---------------------------------------------------------------------- 
    203          if NOT keyword_set(cont_nofill) then BEGIN 
    204             IF chkstru(ex, 'CELL_FILL') THEN ex.CELL_FILL = cell_fill < 1 
    205             IF chkstru(ex, 'LEVELS') THEN ex = extractstru(ex, 'LEVELS') 
    206             if n_elements(trimsk) eq 0 and usetri then trimsk = trichamp 
    207 ; 
    208             usetri = n_elements(trimsk) NE 0 AND (testvar(var = trimsk))[0] NE -1 
    209             if usetri then BEGIN 
    210                if keyword_set(forplt) then $ 
    211                 contour, -1*[mask[*], fltarr(more)], [xm[*], fltarr(more)], [ym[*], fltarr(more)], levels=-0.5, /overplot, /fill ,c_color=c_cont $ 
    212                 ,TRIANGULATION=trimsk, _extra=ex ELSE $ 
    213                 contour, -1*[(mask*masknan)[*], fltarr(more)], [xm[*], fltarr(more)], [ym[*], fltarr(more)], levels=-0.5, /overplot, /fill $ 
    214                 ,c_color=c_cont,TRIANGULATION=trimsk, _extra=ex ; 
    215                completecointerre, coinmonte=coinmontemask, coindescend=coindescendmask $ 
    216                 , indicezoom = indicezoommask, _extra = ex 
    217             ENDIF ELSE BEGIN 
    218                if keyword_set(forplt) then $ 
    219                 contour, -1*mask, xm, ym, levels=-0.5, /overplot, /fill ,c_color=c_cont $ 
    220                 , _extra=ex ELSE $ 
    221                 contour, -1*(mask*masknan), xm, ym, levels=-0.5, /overplot, /fill $ 
    222                 ,c_color=c_cont, _extra=ex ; 
    223             ENDELSE 
    224 ; 
    225  
    226 ; si il y a des points a nan et que le champ n''est pas sur la grille T 
     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  
    227255; on trace en blanc les points a nan avant de dessiner les cotes avec 
    228256; un trait. 
    229             if keyword_set(trinan) THEN BEGIN 
    230                contour, [-masknan[*], fltarr(more)],[xnan[*], fltarr(more)],[ynan[*], fltarr(more)],levels=-0.5,/overplot,/fill,c_color=c_cont $ 
    231                 , TRIANGULATION=trinan, _extra = ex 
    232                completecointerre, coinmonte=coinmontenan, coindescend=coindescendnan $ 
    233                 , indicezoom = indicezoomnan, _extra = ex 
    234                if keyword_set(desstrinan) then dessinetri, trinan, xnan, ynan, color = colortrinan 
    235             endif 
    236          endif 
    237 ;------------------------------------------------------------ 
    238 ; IV) trace les cotes en trait de couleur c_cote 
    239 ;------------------------------------------------------------ 
     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  
    240335 
    241          if NOT keyword_set(cont_thick) then cont_thick = 1 
    242          IF chkstru(ex, 'C_THICK') THEN ex.C_THICK = cont_thick 
    243 ; 
    244          if n_elements(key_stride) LE 2 then key_stride = [1, 1, 1] 
    245          key_stride = 1l > long(key_stride) 
    246 ; 
    247          if (keyword_set(forplt) AND (!map.projection GT 0 OR key_irregular)) $ 
    248           OR keyword_set(nan) then $ 
    249           tracecote, CONT_THICK = cont_thick, _extra = ex $ 
    250          ELSE tracemask, mask, xm, ym, CONT_THICK = cont_thick, _extra = ex 
    251 ; 
    252       endif 
    253    ENDIF 
    254 ;------------------------------------------------------------ 
    255 fini: 
    256    if keyword_set(desstrichamp) then dessinetri, trichamp, x, y, color = colortrichamp, thick = th_trichamp 
    257    if keyword_set(desstrimask) then dessinetri, trimsk, xm, ym, color = colortrimask, thick = th_trimask 
    258    IF keyword_set(key_performance) THEN print, 'temps pltbase', systime(1)-tempsun  
    259  
    260    return 
     336  return 
    261337end 
Note: See TracChangeset for help on using the changeset viewer.