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

Last change on this file since 246 was 232, checked in by pinsard, 17 years ago

improvements/corrections of some *.pro headers

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 7.2 KB
Line 
1;+
2;
3; @file_comments
4;
5; @categories
6; Graphics
7;
8; @param LONS
9;
10; @param LATS
11;
12; @param SEUIL
13;
14; @keyword _EXTRA
15; Used to pass keywords
16;
17; @keyword CONT_COLOR {default=(!d.n_colors - 1) < 255 => white}
18; The color of the continent.
19;
20; @uses
21; common.pro
22;
23; @history
24; Sebastien Masson (smasson\@lodyc.jussieu.fr)
25;                      01/10/1999
26;
27; @version
28; $Id$
29;
30;-
31;
32PRO draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _EXTRA = ex
33;
34  compile_opt idl2, strictarrsubs
35;
36@cm_4mesh
37; the triangle must not be out of the domain
38  IF min(lons, max = maxlon) GE lon1 AND maxlon LE lon2 $
39    AND min(lats, max = maxlat) GE lat1 AND maxlat LE lat2 then BEGIN
40; the triangle must not be too big
41    z = convert_coord(lons, lats, /data, /to_normal)
42    alldist = [(z[0, 2]-z[0, 0])^2 + (z[1, 2]-z[1, 0])^2 $
43               , (z[0, 0]-z[0, 1])^2 + (z[1, 0]-z[1, 1])^2 $
44               , (z[0, 1]-z[0, 2])^2 + (z[1, 1]-z[1, 2])^2]
45    IF max(alldist) LT seuil^2 THEN polyfill, lons, lats $
46      , color = cont_color, _extra = ex
47    return
48  ENDIF
49end
50;
51;+
52;
53; @file_comments
54; To color cleanly continents
55;
56; @categories
57; Graphics
58;
59; @keyword _EXTRA
60; Used to pass keywords
61;
62; @keyword CONT_COLOR
63; The color of the continent. default value is
64; (!d.n_colors - 1) < 255 => white
65;
66; @keyword COINMONTE {type=array}
67; To obtain the array of "ascending land corner"
68; to be treated with <pro>completecointerre</pro> in the variable array
69; instead of make it pass by the global variable twin_corners_up.
70;
71; @keyword COINDESCEND {type=array}
72; See COINMONTE
73;
74; @keyword INDICEZOOM
75; The zoom's index
76;
77; @uses
78; common.pro
79;
80; @history
81; Sebastien Masson (smasson\@lodyc.jussieu.fr)
82;                      01/10/1999
83;
84; @version
85; $Id$
86;
87;-
88;
89PRO completecointerre, COINMONTE = coinmonte, COINDESCEND = coindescend $
90                       , CONT_COLOR = cont_color, INDICEZOOM = indicezoom $
91                       , _EXTRA = ex
92;
93  compile_opt idl2, strictarrsubs
94;
95@common
96;------------------------------------------------------------
97;   if NOT keyword_set(coinmonte) then return
98;   if NOT keyword_set(coindescend) then return
99;   if NOT keyword_set(indicezoom) then return
100  tempsun = systime(1)          ; For key_performance
101;------------------------------------------------------------
102; definitions of vectors coinmont and coindesc
103;------------------------------------------------------------
104  if keyword_set(coinmonte) then coinmont = coinmonte $
105  ELSE coinmont = twin_corners_up
106  if keyword_set(coindescend) then coindesc = coindescend $
107  ELSE coindesc = twin_corners_dn
108  IF NOT keyword_set(cont_color) THEN cont_color = (!d.n_colors-1) <  255
109;------------------------------------------------------------
110; definition of coordinates of points numbered 1,2,3,4,5,6 (see figures below)
111;------------------------------------------------------------
112  tempdeux = systime(1)         ; For key_performance =2
113  if coinmont[0] NE -1 OR coindesc[0] NE -1 then BEGIN
114    if keyword_set(indicezoom) then BEGIN
115; if we use key_stide, the t, u, v and f points are no more related to
116; the same cell because glamf and gphif has be recomputed to be in the
117; middle of two t points
118      IF total(key_stride) EQ 3 AND finite(glamv[0]*gphiv[0]) NE 0 THEN BEGIN
119        long1 = glamv[indicezoom] & lati1 = gphiv[indicezoom]
120      ENDIF ELSE BEGIN
121        long1 = glamt[indicezoom] & lati1 = gphif[indicezoom]
122      ENDELSE
123      IF total(key_stride) EQ 3 AND finite(glamu[0]*gphiu[0]) NE 0 THEN BEGIN
124        long2 = glamu[indicezoom] & lati2 = gphiu[indicezoom]
125      ENDIF ELSE BEGIN
126        long2 = glamf[indicezoom] & lati2 = gphit[indicezoom]
127      ENDELSE
128      long3 = glamf[indicezoom] & lati3 = gphif[indicezoom]
129    ENDIF ELSE BEGIN
130      IF total(key_stride) EQ 3 AND finite(glamv[0]*gphiv[0]) NE 0 THEN BEGIN
131        long1 = glamv & lati1 = gphiv
132      ENDIF ELSE BEGIN
133        long1 = glamt & lati1 = gphif
134      ENDELSE
135      IF total(key_stride) EQ 3 AND finite(glamu[0]*gphiu[0]) NE 0 THEN BEGIN
136        long2 = glamu & lati2 = gphiu
137      ENDIF ELSE BEGIN
138        long2 = glamf & lati2 = gphit
139      ENDELSE
140      long3 = glamf & lati3 = gphif
141    ENDELSE
142;
143    nx = (size(long1, /dimensions))[0]
144    ny = (size(long1, /dimensions))[1]
145    seuil = 5 < (min([nx, ny])-2)
146    seuil = min([(!p.position[2]-!p.position[0])/seuil $
147                 , (!p.position[3]-!p.position[1])/seuil])
148;
149  ENDIF
150;
151  IF testvar(var = key_performance) EQ 2 THEN $
152    print, 'temps completecointerre: positions des points', systime(1)-tempdeux
153;
154;
155; Case land corner in ascent:
156;      2 land points in diagonal ascending with 2 ocean points on the descendant diagonal.
157;
158;                     4
159;     t(i+nx)=1    u(i+nx)       t(i+nx+1)=0
160;                     |    \
161;                     |        \
162;         1         3 |            \   5
163;       v(i)---------f(i)------------v(i+1)
164;           \         |
165;              \      |
166;                 \   |
167;      t(i)=0       2 u(i)          t(i+1)=1
168;
169;
170  if coinmont[0] NE -1 then BEGIN
171    tempdeux = systime(1)       ; For key_performance =2
172    for id = 0, n_elements(coinmont)-1 do BEGIN
173      i = coinmont[id]
174      ii = i MOD nx
175      ij = i/nx
176; bottom triangle
177      lons = [long1[i], long2[i], long3[i]]
178      lats = [lati1[i], lati2[i], lati3[i]]
179      draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
180; upper triangle
181      IF ii NE nx-1 AND ij NE ny-1 THEN BEGIN
182        lons = [long3[i], long1[i+1], long2[i+nx]]
183        lats = [lati3[i], lati1[i+1], lati2[i+nx]]
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 cointerremonte', systime(1)-tempdeux
189  ENDIF
190;------------------------------------------------------------
191; Case land corner in descent:
192;      2 land points in diagonal descending with 2 ocean points on the ascendant diagonal.
193;
194;                     4
195;     t(i+nx)=1    u(i+nx)       t(i+nx+1)=0
196;                /    |
197;             /       |
198;          /        3 |                5
199;       v(i)---------f(i)------------v(i+1)
200;         1           |            /
201;                     |         /
202;                     |      /
203;      t(i)=0      2 u(i)          t(i+1)=1
204;
205  if coindesc[0] NE -1 then begin
206    tempdeux = systime(1)       ; For key_performance =2
207    for id = 0, n_elements(coindesc)-1 do BEGIN
208      i = coindesc[id]
209      ii = i MOD nx
210      ij = i/nx
211      IF ii NE nx-1 AND ij NE ny-1 THEN BEGIN
212; left triangle
213        lons = [long1[i], long3[i], long2[i+nx]]
214        lats = [lati1[i], lati3[i], lati2[i+nx]]
215        draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
216; right triangle
217        lons = [long3[i], long2[i], long1[i+1]]
218        lats = [lati3[i], lati2[i], lati1[i+1]]
219        draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
220      ENDIF
221    ENDFOR
222    IF testvar(var = key_performance) EQ 2 THEN $
223      print, 'temps completecointerre: trace de cointerredescend', systime(1)-tempdeux
224  ENDIF
225
226;------------------------------------------------------------
227  IF keyword_set(key_performance) THEN print, 'temps completecointerre', systime(1)-tempsun
228;------------------------------------------------------------
229  return
230end
Note: See TracBrowser for help on using the repository browser.