;+ ; permet de coller n fichiers entre eux suivant une ; direction. c.a.d. qu''un nouveau fichier de sortie est ecrit et que ; si les variables comportent la dimension a coller alors la variable ; de sortie sera un collage des n variables d''entree suivant la dite dimension ; ; @categories ; bidouille de fichiers netcdf ; ; @param LISTIN {in}{required} ; 'nomfich1,nomfich2,nomfich3,...': un string contenant la ; liste des noms des fichiers en entree separes par une virgule ; ; @param NOMFICHOUT {in}{required} ; un string contenant le nom du fichier en sortie ; ; @param NOMDIREC {in}{required} ; un string contenant le nom de la dimension ; suivant laquelle on doit faire le collage. ; REMARQUE: si nomdirect n''existe pas ds le fichier et que les ; fichiers d''entree ne comportent pas de dimension infinie alors on cree la dimension ; infinie nomdirect et on constitue pour chaque variable un ; "empilement" des n tableaux suivant la nouvelle direction. En clair ; avec n fichiers sans dim temporelle on cree une serie temporelle de n pas de temps. ; ; @keyword GARDE ; vecteur donnant les noms des variables a ; selectionner. si il n'est pas active toutes les variables ; sont selectionnees. ; ; @keyword EXCLU ; vecteur donnant les noms des variablers a ne pas ; selectionner. si il n'est pas active toutes les variables ; sont selectionnees. ; ; @uses ; attention cette procedure fait appelle a la fonction ; colle.pro ; souvant pour une raison encore inexpliquee, IDL ne reconnait pas ds ; ncdf_colle que colle est une fonction et plante en annoncant que la ; variable colle is undefinned... ; Ce probleme se rencontre meme parfois qd on a pris soin de compiler ; colle avant de lancer ncdf_colle. ; La solution (curieuse et inexpliquee) que je propose est apres un ; petit retall de recompiler colle puis ncdf_colle. ; IDL>retall ; IDL>.r colle ; IDL>.r ncdf_colle ; ; SIDE EFFECTS: Pour coller ncdf_colle appelle colle avec un tableau ; de pointeur en argument. Qd tout se passe bien (ncdf_colle ne plante ; pas) les pointeurs et les pointes sont detruits. Par contre en cas ; de plantage les pointeurs sont detruits mais pas les tableaux vers ; lesquels ils pointent. Ceux-ci restent en memoire tant qu'ils ne sont ; pas explicitement detruit avec ptr_free ou tant que la cession ; n''est pas detruite. Ceux ci peut expliquer pourquoi apres 2 ou 3 ; plantages en serie IDL affiche unable to allocate memory... ; ; @restrictions ; ; @examples ; ; @history ; Sebastien Masson (smasson\@lodyc.jussieu.fr) ; 23/11/98 ; 13/1/98 : attribut concernant le min et le max ;- ;------------------------------------------------------------ ;------------------------------------------------------------ ;------------------------------------------------------------ PRO ncdf_colle, listin, nomfichout, nomdirec, GARDE = garde, EXCLU = exclu nomdirec = strlowcase(nomdirec) ;------------------------------------------------------------ ; decriptage de listin ;------------------------------------------------------------ ; on recupere le nom des fichiers a coller nomfichin = str_sep(listin, ',') nomfichin = strtrim(nomfichin, 2) ; on recupere le nombre de fichiers a coller nbrefich = n_elements(nomfichin) ;------------------------------------------------------------ ; ouverture de tous les fichiers ;------------------------------------------------------------ cdfidin = lonarr(nbrefich) for n = 0,nbrefich-1 do begin cdfidin[n] = ncdf_open(nomfichin[n]) endfor ;------------------------------------------------------------ ; le contenu des fichers est contenu ds un vecteur de structures... ;------------------------------------------------------------ contientin = replicate(ncdf_inquire(cdfidin[0]),nbrefich ) for n = 1, nbrefich-1 do begin intermediere = ncdf_inquire(cdfidin[n]) contientin[n].ndims = intermediere.ndims contientin[n].nvars = intermediere.nvars contientin[n].ngatts = intermediere.ngatts contientin[n].recdim = intermediere.recdim intermediere = 1 endfor ;------------------------------------------------------------ ; mise en place du resultat ;------------------------------------------------------------ cdfidout = ncdf_create('travaille.nc', /clobber) ;------------------------------------------------------------ ; dimensions en entree ;------------------------------------------------------------ nomdimin = strarr(contientin[0].ndims) tailledimin = lonarr(contientin[0].ndims) tailledimout = lonarr(contientin[0].ndims) nouvelledim = 1 for dimid = 0,contientin[0].ndims-1 do begin ncdf_diminq, cdfidin[0], dimid, name, value nomdimin[dimid] = name tailledimin[dimid] = value tailledimout[dimid] = value if strlowcase(name) EQ nomdirec then begin nouvelledim = 0 for n = 1,nbrefich-1 do begin ncdf_diminq, cdfidin[n], dimid, name, value tailledimout[dimid] = tailledimout[dimid]+value endfor ENDIF endfor ;------------------------------------------------------------ ; definition des dimensions du nouveau fichier ;------------------------------------------------------------ dimidout = lonarr(contientin[0].ndims+1*nouvelledim) for i = 0,contientin[0].ndims-1 do begin if i NE contientin[0].recdim then $ dimidout[i] = ncdf_dimdef(cdfidout, nomdimin[i], tailledimout[i]) $ ELSE dimidout[i] = ncdf_dimdef(cdfidout, nomdimin[i], /unlimited) endfor if nouvelledim AND contientin[0].recdim EQ -1 $ THEN dimidout[contientin[0].ndims] = ncdf_dimdef(cdfidout, nomdimin[i], /unlimited) ; ; on recupere l''id, pour le fichier de sortie, des dimensions a garder. ; pour cela on construit indice qui est la liste des dimensions a ; garder et leurs indices ds nomdim2. ; case contientin[0].recdim of 0:renverser = 1 contientin[0].ndims-1:renverser = 0 -1:renverser = 0 ELSE: BEGIN print, 'la dimension infinie doit etre la premiere ou la derniere des dimensions du tableau' stop END endcase ;------------------------------------------------------------ ; definitions des attributs globeaux du nouveau fichier ;------------------------------------------------------------ for attiq = 0, contientin[0].ngatts-1 do begin name=ncdf_attname(cdfidin[0],attiq,/global) rien = ncdf_attcopy(cdfidin[0],name,cdfidout,/in_global, /out_global) endfor ;------------------------------------------------------------ ; definition des variables ;------------------------------------------------------------ varidout = lonarr(contientin[0].nvars) for i = 0,contientin[0].nvars-1 do begin varcontient = ncdf_varinq(cdfidin[0], i) case 1 of keyword_set(GARDE):rien = where(strlowcase(garde) EQ strlowcase(varcontient.name), test) keyword_set(EXCLU):BEGIN rien = where(strlowcase(exclu) EQ strlowcase(varcontient.name), test) test = 1-test END ELSE :test = 1 endcase ; si on garde la variable if test EQ 1 then begin indice = varcontient.dim if renverser EQ 1 then indice = reverse(indice) IF varcontient.dim[0] NE -1 THEN BEGIN ; la variable extraite n''est pas un scalaire commande = 'varidout[i] = ncdf_vardef(cdfidout,varcontient.name , dimidout(indice),'+varcontient.datatype+'=1)' rien = execute(commande) ENDIF ELSE BEGIN commande = 'varid2[i] = ncdf_vardef(cdfid2,varcontient.name ,'+varcontient.datatype+'=1)' rien = execute(commande) ENDELSE ;------------------------------------------------------------ ; atributs des variables ;------------------------------------------------------------ FOR attid = 0,varcontient.natts-1 do begin name = ncdf_attname(cdfidin[0],i , attid) case 1 of strpos(name, 'max') ne -1:ncdf_attput,cdfidout,varcontient.name, 'valid_max', '-0.00000e+00f' strpos(name, 'min') ne -1:ncdf_attput,cdfidout,varcontient.name, 'valid_min', '-0.00000e+00f' ELSE:bidon = ncdf_attcopy(cdfidin[0],i, name, cdfidout,varcontient.name) endcase endfor endif endfor ;------------------------------------------------------------ ; fin de la definition du fichier de sortie. ;------------------------------------------------------------ ncdf_control, cdfidout, /endef ;------------------------------------------------------------ ; debut du remplissage des variables ;------------------------------------------------------------ for i = 0,contientin[0].nvars-1 do begin varcontient = ncdf_varinq(cdfidin[0], i) case 1 of keyword_set(GARDE):rien = where(strlowcase(garde) EQ strlowcase(varcontient.name), test) keyword_set(EXCLU):BEGIN rien = where(strlowcase(exclu) EQ strlowcase(varcontient.name), test) test = 1-test END ELSE :test = 1 endcase if test EQ 1 then begin print, varcontient.name ; la variable contient la dim a coller ? numero = where(strlowcase(nomdimin(varcontient.dim)) EQ nomdirec) if numero[0] NE -1 then BEGIN ; il faut coller ... ; mise en place du tableau de pointeur pour utiliser colle tabpoint = ptrarr(nbrefich,/allocate_heap) for numfich = 0, nbrefich-1 do begin ncdf_varget, cdfidin[numfich], i, tab *tabpoint[numfich] = tab tab = 1 endfor ; on colle et on ecrit ds le nouveau ficher tabcolle = colle(tabpoint, numero[0]+1) ncdf_varput, cdfidout,varcontient.name , tabcolle ENDIF ELSE BEGIN if nouvelledim then BEGIN ; il faut les coller suivant une nouvelle dimension qui est obligatoirement infinie ; mise en place du tableau de pointeur pour utiliser colle tabpoint = ptrarr(nbrefich,/allocate_heap) for numfich = 0, nbrefich-1 do begin ncdf_varget, cdfidin[numfich], i, tab *tabpoint[numfich] = reform(tab, [tailledimin(varcontient.dim), 1]) tab = 1 endfor ; on colle et on ecrit ds le nouveau ficher tabcolle = colle(tabpoint,contientin[0].ndims+1) ncdf_varput, cdfidout,varcontient.name, tabcolle ENDIF ELSE BEGIN ncdf_varget, cdfidin[0], i, tab tabcolle = tab ncdf_varput, cdfidout,varcontient.name,tabcolle ENDELSE ENDELSE ;------------------------------------------------------------ ; mise a jour du min et du max de la variable ;------------------------------------------------------------ ; recherche de la missing value de l'argument max et min ... FOR attid = 0,varcontient.natts-1 do begin name = ncdf_attname(cdfidin[0],i , attid) if strpos(strlowcase(name), 'missing') ne -1 then BEGIN ncdf_attget, cdfidin[0],i ,name , value ; la missing value existe ?? missing = float(string(value)) endif if strpos(strlowcase(name), 'min') ne -1 then BEGIN ncdf_attget, cdfidin[0],i ,name , value ; l''argument min existe ?? min = float(string(value)) endif if strpos(strlowcase(name), 'max') ne -1 then BEGIN ncdf_attget, cdfidin[0],i ,name , value ; l''argument max existe ?? max = float(string(value)) endif endfor IF n_elements(max) NE 0 AND n_elements(min) NE 0 then begin if n_elements(missing) NE 0 then BEGIN ; test different suivant la valeure if abs(missing) LT 1e6 then BEGIN ; de missing pour eviter les erreures nomask = where(tabcolle NE missing) ; d''arondis... max = max(tabcolle[nomask], min = min) ENDIF ELSE BEGIN nomask = where(abs(tabcolle) LT abs(missing)/10.) max = max(tabcolle[nomask], min = min) ENDELSE nomask = 1 ENDIF ELSE max = max(tabcolle, min = min) ncdf_attput,cdfidout,varcontient.name, 'valid_max', strtrim(max, 2)+'f' ncdf_attput,cdfidout,varcontient.name, 'valid_min', strtrim(min, 2)+'f' tempvar = SIZE(TEMPORARY(min)) ; pour effacer le min tempvar = SIZE(TEMPORARY(max)) ; pour effacer le max endif tabcolle = 1 endif endfor ;------------------------------------------------------------ ; fermeture des fichiers ;------------------------------------------------------------ for numfich = 0, nbrefich-1 do begin ncdf_close, cdfidin[numfich] endfor ncdf_close, cdfidout ;------------------------------------------------------------ ; changement de nom du fichier de resultat ;------------------------------------------------------------ commande = 'mv travaille.nc '+nomfichout spawn, commande return end