Context Navigation

grille.pro @ 69

Last change on this file since 69 was 69, checked in by smasson, 18 years ago
debug + new xxx
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 15.0 KB

Line
1	;------------------------------------------------------------
2	;------------------------------------------------------------
3	;------------------------------------------------------------
4	;+
5	; NAME:grille
6	;
7	; PURPOSE: choisit la grille qui doit etre utilisee pour faire le graphe en
8	; fonction de vargrid et renvoie les parametres correspondants calcules ds
9	; domdef.pro et reduit au domaine definit par domdef (contrairement a
10	; grandegrille.pro)
11	;
12	; CATEGORY:
13	;
14	; CALLING SEQUENCE:
15	; grille,mask,glam,gphi,gdep,nx,ny,nz,firstx,firsty,firstz,lastx,lasty,lastz,e1,e2,e3
16	;
17	; INPUTS:rien. ATTENTION les choix de la grille se fait a partir de la
18	; valeur de la variable globale vargrid, qui peut etre egale a 'T',
19	; 'U', 'V', 'W' ou 'F'.
20	;
21	; KEYWORD PARAMETERS:
22	; TRI si ce mot clef sert a obtenir grace a grille la
23	; triangulation qui se rapporte a la grille mais uniquement
24	; sur la partie du zoom. ce tableau de triangulation reduit
25	; est passe ds la variable que l''on a egalee a tri.par ex:
26	; grille,...,tri=triangulation_reduite. ne mot clef est
27	; utilise dans plt.pro
28	;
29	; /FORPLT: ds plt on veut que sur les points terres, glam et
30	; gphi soit egale a glamt et gphit quelle que soit la grille.
31	;
32	; /NOTRI: utile seulement qd TRI est active. dans ce cas
33	; grille retourne -1 ds la variable tri meme si la variable du
34	; common triangles_list est definie et differente de -1
35	;
36	; /WDEPTH: to specify that the field is at W depth instad of T
37	; depth (automatically activated if vargrid eq 'W')
38	;
39	; OUTPUTS:mask,glam,gphi,gdep,nx,ny,nz,firstx,firsty,firstz,
40	; lastx,lasty,lastz,e1,e2,e3
41	;
42	; pour leur definition cf domdef et la gestion des sous
43	; domaines sur le web
44	;
45	; Rq: ces outputs sont optionnels, si je veux recuperer que
46	; mask, glam et gphi il suffit de taper grille, mask, glam, gphi
47	;
48	; COMMON BLOCKS: cm_4mesh and cm_4data
49	;
50	; SIDE EFFECTS: utilise la variable globale vargird
51	;
52	; RESTRICTIONS: vargrid doit etre 'T', 'W', 'U', 'V' ou 'F'
53	;
54	; EXAMPLE:
55	;
56	; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
57	; 12/2/1999
58	; 10/11/1999 /forplt
59	;-
60	;------------------------------------------------------------
61	;------------------------------------------------------------
62	;------------------------------------------------------------
63	pro grille, mask, glam, gphi, gdep, nx, ny, nz, firstx, firsty, firstz, lastx, lasty, lastz, e1, e2, e3, TRI = tri, NOTRI = notri, TOUT = tout, FORPLT = forplt, IFPLTZ = ifpltz, WDEPTH = wdepth, _EXTRA = ex
64	;------------------------------------------------------------
65	; include commons
66	@cm_4mesh
67	@cm_4data
68	IF NOT keyword_set(key_forgetold) THEN BEGIN
69	@updatenew
70	ENDIF
71	;---------------------
72	tempsun = systime(1) ; pour key_performance
73	;------------------------------------------------------------
74	vargrid = strupcase(strmid(vargrid,0,/reverse_offset))
75	;
76	if vargrid eq 'W' then wdepth = 1
77	if keyword_set(tout) then begin
78	savedbox = 1b
79	saveboxparam, 'boxparam4grille.dat'
80	domdef, gridtype = vargrid, _EXTRA = ex
81	endif
82	tempdeux = systime(1) ; pour key_performance =2
83	;------------------------------------------------------------
84	;------------------------------------------------------------
85	IF keyword_set(wdepth) THEN BEGIN
86	firstz = firstzw
87	lastz = lastzw
88	nz = nzw
89	ENDIF ELSE BEGIN
90	firstz = firstzt
91	lastz = lastzt
92	nz = nzt
93	ENDELSE
94	;------------------------------------------------------------
95	;------------------------------------------------------------
96	CASE 1 OF
97	;------------------------------------------------------------
98	; grille T and W
99	;------------------------------------------------------------
100	vargrid eq 'T' OR vargrid eq 'W' : begin
101	;scalaires
102	nx = nxt
103	ny = nyt
104	firstx = firstxt
105	firsty = firstyt
106	lastx = lastxt
107	lasty = lastyt
108	;vecteurs 2d
109	IF arg_present(glam) THEN glam = glamt[firstx:lastx, firsty:lasty]
110	IF arg_present(gphi) THEN gphi = gphit[firstx:lastx, firsty:lasty]
111	IF arg_present(e1) THEN e1 = e1t[firstx:lastx, firsty:lasty]
112	IF arg_present(e2) THEN e2 = e2t[firstx:lastx, firsty:lasty]
113	;vecteurs 3d
114	IF keyword_set(forplt) THEN mask = tmask[firstx:lastx, firsty:lasty, firstz] $
115	ELSE IF arg_present(mask) THEN mask = tmask[firstx:lastx, firsty:lasty, firstz:lastz]
116	end
117	;------------------------------------------------------------
118	; grille U
119	;------------------------------------------------------------
120	vargrid eq 'U': begin
121	;scalaires
122	nx = nxu
123	ny = nyu
124	firstx = firstxu
125	firsty = firstyu
126	lastx = lastxu
127	lasty = lastyu
128	;vecteurs 2d
129	IF arg_present(glam) THEN glam = glamu[firstx:lastx, firsty:lasty]
130	IF arg_present(gphi) THEN gphi = gphiu[firstx:lastx, firsty:lasty]
131	if keyword_set(forplt) then BEGIN
132	mask = 1b-tmask[firstx:lastx, firsty:lasty, firstz]
133	eastboarder = mask-shift(mask, 1, 0)*mask
134	westboarder = mask-shift(mask, -1, 0)*mask
135	if key_periodic NE 1 OR nx NE jpi then westboarder[nx-1, *] = 0b
136	tmp1 = shift(eastboarder, 0, 1)
137	tmp1[*, 0] = 0b
138	tmp2 = shift(eastboarder, 0, -1)
139	tmp2[*, ny-1] = 0b
140	add = (temporary(tmp1)+temporary(tmp2))(1b-eastboarder)(1b-temporary(westboarder))
141	eastboarder = temporary(eastboarder)+temporary(add)
142	tmp1 = (mask+shift(mask, 0, -1)+shift(mask, 0, 1)) NE 1b
143	tmp1[*, ny-1] = 1b
144	tmp1[*, 0] = 1b
145	tmp2 = (mask+shift(mask, -1, 0)+shift(mask, 1, 0)) NE 1b
146	if key_periodic NE 1 OR nx NE jpi then begin
147	tmp2[nx-1, *] = 1b
148	tmp2[0, *] = 0b
149	endif
150	no1 = temporary(tmp1)*temporary(tmp2)
151	tmp = temporary(eastboarder)temporary(no1)mask
152	mask[0:nx-2, *] = 0b
153	tmp = temporary(tmp)+temporary(mask)
154	tmp = where(tmp GE 1)
155	if tmp[0] NE -1 then begin
156	glam[tmp] = (glamt[firstx:lastx, firsty:lasty])[tmp]
157	gphi[tmp] = (gphit[firstx:lastx, firsty:lasty])[tmp]
158	endif
159	ENDIF
160	IF arg_present(e1) THEN e1 = e1u[firstx:lastx, firsty:lasty]
161	IF arg_present(e2) THEN e2 = e2u[firstx:lastx, firsty:lasty]
162	;vecteurs 3d
163	IF keyword_set(forplt) THEN mask = (umask())[firstx:lastx, firsty:lasty, firstz] $
164	ELSE IF arg_present(mask) THEN mask = (umask())[firstx:lastx, firsty:lasty, firstz:lastz]
165	end
166	;------------------------------------------------------------
167	; grille V
168	;------------------------------------------------------------
169	vargrid eq 'OPAPTDHV' or vargrid eq 'OPAPT3DV' $
170	or vargrid eq 'V': begin
171	;scalaires
172	nx = nxv
173	ny = nyv
174	firstx = firstxv
175	firsty = firstyv
176	lastx = lastxv
177	lasty = lastyv
178	;vecteurs 2d
179	IF arg_present(glam) THEN glam = glamv[firstx:lastx, firsty:lasty]
180	IF arg_present(gphi) THEN gphi = gphiv[firstx:lastx, firsty:lasty]
181	if keyword_set(forplt) then BEGIN
182	mask = 1b-tmask[firstx:lastx, firsty:lasty, firstz]
183	northboarder = mask-shift(mask, 0, 1)*mask
184	southboarder = mask-shift(mask, 0, -1)*mask
185	southboarder[*, ny-1] = 0b
186	tmp1 = shift(northboarder, -1, 0)
187	if key_periodic NE 1 OR nx NE jpi then tmp1[nx-1, *] = 0b
188	tmp2 = shift(northboarder, 1, 0)
189	if key_periodic NE 1 OR nx NE jpi then tmp2[0, *] = 0b
190	add = (temporary(tmp1)+temporary(tmp2))(1b-northboarder)(1b-southboarder)
191	northboarder = temporary(northboarder)+temporary(add)
192	tmp1 = (mask+shift(mask, 0, -1)+shift(mask, 0, 1)) NE 1b
193	tmp1[*, ny-1] = 1b
194	tmp1[*, 0] = 0b
195	tmp2 = (mask+shift(mask, -1, 0)+shift(mask, 1, 0)) NE 1b
196	if key_periodic NE 1 OR nx NE jpi then begin
197	tmp2[nx-1, *] = 1b
198	tmp2[0, *] = 1b
199	endif
200	no1 = temporary(tmp1)*temporary(tmp2)
201	tmp = temporary(northboarder)masktemporary(no1)
202	mask[*, 0:ny-2] = 0b
203	tmp = temporary(tmp)+temporary(mask)
204	tmp = where(tmp GE 1)
205	if tmp[0] NE -1 then begin
206	glam[tmp] = (glamt[firstx:lastx, firsty:lasty])[tmp]
207	gphi[tmp] = (gphit[firstx:lastx, firsty:lasty])[tmp]
208	endif
209	ENDIF
210	IF arg_present(e1) THEN e1 = e1v[firstx:lastx, firsty:lasty]
211	IF arg_present(e2) THEN e2 = e2v[firstx:lastx, firsty:lasty]
212	;vecteurs 3d
213	IF keyword_set(forplt) THEN mask = (vmask())[firstx:lastx, firsty:lasty, firstz] $
214	ELSE IF arg_present(mask) THEN mask = (vmask())[firstx:lastx, firsty:lasty, firstz:lastz]
215	end
216	;------------------------------------------------------------
217	; grille F
218	;------------------------------------------------------------
219	vargrid eq 'OPAPTDHF' or vargrid eq 'OPAPT3DF' $
220	or vargrid eq 'F': begin
221	;scalaires
222	nx = nxf
223	ny = nyf
224	firstx = firstxf
225	firsty = firstyf
226	lastx = lastxf
227	lasty = lastyf
228	;vecteurs 2d
229	IF arg_present(glam) THEN glam = glamf[firstx:lastx, firsty:lasty]
230	IF arg_present(gphi) THEN gphi = gphif[firstx:lastx, firsty:lasty]
231	if keyword_set(forplt) then BEGIN
232	mask = 1b-tmask[firstx:lastx, firsty:lasty, firstz]
233	eastboarder = mask-shift(mask, 1, 0)*mask
234	westboarder = mask-shift(mask, -1, 0)*mask
235	westboarder[nx-1, *] = 0b
236	northboarder = mask-shift(mask, 0, 1)*mask
237	southboarder = mask-shift(mask, 0, -1)*mask
238	southboarder[*, ny-1] = 0b
239	tmp1 = shift(northboarder, -1, 0)
240	if key_periodic NE 1 OR nx NE jpi then tmp1[nx-1, *] = 0b
241	tmp2 = shift(northboarder, 1, 0)
242	if key_periodic NE 1 OR nx NE jpi then tmp2[0, *] = 0b
243	add = (temporary(tmp1)+temporary(tmp2))(1b-northboarder)(1b-southboarder)
244	northboarder = temporary(northboarder)+temporary(add)
245	tmp1 = shift(eastboarder, 0, 1)
246	tmp1[*, 0] = 0b
247	tmp2 = shift(eastboarder, 0, -1)
248	tmp2[*, ny-1] = 0b
249	add = (temporary(tmp1)+temporary(tmp2))(1b-eastboarder)(1b-temporary(westboarder))
250	eastboarder = temporary(eastboarder)+temporary(add)
251	tmp1 = (mask+shift(mask, 0, -1)+shift(mask, 0, 1)) NE 1b
252	tmp1[*, ny-1] = 1b
253	tmp1[*, 0] = 1b
254	tmp2 = (mask+shift(mask, -1, 0)+shift(mask, 1, 0)) NE 1b
255	if key_periodic NE 1 OR nx NE jpi then begin
256	tmp2[nx-1, *] = 1b
257	tmp2[0, *] = 1b
258	endif
259	no1 = temporary(tmp1)*temporary(tmp2)
260	tmp = (temporary(northboarder)+temporary(eastboarder))masktemporary(no1)
261	mask[0:nx-2, *] = 0b
262	mask[*, 0:ny-2] = 0b
263	tmp = temporary(tmp)+temporary(mask)
264	tmp = where(tmp GE 1)
265	if tmp[0] NE -1 then begin
266	glam[tmp] = (glamt[firstx:lastx, firsty:lasty])[tmp]
267	gphi[tmp] = (gphit[firstx:lastx, firsty:lasty])[tmp]
268	endif
269	ENDIF
270	IF arg_present(e1) THEN e1 = e1f[firstx:lastx, firsty:lasty]
271	IF arg_present(e2) THEN e2 = e2f[firstx:lastx, firsty:lasty]
272	;vecteurs 3d
273	IF keyword_set(forplt) THEN mask = (fmask())[firstx:lastx, firsty:lasty, firstz] $
274	ELSE IF arg_present(mask) THEN mask = (fmask())[firstx:lastx, firsty:lasty, firstz:lastz]
275	END
276	;------------------------------------------------------------
277	ELSE:BEGIN
278	ras = report('Wrong definition of vargrid = '+vargrid+'. Only T, U, V, W or F are acceptable')
279	stop
280	END
281	ENDCASE
282	IF testvar(var = key_performance) EQ 2 THEN $
283	print, 'temps grille: attribution des scalaires, vecteurs et tableaux ', systime(1)-tempdeux
284	;
285	;------------------------------------------------------------
286	;------------------------------------------------------------
287	;------------------------------------------------------------
288	; Variables se rapportant a la dimension verticale
289	;------------------------------------------------------------
290	;------------------------------------------------------------
291	;------------------------------------------------------------
292	;
293	;
294	tempdeux = systime(1) ; pour key_performance =2
295	if keyword_set(wdepth) then begin
296	gdep = gdepw[firstz:lastz]
297	e3 = e3w[firstz:lastz]
298	endif else begin
299	gdep = gdept[firstz:lastz]
300	e3 = e3t[firstz:lastz]
301	ENDELSE
302	; for the vertical sections with partial steps
303	IF keyword_set(ifpltz) AND keyword_set(key_partialstep) THEN BEGIN
304	CASE 1 OF
305	ifpltz EQ 'xz' AND ny EQ 1:BEGIN
306	bottom = total(tmask[firstx:lastx, firsty:lasty, firstz:lastz], 3)
307	good = where(bottom NE 0 AND bottom NE nz+keyword_set(wdepth))
308	bottom = lindgen(nx)+(bottom-1l+keyword_set(wdepth))*nx
309	IF good[0] NE -1 THEN BEGIN
310	bottom = bottom[good]
311	IF lastz EQ jpk-1 THEN gdep[nz-1] = max(hdepw)
312	gdep = replicate(1, nx)#gdep
313	if keyword_set(wdepth) THEN $
314	truegdep = hdepw[firstx:lastx, firsty:lasty] $
315	ELSE truegdep = hdept[firstx:lastx, firsty:lasty]
316	gdep[bottom] = truegdep[good]
317	ENDIF
318	END
319	ifpltz EQ 'yz' AND nx EQ 1:BEGIN
320	bottom = total(tmask[firstx:lastx, firsty:lasty, firstz:lastz], 3)
321	good = where(bottom NE 0 AND bottom NE nz+keyword_set(wdepth))
322	bottom = lindgen(ny)+(bottom-1l+keyword_set(wdepth))*ny
323	IF good[0] NE -1 THEN BEGIN
324	bottom = bottom[good]
325	IF lastz EQ jpk-1 THEN gdep[nz-1] = max(hdepw)
326	gdep = replicate(1, ny)#gdep
327	if keyword_set(wdepth) THEN $
328	truegdep = hdepw[firstx:lastx, firsty:lasty] $
329	ELSE truegdep = hdept[firstx:lastx, firsty:lasty]
330	gdep[bottom] = truegdep[good]
331	ENDIF
332	END
333	ELSE:
334	ENDCASE
335	ENDIF
336	IF testvar(var = key_performance) EQ 2 THEN $
337	print, 'temps grille: Variables se rapportant a la dimension verticale ', systime(1)-tempdeux
338	;------------------------------------------------------------
339	; vecteur triangulation Qd TRI est active
340	;------------------------------------------------------------
341	if arg_present(TRI) then $
342	if triangles_list[0] EQ -1 OR keyword_set(notri) then tri = -1 ELSE BEGIN
343	tempdeux = systime(1) ; pour key_performance =2
344	msk = bytarr(jpi, jpj)
345	msk[firstx:lastx, firsty:lasty] = 1
346	ind = where( msk[triangles_list[0, ]]msk[triangles_list[1, ]]msk[triangles_list[2, *]] EQ 1 )
347	tri = triangles_list[, ind]-(firstx+firstyjpi)
348	y = tri/jpi
349	x = tri-y*jpi
350	tri = x+y*nx
351	IF testvar(var = key_performance) EQ 2 THEN $
352	print, 'temps grille: decoupage de la triangulation ', systime(1)-tempdeux
353	ENDELSE
354	;------------------------------------------------------------------
355	; pour s'assurer qu'il n'y a pas de dimension degenerees (=1)
356	;-------------------------------------------------------------------
357	; mask=reform(mask, /over)
358	; glam=reform(glam, /over)
359	; gphi=reform(gphi, /over)
360	; gdep=reform(gdep, /over)
361	; e1=reform(e1, /over)
362	; e2=reform(e2, /over)
363	; e3=reform(e3, /over)
364
365	if keyword_set(savedbox) THEN restoreboxparam, 'boxparam4grille.dat'
366	if keyword_set(key_performance) THEN print, 'temps grille', systime(1)-tempsun
367
368	;------------------------------------------------------------
369	IF NOT keyword_set(key_forgetold) THEN BEGIN
370	@updateold
371	ENDIF
372	;---------------------
373	return
374
375	end
376
377
378
379
380
381
382

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format