source: trunk/SRC/ToBeReviewed/TRIANGULATION/completecointerre.pro @ 76

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

upgrade of TRIANGULATION according to cerbere.lodyc.jussieu.fr: /usr/home/smasson/SAXO_RD/ : files
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 7.2 KB
Line 
1;------------------------------------------------------------
2;------------------------------------------------------------
3;------------------------------------------------------------
4;+
5; NAME: COMPLETECOINTERRE
6;
7; PURPOSE: pour colorier proprement les continents! (c''est une longue
8; histoire...)
9;
10; CATEGORY: pour plt
11;
12; CALLING SEQUENCE: completecointerre
13;
14; INPUTS: non
15;
16; KEYWORD PARAMETERS:  _EXTRA
17;
18;        CONT_COLOR: the color of the continent. defaut value is
19;        (!d.n_colors - 1) < 255 => white
20;
21; OUTPUTS: non
22;
23; COMMON BLOCKS: common.pro
24;
25; SIDE EFFECTS:
26;
27; RESTRICTIONS:
28;
29; EXAMPLE:
30;
31; MODIFICATION HISTORY:Sebastien Masson (smasson@lodyc.jussieu.fr)
32;                      01/10/1999
33;-
34;------------------------------------------------------------
35;------------------------------------------------------------
36;------------------------------------------------------------
37PRO draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
38@cm_4mesh
39; the triangle must not be out of the domain
40  IF min(lons, max = maxlon) GE lon1 AND maxlon LE lon2 $
41    AND min(lats, max = maxlat) GE lat1 AND maxlat LE lat2 then BEGIN
42; the triangle must not be too big
43    z = convert_coord(lons, lats, /data, /to_normal)
44    alldist = [(z[0, 2]-z[0, 0])^2 + (z[1, 2]-z[1, 0])^2 $
45               , (z[0, 0]-z[0, 1])^2 + (z[1, 0]-z[1, 1])^2 $
46               , (z[0, 1]-z[0, 2])^2 + (z[1, 1]-z[1, 2])^2]
47    IF max(alldist) LT seuil^2 THEN polyfill, lons, lats $
48      , color = cont_color, _extra = ex
49    return
50  ENDIF
51end
52;------------------------------------------------------------
53;------------------------------------------------------------
54PRO completecointerre, COINMONTE = coinmonte, COINDESCEND = coindescend $
55                       , CONT_COLOR = cont_color, INDICEZOOM = indicezoom $
56                       , _extra = ex
57@common
58;------------------------------------------------------------
59;   if NOT keyword_set(coinmonte) then return
60;   if NOT keyword_set(coindescend) then return
61;   if NOT keyword_set(indicezoom) then return
62  tempsun = systime(1)          ; pour key_performance
63;------------------------------------------------------------
64; definitions des vecteurs coinmont et coindesc
65;------------------------------------------------------------
66  if keyword_set(coinmonte) then coinmont = coinmonte $
67  ELSE coinmont = twin_corners_up
68  if keyword_set(coindescend) then coindesc = coindescend $
69  ELSE coindesc = twin_corners_dn
70  IF NOT keyword_set(cont_color) THEN cont_color = (!d.n_colors-1) <  255
71;------------------------------------------------------------
72; definition descoordonnees des points numerotes 1,2,3,4,5,6 cf. les
73; schemas en dessous!
74;------------------------------------------------------------
75  tempdeux = systime(1)         ; pour key_performance =2
76  if coinmont[0] NE -1 OR coindesc[0] NE -1 then BEGIN
77    if keyword_set(indicezoom) then BEGIN
78; if we use key_stide, the t, u, v and f points are no more related to
79; the same cell because glamf and gphif has be recomputed to be in the
80; middle of two t points
81      IF total(key_stride) EQ 3 AND finite(glamv[0]*gphiv[0]) NE 0 THEN BEGIN
82        long1 = glamv[indicezoom] & lati1 = gphiv[indicezoom]
83      ENDIF ELSE BEGIN
84        long1 = glamt[indicezoom] & lati1 = gphif[indicezoom]
85      ENDELSE
86      IF total(key_stride) EQ 3 AND finite(glamu[0]*gphiu[0]) NE 0 THEN BEGIN
87        long2 = glamu[indicezoom] & lati2 = gphiu[indicezoom]
88      ENDIF ELSE BEGIN
89        long2 = glamf[indicezoom] & lati2 = gphit[indicezoom]
90      ENDELSE
91      long3 = glamf[indicezoom] & lati3 = gphif[indicezoom]
92    ENDIF ELSE BEGIN
93      IF total(key_stride) EQ 3 AND finite(glamv[0]*gphiv[0]) NE 0 THEN BEGIN
94        long1 = glamv & lati1 = gphiv
95      ENDIF ELSE BEGIN
96        long1 = glamt & lati1 = gphif
97      ENDELSE
98      IF total(key_stride) EQ 3 AND finite(glamu[0]*gphiu[0]) NE 0 THEN BEGIN
99        long2 = glamu & lati2 = gphiu
100      ENDIF ELSE BEGIN
101        long2 = glamf & lati2 = gphit
102      ENDELSE
103      long3 = glamf & lati3 = gphif
104    ENDELSE
105;
106    nx = (size(long1, /dimensions))[0]
107    ny = (size(long1, /dimensions))[1]
108    seuil = 5 < (min([nx, ny])-2)
109    seuil = min([(!p.position[2]-!p.position[0])/seuil $
110                 , (!p.position[3]-!p.position[1])/seuil])
111;
112  ENDIF
113;
114  IF testvar(var = key_performance) EQ 2 THEN $
115    print, 'temps completecointerre: positions des points', systime(1)-tempdeux
116;
117;
118; cas coin terre en montee:
119;      2 points terre en diagonale montante avec 2 points mer sur
120;      la diagonale descendante.
121;
122;                     4   
123;     t(i+nx)=1    u(i+nx)       t(i+nx+1)=0
124;                     |    \
125;                     |        \
126;         1         3 |            \   5
127;       v(i)---------f(i)------------v(i+1)
128;           \         |
129;              \      |
130;                 \   |
131;      t(i)=0       2 u(i)          t(i+1)=1
132;
133;
134  if coinmont[0] NE -1 then BEGIN
135    tempdeux = systime(1)       ; pour key_performance =2
136    for id = 0, n_elements(coinmont)-1 do BEGIN
137      i = coinmont[id]
138      ii = i MOD nx
139      ij = i/nx
140; bottom triangle
141      lons = [long1[i], long2[i], long3[i]]
142      lats = [lati1[i], lati2[i], lati3[i]]
143      draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
144; upper triangle
145      IF ii NE nx-1 AND ij NE ny-1 THEN BEGIN
146        lons = [long3[i], long1[i+1], long2[i+nx]]
147        lats = [lati3[i], lati1[i+1], lati2[i+nx]]
148        draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
149      ENDIF
150    ENDFOR
151    IF testvar(var = key_performance) EQ 2 THEN $
152      print, 'temps completecointerre: trace de cointerremonte', systime(1)-tempdeux
153  ENDIF
154;------------------------------------------------------------
155; cas coin terre en descendante.:
156;      2 points terre en diagonale descendante avec 2 points mer sur
157;      la diagonale montante
158;
159;                     4
160;     t(i+nx)=1    u(i+nx)       t(i+nx+1)=0
161;                /    |       
162;             /       |         
163;          /        3 |                5
164;       v(i)---------f(i)------------v(i+1)
165;         1           |            /
166;                     |         /
167;                     |      /
168;      t(i)=0      2 u(i)          t(i+1)=1
169;
170  if coindesc[0] NE -1 then begin
171    tempdeux = systime(1)       ; pour key_performance =2
172    for id = 0, n_elements(coindesc)-1 do BEGIN
173      i = coindesc[id]
174      ii = i MOD nx
175      ij = i/nx
176      IF ii NE nx-1 AND ij NE ny-1 THEN BEGIN
177; left triangle
178        lons = [long1[i], long3[i], long2[i+nx]]
179        lats = [lati1[i], lati3[i], lati2[i+nx]]
180        draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
181; right triangle
182        lons = [long3[i], long2[i], long1[i+1]]
183        lats = [lati3[i], lati2[i], lati1[i+1]]
184        draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
185      ENDIF
186    ENDFOR
187    IF testvar(var = key_performance) EQ 2 THEN $
188      print, 'temps completecointerre: trace de cointerredescend', systime(1)-tempdeux
189  ENDIF
190
191;------------------------------------------------------------
192  IF keyword_set(key_performance) THEN print, 'temps completecointerre', systime(1)-tempsun
193;------------------------------------------------------------
194  return
195end
Note: See TracBrowser for help on using the repository browser.