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

Last change on this file since 134 was 134, checked in by navarro, 18 years ago

change *.pro file properties (del eof-style, del executable, set keywords Id
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 7.3 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;
39  compile_opt idl2, strictarrsubs
40;
41@cm_4mesh
42; the triangle must not be out of the domain
43  IF min(lons, max = maxlon) GE lon1 AND maxlon LE lon2 $
44    AND min(lats, max = maxlat) GE lat1 AND maxlat LE lat2 then BEGIN
45; the triangle must not be too big
46    z = convert_coord(lons, lats, /data, /to_normal)
47    alldist = [(z[0, 2]-z[0, 0])^2 + (z[1, 2]-z[1, 0])^2 $
48               , (z[0, 0]-z[0, 1])^2 + (z[1, 0]-z[1, 1])^2 $
49               , (z[0, 1]-z[0, 2])^2 + (z[1, 1]-z[1, 2])^2]
50    IF max(alldist) LT seuil^2 THEN polyfill, lons, lats $
51      , color = cont_color, _extra = ex
52    return
53  ENDIF
54end
55;------------------------------------------------------------
56;------------------------------------------------------------
57PRO completecointerre, COINMONTE = coinmonte, COINDESCEND = coindescend $
58                       , CONT_COLOR = cont_color, INDICEZOOM = indicezoom $
59                       , _extra = ex
60;
61  compile_opt idl2, strictarrsubs
62;
63@common
64;------------------------------------------------------------
65;   if NOT keyword_set(coinmonte) then return
66;   if NOT keyword_set(coindescend) then return
67;   if NOT keyword_set(indicezoom) then return
68  tempsun = systime(1)          ; pour key_performance
69;------------------------------------------------------------
70; definitions des vecteurs coinmont et coindesc
71;------------------------------------------------------------
72  if keyword_set(coinmonte) then coinmont = coinmonte $
73  ELSE coinmont = twin_corners_up
74  if keyword_set(coindescend) then coindesc = coindescend $
75  ELSE coindesc = twin_corners_dn
76  IF NOT keyword_set(cont_color) THEN cont_color = (!d.n_colors-1) <  255
77;------------------------------------------------------------
78; definition descoordonnees des points numerotes 1,2,3,4,5,6 cf. les
79; schemas en dessous!
80;------------------------------------------------------------
81  tempdeux = systime(1)         ; pour key_performance =2
82  if coinmont[0] NE -1 OR coindesc[0] NE -1 then BEGIN
83    if keyword_set(indicezoom) then BEGIN
84; if we use key_stide, the t, u, v and f points are no more related to
85; the same cell because glamf and gphif has be recomputed to be in the
86; middle of two t points
87      IF total(key_stride) EQ 3 AND finite(glamv[0]*gphiv[0]) NE 0 THEN BEGIN
88        long1 = glamv[indicezoom] & lati1 = gphiv[indicezoom]
89      ENDIF ELSE BEGIN
90        long1 = glamt[indicezoom] & lati1 = gphif[indicezoom]
91      ENDELSE
92      IF total(key_stride) EQ 3 AND finite(glamu[0]*gphiu[0]) NE 0 THEN BEGIN
93        long2 = glamu[indicezoom] & lati2 = gphiu[indicezoom]
94      ENDIF ELSE BEGIN
95        long2 = glamf[indicezoom] & lati2 = gphit[indicezoom]
96      ENDELSE
97      long3 = glamf[indicezoom] & lati3 = gphif[indicezoom]
98    ENDIF ELSE BEGIN
99      IF total(key_stride) EQ 3 AND finite(glamv[0]*gphiv[0]) NE 0 THEN BEGIN
100        long1 = glamv & lati1 = gphiv
101      ENDIF ELSE BEGIN
102        long1 = glamt & lati1 = gphif
103      ENDELSE
104      IF total(key_stride) EQ 3 AND finite(glamu[0]*gphiu[0]) NE 0 THEN BEGIN
105        long2 = glamu & lati2 = gphiu
106      ENDIF ELSE BEGIN
107        long2 = glamf & lati2 = gphit
108      ENDELSE
109      long3 = glamf & lati3 = gphif
110    ENDELSE
111;
112    nx = (size(long1, /dimensions))[0]
113    ny = (size(long1, /dimensions))[1]
114    seuil = 5 < (min([nx, ny])-2)
115    seuil = min([(!p.position[2]-!p.position[0])/seuil $
116                 , (!p.position[3]-!p.position[1])/seuil])
117;
118  ENDIF
119;
120  IF testvar(var = key_performance) EQ 2 THEN $
121    print, 'temps completecointerre: positions des points', systime(1)-tempdeux
122;
123;
124; cas coin terre en montee:
125;      2 points terre en diagonale montante avec 2 points mer sur
126;      la diagonale descendante.
127;
128;                     4   
129;     t(i+nx)=1    u(i+nx)       t(i+nx+1)=0
130;                     |    \
131;                     |        \
132;         1         3 |            \   5
133;       v(i)---------f(i)------------v(i+1)
134;           \         |
135;              \      |
136;                 \   |
137;      t(i)=0       2 u(i)          t(i+1)=1
138;
139;
140  if coinmont[0] NE -1 then BEGIN
141    tempdeux = systime(1)       ; pour key_performance =2
142    for id = 0, n_elements(coinmont)-1 do BEGIN
143      i = coinmont[id]
144      ii = i MOD nx
145      ij = i/nx
146; bottom triangle
147      lons = [long1[i], long2[i], long3[i]]
148      lats = [lati1[i], lati2[i], lati3[i]]
149      draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
150; upper triangle
151      IF ii NE nx-1 AND ij NE ny-1 THEN BEGIN
152        lons = [long3[i], long1[i+1], long2[i+nx]]
153        lats = [lati3[i], lati1[i+1], lati2[i+nx]]
154        draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
155      ENDIF
156    ENDFOR
157    IF testvar(var = key_performance) EQ 2 THEN $
158      print, 'temps completecointerre: trace de cointerremonte', systime(1)-tempdeux
159  ENDIF
160;------------------------------------------------------------
161; cas coin terre en descendante.:
162;      2 points terre en diagonale descendante avec 2 points mer sur
163;      la diagonale montante
164;
165;                     4
166;     t(i+nx)=1    u(i+nx)       t(i+nx+1)=0
167;                /    |       
168;             /       |         
169;          /        3 |                5
170;       v(i)---------f(i)------------v(i+1)
171;         1           |            /
172;                     |         /
173;                     |      /
174;      t(i)=0      2 u(i)          t(i+1)=1
175;
176  if coindesc[0] NE -1 then begin
177    tempdeux = systime(1)       ; pour key_performance =2
178    for id = 0, n_elements(coindesc)-1 do BEGIN
179      i = coindesc[id]
180      ii = i MOD nx
181      ij = i/nx
182      IF ii NE nx-1 AND ij NE ny-1 THEN BEGIN
183; left triangle
184        lons = [long1[i], long3[i], long2[i+nx]]
185        lats = [lati1[i], lati3[i], lati2[i+nx]]
186        draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
187; right triangle
188        lons = [long3[i], long2[i], long1[i+1]]
189        lats = [lati3[i], lati2[i], lati1[i+1]]
190        draw_corner_triangle, lons, lats, seuil, CONT_COLOR = cont_color, _extra = ex
191      ENDIF
192    ENDFOR
193    IF testvar(var = key_performance) EQ 2 THEN $
194      print, 'temps completecointerre: trace de cointerredescend', systime(1)-tempdeux
195  ENDIF
196
197;------------------------------------------------------------
198  IF keyword_set(key_performance) THEN print, 'temps completecointerre', systime(1)-tempsun
199;------------------------------------------------------------
200  return
201end
Note: See TracBrowser for help on using the repository browser.