source: trunk/tools/idl_netcdf/ncdf_colle2.pro @ 161

Last change on this file since 161 was 161, checked in by pinsard, 15 years ago

conversion from IDL help header syntax to IDLDOC 2. header syntax
File size: 12.9 KB
Line 
1;+
2; permet de coller n fichiers entre eux suivant une
3; direction. c.a.d. qu''un nouveau fichier de sortie est ecrit et que
4; si les variables comportent la dimension a coller alors la variable
5; de sortie sera un collage des n variables d''entree suivant la dite dimension
6;
7; @categories
8; bidouille de fichiers netcdf
9;
10; @param LISTIN {in}{required}
11; 'nomfich1,nomfich2,nomfich3,...': un string contenant la
12;        liste des noms des fichiers en entree separes par une virgule
13;
14; @param NOMFICHOUT {in}{required}
15; un string contenant le nom du fichier en sortie
16;
17; @param NOMDIREC {in}{required}
18; un string contenant le nom de la dimension
19; suivant laquelle on doit faire le collage.     
20
21; REMARQUE: si nomdirect n''existe pas ds le fichier et que les
22; fichiers d''entree ne comportent pas de dimension infinie alors on cree la dimension
23;  infinie nomdirect et on constitue pour chaque variable un
24;  "empilement" des n tableaux suivant la nouvelle direction. En clair
25;  avec n fichiers sans dim temporelle on cree une serie temporelle de n pas de temps.
26;
27; @keyword GARDE
28; vecteur donnant les noms des variables a
29;        selectionner. si il n'est pas active toutes les variables
30;        sont selectionnees.
31;
32; @keyword EXCLU
33; vecteur donnant les noms des variablers a ne pas
34;        selectionner. si il n'est pas active toutes les variables
35;        sont selectionnees.
36;
37; @uses
38; attention cette procedure fait appelle a la fonction
39; colle.pro
40;  souvant pour une raison encore inexpliquee, IDL ne reconnait pas ds
41;  ncdf_colle que colle est une fonction et plante en annoncant que la
42;  variable colle is undefinned...
43;  Ce probleme se rencontre meme parfois qd on a pris soin de compiler
44;  colle avant de lancer ncdf_colle.
45;  La solution (curieuse et inexpliquee) que je propose est apres un
46;  petit retall de recompiler colle puis ncdf_colle.
47;      IDL>retall
48;      IDL>.r colle
49;      IDL>.r ncdf_colle
50;
51; SIDE EFFECTS: Pour coller ncdf_colle appelle colle avec un tableau
52; de pointeur en argument. Qd tout se passe bien (ncdf_colle ne plante
53; pas) les pointeurs et les pointes sont detruits. Par contre en cas
54; de plantage les pointeurs sont detruits mais pas les tableaux vers
55; lesquels ils pointent. Ceux-ci restent en memoire tant qu'ils ne sont
56; pas explicitement detruit avec ptr_free ou tant que la cession
57; n''est pas detruite. Ceux ci peut expliquer pourquoi apres 2 ou 3
58; plantages en serie IDL affiche unable to allocate memory...
59;
60; @restrictions
61;
62; @examples
63;
64; @history
65; Sebastien Masson (smasson\@lodyc.jussieu.fr)
66;                       23/11/98
67; 13/1/98 : attribut concernant le min et le max
68;-
69;------------------------------------------------------------
70;------------------------------------------------------------
71;------------------------------------------------------------
72PRO ncdf_colle, listin, nomfichout, nomdirec, GARDE = garde,  EXCLU = exclu
73   nomdirec = strlowcase(nomdirec)
74;------------------------------------------------------------
75; decriptage de listin
76;------------------------------------------------------------
77; on recupere le nom des fichiers a coller
78   nomfichin = str_sep(listin, ',')
79   nomfichin = strtrim(nomfichin, 2)
80; on recupere le nombre de fichiers a coller
81   nbrefich = n_elements(nomfichin)
82;------------------------------------------------------------
83; ouverture de tous les fichiers
84;------------------------------------------------------------
85   cdfidin = lonarr(nbrefich)
86   for n = 0,nbrefich-1 do begin
87      cdfidin[n] = ncdf_open(nomfichin[n])
88   endfor
89;------------------------------------------------------------
90; le contenu des fichers est contenu ds un vecteur de structures...
91;------------------------------------------------------------
92   contientin = replicate(ncdf_inquire(cdfidin[0]),nbrefich )
93   for n = 1, nbrefich-1 do begin
94      intermediere = ncdf_inquire(cdfidin[n])
95      contientin[n].ndims = intermediere.ndims
96      contientin[n].nvars = intermediere.nvars
97      contientin[n].ngatts = intermediere.ngatts
98      contientin[n].recdim = intermediere.recdim
99      intermediere = 1
100   endfor
101;------------------------------------------------------------
102; mise en place du resultat
103;------------------------------------------------------------
104   cdfidout = ncdf_create('travaille.nc', /clobber)
105;------------------------------------------------------------
106; dimensions en entree
107;------------------------------------------------------------
108   nomdimin = strarr(contientin[0].ndims)
109   tailledimin = lonarr(contientin[0].ndims)
110   tailledimout = lonarr(contientin[0].ndims)
111   nouvelledim = 1
112   for dimid = 0,contientin[0].ndims-1 do begin
113      ncdf_diminq, cdfidin[0], dimid, name, value
114      nomdimin[dimid] = name
115      tailledimin[dimid] = value
116      tailledimout[dimid] = value
117      if strlowcase(name) EQ nomdirec then begin
118         nouvelledim = 0
119         for n = 1,nbrefich-1 do begin
120            ncdf_diminq, cdfidin[n], dimid, name, value
121            tailledimout[dimid] = tailledimout[dimid]+value
122         endfor
123      ENDIF
124   endfor
125;------------------------------------------------------------
126; definition des dimensions du nouveau fichier
127;------------------------------------------------------------
128   dimidout = lonarr(contientin[0].ndims+1*nouvelledim)
129   for i = 0,contientin[0].ndims-1 do begin
130      if i NE contientin[0].recdim then $
131       dimidout[i] = ncdf_dimdef(cdfidout, nomdimin[i], tailledimout[i]) $
132      ELSE dimidout[i] = ncdf_dimdef(cdfidout, nomdimin[i], /unlimited)
133   endfor
134   if nouvelledim AND contientin[0].recdim EQ -1 $
135    THEN dimidout[contientin[0].ndims] = ncdf_dimdef(cdfidout, nomdimin[i], /unlimited)
136;
137; on recupere l''id, pour le fichier de sortie, des dimensions a garder.
138; pour cela on construit indice qui est la liste des dimensions a
139; garder et leurs indices ds nomdim2.
140;
141   case contientin[0].recdim of
142      0:renverser = 1
143      contientin[0].ndims-1:renverser = 0
144      -1:renverser = 0
145      ELSE: BEGIN
146         print, 'la dimension infinie doit etre la premiere ou la derniere des dimensions du tableau'
147         stop
148      END
149   endcase
150;------------------------------------------------------------
151; definitions des attributs globeaux du nouveau fichier
152;------------------------------------------------------------
153   for attiq = 0, contientin[0].ngatts-1 do begin
154      name=ncdf_attname(cdfidin[0],attiq,/global)
155      rien = ncdf_attcopy(cdfidin[0],name,cdfidout,/in_global, /out_global)
156   endfor
157;------------------------------------------------------------
158; definition des variables
159;------------------------------------------------------------
160   varidout = lonarr(contientin[0].nvars)
161   for i = 0,contientin[0].nvars-1 do begin
162      varcontient = ncdf_varinq(cdfidin[0], i)
163      case 1 of
164         keyword_set(GARDE):rien = where(strlowcase(garde) EQ strlowcase(varcontient.name), test)
165         keyword_set(EXCLU):BEGIN
166            rien = where(strlowcase(exclu) EQ strlowcase(varcontient.name), test)
167            test = 1-test
168         END
169         ELSE :test = 1
170      endcase
171; si on garde la variable
172      if test EQ 1 then begin
173
174         indice = varcontient.dim
175         if renverser EQ 1 then indice = reverse(indice)
176
177
178         IF varcontient.dim[0] NE -1 THEN BEGIN
179                                ; la variable extraite n''est pas un scalaire
180            commande = 'varidout[i] = ncdf_vardef(cdfidout,varcontient.name , dimidout(indice),'+varcontient.datatype+'=1)'
181            rien = execute(commande)
182         ENDIF ELSE BEGIN
183            commande = 'varid2[i] = ncdf_vardef(cdfid2,varcontient.name ,'+varcontient.datatype+'=1)'
184            rien = execute(commande)
185         ENDELSE
186;------------------------------------------------------------
187; atributs des variables
188;------------------------------------------------------------
189         FOR attid = 0,varcontient.natts-1 do begin
190            name = ncdf_attname(cdfidin[0],i , attid)
191            case 1 of
192               strpos(name, 'max') ne -1:ncdf_attput,cdfidout,varcontient.name, 'valid_max', '-0.00000e+00f'
193               strpos(name, 'min') ne -1:ncdf_attput,cdfidout,varcontient.name, 'valid_min', '-0.00000e+00f'
194               ELSE:bidon = ncdf_attcopy(cdfidin[0],i, name, cdfidout,varcontient.name)
195            endcase
196         endfor
197      endif
198   endfor
199;------------------------------------------------------------
200; fin de la definition du fichier de sortie.
201;------------------------------------------------------------
202   ncdf_control,  cdfidout, /endef
203;------------------------------------------------------------
204; debut du remplissage des variables
205;------------------------------------------------------------
206   for i = 0,contientin[0].nvars-1 do begin
207      varcontient = ncdf_varinq(cdfidin[0], i)
208      case 1 of
209         keyword_set(GARDE):rien = where(strlowcase(garde) EQ strlowcase(varcontient.name), test)
210         keyword_set(EXCLU):BEGIN
211            rien = where(strlowcase(exclu) EQ strlowcase(varcontient.name), test)
212            test = 1-test
213         END
214         ELSE :test = 1
215      endcase
216      if test EQ 1 then begin
217         print, varcontient.name
218; la variable contient la dim a coller ?
219         numero = where(strlowcase(nomdimin(varcontient.dim)) EQ nomdirec)
220         if numero[0] NE -1 then BEGIN ; il faut coller ...
221; mise en place du tableau de pointeur pour utiliser colle
222            tabpoint = ptrarr(nbrefich,/allocate_heap)
223            for numfich = 0, nbrefich-1 do begin
224               ncdf_varget, cdfidin[numfich], i, tab
225               *tabpoint[numfich] = tab
226               tab = 1
227            endfor
228; on colle et on ecrit ds le nouveau ficher
229            tabcolle = colle(tabpoint, numero[0]+1)
230            ncdf_varput, cdfidout,varcontient.name , tabcolle
231         ENDIF ELSE BEGIN
232            if nouvelledim then BEGIN
233; il faut les coller suivant une nouvelle dimension qui est obligatoirement infinie
234; mise en place du tableau de pointeur pour utiliser colle
235               tabpoint = ptrarr(nbrefich,/allocate_heap)
236               for numfich = 0, nbrefich-1 do begin
237                  ncdf_varget, cdfidin[numfich], i, tab
238                  *tabpoint[numfich] = reform(tab, [tailledimin(varcontient.dim), 1])
239                  tab = 1
240               endfor
241; on colle et on ecrit ds le nouveau ficher
242               tabcolle = colle(tabpoint,contientin[0].ndims+1)
243               ncdf_varput, cdfidout,varcontient.name, tabcolle
244            ENDIF ELSE BEGIN
245               ncdf_varget, cdfidin[0], i, tab
246               tabcolle = tab
247               ncdf_varput, cdfidout,varcontient.name,tabcolle               
248            ENDELSE
249         ENDELSE
250;------------------------------------------------------------
251; mise a jour du min et du max de la variable
252;------------------------------------------------------------
253; recherche de la missing value de l'argument max et min ...
254         FOR attid = 0,varcontient.natts-1 do begin
255            name = ncdf_attname(cdfidin[0],i , attid)
256            if strpos(strlowcase(name), 'missing') ne -1 then BEGIN
257               ncdf_attget, cdfidin[0],i ,name , value ; la missing value existe ??
258               missing = float(string(value))
259            endif
260            if strpos(strlowcase(name), 'min') ne -1 then BEGIN
261               ncdf_attget, cdfidin[0],i ,name , value ; l''argument min existe ??
262               min = float(string(value))
263            endif
264            if strpos(strlowcase(name), 'max') ne -1 then BEGIN
265               ncdf_attget, cdfidin[0],i ,name , value ; l''argument max existe ??
266               max = float(string(value))
267            endif
268         endfor
269         IF n_elements(max) NE 0 AND n_elements(min) NE 0 then begin
270            if n_elements(missing) NE 0 then BEGIN ; test different suivant la valeure
271               if abs(missing) LT 1e6 then BEGIN ; de missing  pour eviter les erreures
272                  nomask = where(tabcolle NE missing) ; d''arondis...
273                  max = max(tabcolle[nomask], min = min)
274               ENDIF ELSE BEGIN
275                  nomask = where(abs(tabcolle) LT abs(missing)/10.)
276                  max = max(tabcolle[nomask], min = min)
277               ENDELSE
278               nomask = 1
279            ENDIF ELSE max = max(tabcolle, min = min)
280            ncdf_attput,cdfidout,varcontient.name, 'valid_max', strtrim(max, 2)+'f'
281            ncdf_attput,cdfidout,varcontient.name, 'valid_min', strtrim(min, 2)+'f'
282            tempvar = SIZE(TEMPORARY(min)) ; pour effacer le min
283            tempvar = SIZE(TEMPORARY(max)) ; pour effacer le max
284         endif
285         tabcolle = 1
286      endif
287   endfor
288;------------------------------------------------------------
289; fermeture des fichiers
290;------------------------------------------------------------
291   for numfich = 0, nbrefich-1 do begin
292      ncdf_close, cdfidin[numfich]
293   endfor
294   ncdf_close, cdfidout
295;------------------------------------------------------------
296; changement de nom du fichier de resultat
297;------------------------------------------------------------
298   commande = 'mv travaille.nc '+nomfichout
299   spawn, commande
300   return
301end
Note: See TracBrowser for help on using the repository browser.