;---------------------------------------------------------------------------------------------- ; ; @version ; $Id$ ; ;---------------------------------------------------------------------------------------------- ; ; ; secondary subroutines used in the main subroutine named : write_ncdf.pro ; ------------------------------------------------------------------------ ; ; ;---------------------------------------------------------------------------------------------- ; ; --- ; ;---------------------------------------------------------------------------------------------- ; ; ; SUBROUTINE (1)/(3) : ; ; subroutine utilise ds le cas ou NOT_OUASSALU n est pas active ; (default) et alors cela sert a uniformiser les dimensions qui sont ; en dernieres dim de vars en unlimited si une dim de meme taille est ; definie en unlimited et si eventuellement elles peuvent aussi etre ; definies comme telles i.e. on privilegie le type unlimited pour les ; dimensions en fin de var lorsque c''est possible et qu au moins un ; dim de meme type est demandee en unlimited ; ; cf details plus bas... ; ;- pro writenc_unlimdim_update, dnames_imposed, unl_imposed, fmtbase, nviv $ , iidp1st, nn, dst, iid, SUPERTABU=supertab $ , DIMSIZESU=dimsizes, UNLIMTABAU=unlimtaba, UNLIMAU=unlima $ , DIMIDASU=dimidas, NDIMTOTU=ndimtot, DNAMOSSU=dnamoss, DNAMAU=dnama $ , IMPOSE_DNM_UNLU=impose_dnm_unl ; ------- compile_opt idl2, strictarrsubs ; idl2 --> les entiers sont des long par defaut ET [...] obligatoire pour les tablo ; strictarrsubs --> pas de depassement de tablo ; ------- ; (1) mise en forme en structures classiques du main prog if n_elements(supertab) ne ndimtot then message,'PB : procedure write_ncdf_unlimdim_update init, (dim'+iodp1st+', var'+nviv+')... stop' for ikd=0,ndimtot-1 do begin ikdp1st = string(ikd+1,format=fmtbase) com = 'strd'+ikdp1st+' = writenc_strlc2str(supertab[ikd])' if not execute(com) then message,'PB : writenc_unlimdim_update, loop1 on dim tot ('+ikdp1st+'), dim '+iidp1st+', var '+nviv+'... stop' endfor ; ------- ; (2) traitement des structures de dim existantes, et comparaison a la dim courante (qui est last of var) ; --> on est en train de gerer une last dim d une var avec option oneunlim_all_samesizeandlast_unlim=1, ; i.e. : si une dim est definie en unlim=1 ALORS toutes les dim de meme taille ET last dim definie avant ou ; apres deviennent identiques a cette dim (ne font plus qu une, selon compatibilite nom de dim ET unlimited impose ou pas) ; ; DONC - soit cette dim est unlim=0 --> - soit on a deja une dim meme taille unlimited=1 alors: Si nom+unlim_impose compatibles, ; on passe notre dim courante a unlim=1 et elle sera assimile a celle qui ; existe deja avec le meme nom precedent (car meme caracteristiques). Si nom+unlim incompatibles, ; on va juste creer une nouvelle dim last not unlimited. ; ; - soit on a pas deja de dim meme taille et unlim=1, donc cas classique cette dim unlim=0 est ; creee ou assimilee a une existante si nom et taille compatibles ; ; - soit cette dim est unlim=1 --> - soit une dim unlim=1 existe deja, alors elle sera assimilee a celle-ci si noms compatibles ; ; - soit une dim unlim=1 existe pas deja, alors cas plus complexe : pour eventuellement ; les mettre a jour, on doit parcourir les dimensions de meme taille pour separer les variables ; dont la dim en question est la last, et les variables dont la dim est not la last ; - soit on n a pas de variables qui ont une dim de meme taille en last dim, alors pas de mise ; a jour a faire, on va creer une nouvelle dim, qui sera la dim unlim=1 du fichier ; - soit on a des variable(s) avec une dim last de meme taille unlim=0 ET nomdim compatible, ; DONC on doit mettre a jour les last dim(s) de ces variables, 3 cas: ; - une dim (unlim=0) contient que des vars qui en dependent en last dim et meme taille ; que dim courante --> alors selon compatibilite pour changer unlim et nomdim, on regroupe ; les vars qui ont last dim same size sous cette meme dim qui devient unlim=1 et a laquelle ; la dim courante sera assimilee ; - aucune dim contient que des vars en last dim et meme taille que dim courante --> alors ; on cree des ICI une NOUVELLE dim qui est identique a la dim courante pour que celle-ci y ; assimilee (pas creer 2 fois meme dim) ET qui contient les vars avec last dim qui sont ; compatibles en unlim dim et nomdim ; - n=plus de une dim (unlim=0) contient que des vars en last dim et meme taille que dim ; courante --> il faudrait supprimer n-1 dim pour les assimiler a l une d entre elles... ; en fait cela veut dire que pas assez de contraintes ont ete donne en entree aux dim ; donc WARNING pour dire qu en ajoutant des contraintes pour forcer dim unlim=0 ou 1 ou bien ; forcer le nom de la dim, alors on levera l ambiguite. if unlima eq 0 then begin ; si on a une last dim not unlim, on check si des dim meme taille unlim1 qui existent pour les utiliser as same dim ; --> si on trouve une dim meme taille et unlim=1 et nom ok alors on met la dim nbdimvv[inv] en unlim aussi aaddo = where(dimsizes - nn eq 0 and unlimtaba eq 1) if n_elements(aaddo) ne 1 then message,'PB : on a 1 ou 0 dim en unlimited (a), pas plus... stop' if aaddo[0] ne -1 then begin ; on a une dims unlim=1 deja definie et de meme taille strnbd = string(aaddo[0]+1,format=fmtbase) com = 'strdtmp = strd'+strnbd if not execute(com) then message, 'ERR : attrib strdtmp -1 (dim'+iodp1st+', var'+nviv+')...stop' samnamokchgunlim = 0 ; peu importe cette valeur car si elle change pas c parce que dnames_imposed=0 donc condition apres deja ok if dnames_imposed eq 1 then if strdtmp.nomdim eq dnama then samnamokchgunlim=1 else samnamokchgunlim=0 if (unl_imposed eq 0) and (dnames_imposed eq 0 or samnamokchgunlim) $ then unlima=1 ; ok pn peut changer unlim de la nouvelle dim qui pourra bien etre assimilee par la suite a une dim deja existante endif endif else begin ; unlima = 1 --> cette last dim de la var est unlim=1 et donc unl_imposed = 1 aussi aaddo = where(dimsizes - nn eq 0 and unlimtaba eq 1) if n_elements(aaddo) ne 1 then message,'PB : on a 1 ou 0 dim en unlimited (b), pas plus... stop' if aaddo[0] eq -1 then begin ; si une dim same kind pas deja definie --> update des dims precedentes ou create (sinon, on aura assimil...) ; on a pas de dim meme taille avec unlim=1, donc on cherche si on a des last dims de meme taille ; pour les mettre a jour question var et les rendre unlim=1 si possible ou creer un new dim unlim sinon aabb = where(dimsizes - nn eq 0) ; et comme aucun n a same size et unlim=1 (cf au dessus) --> on tombe sur des dim unlim=0 !!!! if aabb[0] ne -1 then begin nbsdd = n_elements(aabb) for iod=0,nbsdd-1 do begin ; on parcourt les dim de meme taille pr separer last dim ET not last dim iodp1st=string(iod+1,format=fmtbase) strnbd = string(aabb[iod]+1,format=fmtbase) com = 'strdtmp = strd'+strnbd if not execute(com) then message, 'ERR : attrib strdtmp 0a (dim'+iodp1st+', var'+nviv+')...stop' ; que si on peut modifier leur dim name IF dnames_imposed EQ 1 THEN if impose_dnm_unl[0,aabb[iod]] eq 1 and strdtmp.nomdim ne dnama then CONTINUE strvarsdim = strdtmp.vardep_ndim vnmarr = strvarsdim.(0) ddparr = strvarsdim.(1) nvararr = strvarsdim.(2) lastad = strvarsdim.(3) for iij=0,n_elements(nvararr)-1 do begin ;loop on var which depend on dim if lastad[iij] eq 1 then begin ; les var ou la dim est une last dim if n_elements(lasdd) eq 0 then $ lasdd = [ { u:aabb[iod]+1,v:[vnmarr[iij]],w:[ddparr[iij]] $ ,x:[nvararr[iij]],y:[lastad[iij]] } ] $ else $ lasdd = [ lasdd, { u:aabb[iod]+1,v:[vnmarr[iij]],w:[ddparr[iij]] $ ,x:[nvararr[iij]],y:[lastad[iij]] } ] endif else begin ; vars ou la dim est pas un last dim if n_elements(notlasdd) eq 0 then $ notlasdd = [ { u:aabb[iod]+1,v:[vnmarr[iij]],w:[ddparr[iij]] $ ,x:[nvararr[iij]],y:[lastad[iij]] } ] $ else $ notlasdd = [ notlasdd, { u:aabb[iod]+1,v:[vnmarr[iij]],w:[ddparr[iij]] $ ,x:[nvararr[iij]],y:[lastad[iij]] } ] endelse endfor endfor if n_elements(lasdd) ne 0 then begin ; alors on a des vars qui ont la meme dim en taille ET last dim --> update/creation faisable listdwlast = lasdd[*].(0) nnndz=0 dimwzonlylast=-1 & zorglub=temporary(dimwzonlylast) dimdone = [-1] FOR iad = 0, n_elements(listdwlast)-1 DO BEGIN ; on parcourt les dims de listdwlast, mais que une fois par dim size IF (where(dimdone eq listdwlast[iad]))[0] EQ -1 THEN BEGIN ; si cette dim est pas encore faite, on la fait strnbdo = string(listdwlast[iad], format = fmtbase) com = 'strdtmp = strd'+strnbdo if not execute(com) then message, $ 'ERR : attrib strdtmp 0b (dim'+strnbdo+', var'+nviv+')...stop' ;print,'hello ',strdtmp.vardep_ndim.(3) if (where(strdtmp.vardep_ndim.(3) eq 0))[0] eq -1 and impose_dnm_unl[1, listdwlast[iad]-1] eq 0 then begin ; pour cette dim: que des var avec last ET son unlim est pas imposed: ok, on peut utiliser cette dim pour update dimwzonlylast = listdwlast[iad] nnndz = nnndz+1 endif IF iad EQ 0 THEN dimdone = [listdwlast[iad]] ELSE dimdone = [dimdone, listdwlast[iad]] endif ENDFOR updatevara=0 ;if inv eq 2 and iid eq 0 then stop ;if iidp1st eq '01' and nviv eq '03' then stop case nnndz of 1:begin ; 1 dim contient que des var avec last dim --> on s en sert pour update ok ; ; on ajoute ces vars (si plus de 1 existe) qui ont dim unlim a la struct de dim choisie ; strnbdu = string(dimwzonlylast,format=fmtbase) com = 'strdtmp1 = strd'+strnbdu if not execute(com) then message, $ 'ERR : attrib strdtmp 0c (dim'+iidp1st+', var'+nviv+')...stop' uubb = where(lasdd[*].(0) ne dimwzonlylast) ; autre dim avec var last=1 ? si oui update: if uubb[0] ne -1 then begin updatevara=1 bbvdnd = { a:[strdtmp1.vardep_ndim.(0),lasdd[uubb].(1) ] $ ,b:[strdtmp1.vardep_ndim.(1),lasdd[uubb].(2) ] $ ,c:[strdtmp1.vardep_ndim.(2),lasdd[uubb].(3) ] $ ,d:[strdtmp1.vardep_ndim.(3),lasdd[uubb].(4) ] } endif else bbvdnd = strdtmp1.vardep_ndim ; ici pas d update var a faire (updatevara=0) unlimtaba[dimwzonlylast-1] = 1 ; update de unlim !!! ;si dnames_imposed=1, on a selectionne des dims de meme nom ou nom non impose, donc nomdim=dnama[iid], ;si dnames_imposed=0, le nom de notre dim courante peut changer pour assimile a ancien nomdim dnamoss[dimwzonlylast-1] ; -> ok gere par dnames_imposed... continue plus haut if n_elements(dnama) ne 0 then dnamoss[dimwzonlylast-1] = dnama[iid] strdtmp2={ dimid:strdtmp1.dimid,taille:strdtmp1.taille,nomdim:dnamoss[dimwzonlylast-1] $ ,unlimz:unlimtaba[dimwzonlylast-1],vardep_ndim:bbvdnd} ; on passe en unlim=1 ICI com='strd'+strnbdu+'=strdtmp2' if not execute(com) then message, $ 'ERR : update strd unlim dim '+strnbdu+', loop: dim'+iidp1st+', var'+nviv+'... stop 0' strdtmp1 = 0 & strdtmp2 = 0 end 0:begin ; aucune dim ne contient que des vars en last dim --> on doit cree une new dim ; --> la dim iidp1st = nbdimvv sera donc pas creee mais assimilee a celle-ci ; on ne cree bien qu une seule dim au max par passage sur indice iid ; pour creer nouvelle dim a laquelle la courante sera assimilee, il faut que les variables ; ramenees dedans, proviennent de dim qui le permettent, vis a vis de nom de dim imposee et/ou unlim impose noka = 0 for iud=0,n_elements(lasdd)-1 do begin if ( impose_dnm_unl[1, lasdd[iud].(0)-1 ] eq 0) then begin ; car unlim passe de 0 a 1 pour ces dim de vars ndst = string(ndimtot, format = fmtbase) if n_elements(dnama) ne 0 then dnamur = dnama[iid] else dnamur = dst+ndst if ( ( impose_dnm_unl[0, lasdd[iud].(0)-1 ] eq 0 ) or ( dnamur eq dnamoss[lasdd[iud].(0) -1]) ) then begin if noka eq 0 then begin lasddoka = [lasdd[iud]] listdwlastoka = [lasdd[iud].(0)] endif else begin lasddoka = [lasddoka,lasdd[iud]] listdwlastoka = [listdwlastoka,lasdd[iud].(0)] endelse noka = noka + 1 endif else begin if n_elements(notlasddoka) eq 0 then begin if n_elements(notlasdd) eq 0 then notlasddoka = [lasdd[iud]] $ else notlasddoka = [notlasdd, lasdd[iud]] endif else notlasddoka = [notlasddoka, lasdd[iud]] endelse endif endfor if noka ne 0 then begin updatevara=1 ndimtot = ndimtot+1 ndst = string(ndimtot, format = fmtbase) dimsizes = [dimsizes, nn] dimidas = [dimidas, dst+ndst] lasto=1 unlimtaba = [unlimtaba,unlima] ; rappel : unlima =1 if n_elements(dnama) ne 0 then dnamoss = [dnamoss, dnama[iid]] else dnamoss = [dnamoss, dimidas[ndimtot-1]] impose_dnm_unl = [[impose_dnm_unl],[dnames_imposed,unl_imposed]] ; tablo: ix=2, jy=ndimtot ddvdnd = { a:[lasddoka[*].(1) ] $ ,b:[lasddoka[*].(2) ] $ ,c:[lasddoka[*].(3) ] $ ,d:[lasddoka[*].(4) ] } com = 'strd'+ndst+' = { ' $ +' dimid:dimidas[ndimtot-1],taille:nn,nomdim:dnamoss[ndimtot-1],unlimz:unlimtaba[ndimtot-1]' $ +',vardep_ndim:ddvdnd } ' if not execute(com) then message, 'ERR : a la def (3) de la structure de dim' $ +iidp1st+', var'+nviv+'... stop' endif ; else aucune last var de dim est ok pour aller ds la nouvelle dim creable... elle se creera toute seule apres end else:begin print, ' *** WARNING !!! on trouve 2 dims ou plus, que l on peut mettre en unlimited (assimilees a la dim ' $ +'unlimited demandee)... pour ne pas choisir ou supprimer une dim, on ne change aucune dim en unlimited. ' $ +' --> Pour lever l''ambiguite si besoin, utiliser les champs unlim et dnames pour imposer des noms ' $ +'et carateristiques de dimensions et donner plus de contraintes pour la construction du netcdf (ou bien ' $ +'activer le mot cle /NOT_OUASSALU pour ne pas uniformiser les last dim des vars a unlimited dim).' ;message, 'PB Z : on ne peut avoir que 0 ou max 1 dim avec que des var lasto ' $ ; +'(dim'+iidp1st+', var'+nviv+')...stop' end endcase ; ; on doit egalement enlever ces vars des struct de dim ou on les a prises ; if updatevara eq 1 then begin if nnndz eq 0 then begin listdwlast = listdwlastoka notlasdd = notlasddoka endif dimdone = [-1] FOR iad = 0, n_elements(listdwlast)-1 DO BEGIN ; on parcourt les dims de listdwlast, mais que une fois par dim size IF (where(dimdone eq listdwlast[iad]))[0] EQ -1 THEN BEGIN ; si cette dim est pas encore faite, on la fait if nnndz eq 1 then if listdwlast[iad] eq dimwzonlylast then continue ;on saute dimwz si exist strnbdv = string(listdwlast[iad],format=fmtbase) com = 'strdtmp1 = strd'+strnbdv if not execute(com) then message, $ 'ERR : attrib strdtmp 0d dim loc'+strnbdv+' (dim'+iidp1st+', var'+nviv+')...stop' if n_elements(notlasdd) ne 0 then begin oobb = where(notlasdd[*].(0) eq listdwlast[iad]) ; dim de notlast concernee if oobb[0] eq -1 then message,'PB : 0 ou 1 max dim wz only last var ' $ +'dim loc'+istrnbdv+' (dim'+iidp1st+', var'+nviv+')...stop a PB Z expected' ccvdnd = { a:[ notlasdd[oobb].(1) ] $ ,b:[ notlasdd[oobb].(2) ] $ ,c:[ notlasdd[oobb].(3) ] $ ,d:[ notlasdd[oobb].(4) ] } strdtmp2={ dimid:strdtmp1.dimid,taille:strdtmp1.taille,nomdim:strdtmp1.nomdim $ ,unlimz:strdtmp1.unlimz,vardep_ndim:ccvdnd} com='strd'+strnbdv+'=strdtmp2' if not execute(com) then message, 'ERR : update strd unlim, dim loc'+strnbdv $ +', loop: dim'+iidp1st+', var'+nviv+'... stop 1' strdtmp1 = 0 & strdtmp2 = 0 ENDIF IF iad EQ 0 THEN dimdone = [listdwlast[iad]] ELSE dimdone = [dimdone, listdwlast[iad]] ENDIF endfor endif ; else pas besoin de faire update sur les var car on a juste mis unlim a 1 ds dimwzonlylas endif ; else... on n a pas de dim meme taille dont une var depend en last dim --> on va creer new dim endif ; else... pas de dim deja definie et de meme taille, donc on va creer une new dim endif else begin ; else... on a deja une dim de meme taille et unlim=1, donc elle DOIVENT etre les memes car une seule dim unlim=1 strnbd = string(aaddo[0]+1,format=fmtbase) com = 'strdtmp = strd'+strnbd if not execute(com) then message, 'ERR : attrib strdtmp 0d (dim'+iodp1st+', var'+nviv+')...stop' if dnames_imposed eq 1 then if not (strdtmp.nomdim eq dnama[n_elements(dnama)-1]) then $ message,'PB : on specifie 2 dimensions unlimited avec 2 noms differents... impossible... stop' endelse endelse ;print,'d',inv,unlima ; ------- ; (3) re-mise en forme en supertab pour passer au prog principal for ikd=0,ndimtot-1 do begin ; loop on dims pour mettre les champs vardep_ndim des struc dim en liste chainee ikdp1st = string(ikd+1,format=fmtbase) com = 'strdlc = writenc_str2strlc(strd'+ikdp1st+')' if not execute(com) then message,'PB : writenc_unlimdim_update loop2 on dim tot ('+ikdp1st+'), dim '+iidp1st+', var '+nviv+'... stop' if ikd eq 0 then supertab = [strdlc] else supertab = [supertab, strdlc] endfor ; on obtient ici supertab = [strd01lc ,strd02lc ....] end ;---------------------------------------------------------------------------------------------- ; ;+ ; SUBROUTINE (2)/(3) : ; ; on remplace la 4ieme structure de structa par une liste chainee afin ; d uniformaiser les format de strd (cf prog write_ncdf) pour les ; passer facilement en argument au sous-prog writenc_unlimdim_update, sous forme de tablo de structures de ; meme type !!!! (utilise si writenc_unlimdim_update est utilise i.e. dans le cas ou la cle NOT_OUASSALU ; est pas active, i.e. cas par defaut) ; ;- function writenc_str2strlc, structa ; -------- strdtmp = structa strvarsdim = strdtmp.vardep_ndim vnmarr = strvarsdim.(0) ddparr = strvarsdim.(1) nvararr = strvarsdim.(2) lastad = strvarsdim.(3) nvardepa = n_elements(lastad) if nvardepa lt 1 then message,'PB : aucune var ne depend de cette dim... impossible... stop' ; Create an anonymous strucutre to contain list elements. Note that ; the next field is initialized to be a null pointer. llistvofd01 = {vname:'', numdimdep:0, nvar:0, dlast:0, next:ptr_new()} if ptr_valid(fst_llistvofd01) then ptr_free,fst_llistvofd01 first_varsd01 = ptr_new(llistvofd01) current = first_varsd01 for iidv=0,nvardepa-1 do begin next = ptr_new({vname:'', numdimdep:0, nvar:0, dlast:0, next:ptr_new()}) ; set the name field of 'current' to the input string. (*current).vname = vnmarr[iidv] (*current).numdimdep = ddparr[iidv] (*current).nvar = nvararr[iidv] (*current).dlast = lastad[iidv] ; prepare the next field of 'current' to the pointer to the next list element. (*current).next = next ; copy the 'current' pointer to 'last' last = current ; make 'current' the next pointer. current = next endfor if ptr_valid(next) then ptr_free, next ; Set the _next_ field of the last element to the null pointer. if ptr_valid(last) then (*last).next = ptr_new() ; -------- strdout_ptr = { dimid:strdtmp.dimid, taille: strdtmp.taille , nomdim: strdtmp.nomdim , unlimz: strdtmp.unlimz $ ,vardep_ptr : first_varsd01 } return,strdout_ptr end ;+ ; ; SUBROUTINE (3)/(3) : ; ; convertit une structure contenant une liste ; chainee en structure classique utilisee par le main prog (utile pour ; passer ces structures en argument au sous-prog ; writenc_unlimdim_update, i.e. dans le cas ou la cle NOT_OUASSALU n ; est pas activee, i.e. cas par defaut) ; ; ;- function writenc_strlc2str, strwlist ptr_firstvars = strwlist.vardep_ptr ; create a second pointer to the heap variable pointed at by 'first' current = ptr_firstvars invdp = 0 while ptr_valid(current) do begin if invdp eq 0 then begin vnmarr = [ (*current).(0) ] ddparr = [ (*current).(1) ] nvararr = [ (*current).(2) ] lastad = [ (*current).(3) ] endif else begin vnmarr = [ vnmarr, (*current).(0) ] ddparr = [ ddparr, (*current).(1) ] nvararr = [ nvararr, (*current).(2) ] lastad = [ lastad, (*current).(3) ] endelse ; set 'current' equal to the pointer in its own next field. current = (*current).next invdp = invdp + 1 endwhile if invdp eq 0 then message,'PB : aucune var ne depend de cette dim... impossible 2 ... stop' strwolist = { dimid:strwlist.dimid, taille: strwlist.taille , nomdim: strwlist.nomdim , unlimz: strwlist.unlimz $ ,vardep_ndim: {a:vnmarr,b:ddparr,c:nvararr,d:lastad}} return, strwolist end ;---------------------------------------------------------------------------------------------- ; ; ; END SECONDARY SUBROUTINES ; ------------------------- ; ; ;---------------------------------------------------------------------------------------------- ; ... ... .... ... .. . .. . ;---------------------------------------------------------------------------------------------- ; ; ; MAIN SUBROUTINE ; --------------- ; ;---------------------------------------------------------------------------------------------- ;+ ; ; ; pro write_ncdf, var01,var02,var03,var04,var05,var06,var07,var08,var09,var10 $ ; ,var11,var12,var13,var14,var15,var16,var17,var18,var19,var20 $ ; ,var21,var22,var23,var24,var25,var26,var27,var28,var29,var30 $ ; ,FILENAME=filename $ ; ,GLOBATTR=globattr $ ; ,VARNAME=namevquick ; ; --------------------------------------------------------------------------------------------- ; ; @file_comments ; Construct a netcdf file containing up to 30 variables of any ; dimension (limited to 99 for now) with any attributes specified. ; We use structures to pass the fields (var and their attributes, and ; global attr) ; ; @return value ; a netcdf file containing the variable in the format specified ; through keywords and variables ; ; @param var01 {in}{required} ; - It can be simply a variable (scalar or array, of type : ; byte,int,long,float,double or string), or a structure ; containing the variable and its properties and attributes. At ; least one variable must be specified. ; - If a structure is given it should be of the following form (exple): ; vv1 = {var:xaxis,name:'nav_lon',dname:'x',at0:{a:'units',b:'degrees_east'},at1:{a:'title',b:'longitude'}} ; vv4 = {var:rain, name:'rain', unlim:1, dname:['x','y','t'],at0:{a:'units',b:'mm/day'},at4:{a:'missing_value',b:-9999.}} ; Namely, the if vv1 is a structure it MUST follow the following points: ; - attributes fields for the variable (at0,at1...) MUST be the last fields of the vv1 structure ; and name of those fields (at0,at1...) are not important. ; - attributes MUST themselves be given in the form of a 2 field structure, containing the ; name of the attribute (a string), and its value (can be any type as the ones of variable) ; - order of the first fields is not important but they MUST have the names: ; 'var' : for the variable (scalar or array, of type:byte,int,long,float,double or string) ; 'name' : for its name (a string), default value is var01,var02 etc... ; 'unlim' : = 1 to specify that the last dim of the var must be UNLIMITED, =0 or not specified otherwise ; 'dname' : to give the names of the dimensions of the variable, in the same order as the var dimensions. ; it is an array of string of dim = nbre de dim de la var. default is d01,d02 etc... ; - the field 'var' MUST be there (a variable) but every others are optional ; - if a missing value exists for the variable and one wants to specify it, it MUST be specified ; somewhere in one of the attributes and the name of this attribute MUST be 'missing_value' (to be taken ; into account in the computing of the min-max of the variable), missing_value being not case sensitive ; (MISSING_VALUE is also ok) ; ; @param var02, var03, .... var30 {in}{optional} ; All the variables/attributes to be written in the netcdf file, in ; the same way as the var01 (cf info above) ; ; @keyword filename {in}{optional} ; - a string giving the filename (including the path of the file) ; - if not specified, it is set to iodir+'writenclem.nc' ; ; @keyword globattr {in}{optional} ; - a structure containing the global attributes for the ; file. Similarly as for the attributes of the variable, this ; structure contains 2-fields structures which are the global ; attribute (first their name and second their value) ; exple: glbatt = {gb1:{a:'Grid',b:'regular 0.25'},gb2:{a:'Production',b:'clem'+systime()}} ; - if not specified in globattr, default case set production='date of ; day' as a global attribute ; ; @keyword namevquick {in}{optional} ; - an array of char, same number of elements as the number of given ; var ; - if specified, it gives the names of the variables as an array for ; the default name values (if one of the var is structure and also has ; the name field given, then the latter will be the one chosen and not namevquick) ; ; @uses ; cm_general for iodir variable ; ; @examples ; ; 1) ; IDL> write_ncdf, vvsst, btoa ; ; 2) ; IDL> write_ncdf, a1, {var:a2,name:'rain'}, ['up','down','fix'], a4, a5, {var:a6,unlim:1,name:'sst',dname:['x','y','z','time']} ; ; 3) ; IDL> write_ncdf,v031tr,msf031dn,msf031up,v031,vmaskloc,btoa,runame,titplo1,vargrid,nytt $ ; ,varname = ['v031tr','msf031dn','msf031up','v031','vmaskloc','btoa','runame','titplo1','vargrid','nytt'] $ ; ,filename = iodir+'IDL_DATA/'+'waza3.nc' ; ; 4) ; IDL> fileoutnc = iodir+'OBS/TRMM/'+'trmm_1d_'+iyystr+'0101_'+iyystr+'1231_reg0.25.nc' ; IDL> vv1 = {var:xaxis,name:'nav_lon',dname:'x',at1:{a:'units',b:'degrees_east'},at2:{a:'title',b:'longitude'}} ; IDL> vv2 = {var:yaxis,name:'nav_lat',dname:'y',at1:{a:'units',b:'degrees_north'},at2:{a:'title',b:'latitude'}} ; IDL> vv3 = {var:ttt,name:'time',dname:'time_counter',unlim:1,at1:{a:'units',b:timeunit},at2:{a:'title',b:'julian days'} $ ; IDL> vv4 = {var:rain_i2, name:'rain' $ ; ,at1:{a:'units',b:'mm/day'} $ ; ,at2:{a:'title',b:'trmm daily accumulated rainfall derived from the 3-hourly product (mm)'} $ ; ,at3:{a:'scale_factor',b:scala_factor} $ ; ,at4:{a:'add_offset',b:adda_offset} $ ; ,at5:{a:'missing_value',b:missaval_i2} $ ; } ; IDL> glbatt={ gb1:{a:'File_Name', b:'trmm_1d_'+iyystr+'0101_'+iyystr+'1231_reg0.25.nc'} $ ; ,gb2:{a:'Model_Name', b:'TRMM 3B42_V6 derived product'} $ ; ,gb3:{a:'Source_File',b:'ftp://disc2.nascom.nasa.gov/data/TRMM/Gridded/Derived_Products/3B42_V6/Daily/'+iyystr+'/*.bin'} $ ; ,gb4:{a:'IDL_Program_Name', b:'zz08_read_plot_row_trmm_precip.pro (clement@jamstec.go.jp)'} $ ; ,gb5:{a:'Grid', b:'regular 0.25 degres resolution'}$ ; } ; IDL> write_ncdf, vv1, vv2, vv3, vv4, filename=fileoutnc, globattr=glbatt ; ; @side effects ; ; @history ; CBM 2007-09-10 ; ; @todo ; clem ; ;- pro write_ncdf, var01,var02,var03,var04,var05,var06,var07,var08,var09,var10 $ ; RQ : if more than 30 variables is needed, simply add ,var11,var12,var13,var14,var15,var16,var17,var18,var19,var20 $ ; var31,var32 etc... here and change nmaxvv to 32 ... ,var21,var22,var23,var24,var25,var26,var27,var28,var29,var30 $ ,FILENAME=filename $ ,GLOBATTR=globattr $ ,VARNAME=namevquick $ $ ,NOT_SDISV=flag1 $ ; mots cles non utiles sauf cas particuliers... ,NOT_OUASSALU=flag2 $ ,OKNAN=oknan ; ; --> subroutine a tester avec le prog zz10_test_write_ncdf.pro par exemple... ; ou bien zz08_read_plot_row_trmm_precip_b ; ; ------- compile_opt idl2, strictarrsubs ; idl2 --> les entiers sont des long par defaut ET [...] obligatoire pour les tablo ; strictarrsubs --> pas de depassement de tablo @cm_general ; pour iodir si filename n est pas defini ; ------- writeout = 1 ; 1 pour ecrire info de base a l ecriture des vars, 0 sinon ; ------- ; not_samedimname_in_same_var : ; 1 : si on rencontre 2 dim de meme taille et meme unlim type ds une var on ; cree 2 dim differentes pour ne pas avoir 2 ou plus meme noms de dim ; dans une meme var (default) ; 0 : on ne cree pas de dim nouvelle si on a la la meme taille et meme ; unlim dim definie deja pour cette var, exple: fltarr(n1,n1) ne ; creera qu une dim de nom 'x1' de taille n1 if keyword_set(flag1) then not_samedimname_in_same_var = 0 else not_samedimname_in_same_var = 1 ; ------- ; ci-dessous ; 0 pour definir une nouvelle dim par sa taille ET sa nature unlim, uniquement ; 1 pour definir une nouvelle dim de la meme maniere, ET que si une dim est definie en unlim ALORS toutes les dim ; de meme taille ET last dim definie avant ou apres deviennent identiques a cette dim (ne font plus qu une), plutot que de ; definir, une dim de taille n0 ET not unlim en last dim de var01, ET une dim de taille n0 ET unlim=1 en last dim de var02 --> ; on defini la meme dim de taille n0 ET unlim pour les 2 vars var01 et var02 !! (default) if keyword_set(flag2) then oneunlim_all_samesizeandlast_unlim = 0 else oneunlim_all_samesizeandlast_unlim = 1 ; ------- if writeout then print,'-------write_ncdf-------' ; ------- structfd_v = 'var' structfd_n = 'name' structfd_unl = 'unlim' structfd_dn = 'dname' ncfile_default = 'write_ncdf.nc' nmaxvv = 30 nbdimmax = 99 fmtbase='(i2.2)' ; lie au max de var et dim definissable, si moins de 99 i2.2 ok, sinon passer a i3.3 etc... ; ------- nbvars = n_params() if nbvars lt 1 then message,'ERR : donner au moins une var stp ... stop' if nbvars gt nmaxvv then message,'ERR : la fonction write_ncdf est pour le moment definie pour '+string(nmaxvv,format=fmtbase) $ +' variables. Pour l utiliser avec plus, simplement ajouter var31,var32 etc ds l''entete de la subroutine... stop' ; ------- if n_elements(namevquick) ne 0 and n_elements(namevquick) ne nbvars then $ message,'PB : varname=... (nom des vars par defaut) doit avoir le meme nombre d elements que le nbre de vars... stop' ; ----------------------------------------------------------------------------------------------------------- ; ; creation du fichier netcdf ; ; ----------------------------------------------------------------------------------------------------------- if not(keyword_set(filename)) then ncfile=iodir+ncfile_default else ncfile=filename nposdir = strpos(ncfile,'/',/reverse_search) ; --> controlle de l existence du path menant au fichier dirr=strmid(ncfile,0,nposdir+1) if file_test(dirr,/directory) eq 0 then message,'ERR : le directory donne pour le fichier .nc n existe pas --> dir = '+dirr idout = ncdf_create(ncfile,/clobber) ; --> create a netcdf file, automatically placed into define mode (/clobber = erase previous file) ncdf_control, idout, /nofill ; --> data in the netcdf file is not pre-filled with default fill values ; ----------------------------------------------------------------------------------------------------------- ; ; define mode --> 1ere boucle sur les vars pour trouver les dimensions a definir et leurs caracteristiques ; ; ----------------------------------------------------------------------------------------------------------- oktypcodarr = [1,2,3,4,5,7] ; --> correspond au type de var accepte par ncdf_vardef de idl : byte,int,long,float,double,string, varst='var' dst='d' dimiss='--' dim_gene=dimiss arr_struct = intarr(nbvars) - 1 iattrv0 = intarr(nbvars) ; indice du premier attribut ds la structure typcodvv = intarr(nbvars) - 1 nama = strarr(nbvars) nbdimvv = intarr(nbvars) nbtags = intarr(nbvars) listofdimnams = strarr(nbvars) ;fieldfd = intarr(nbvars) firstdimcreated = 0 ndimtot = 0 for inv=0,nbvars-1 do begin dnames_imposed = 0 unl_imposed = 0 ; init de var, qui doivent etre non def si non attribuee (cf plus bas) dnama = 12 & zorglub = temporary(dnama) lasdd = 12 & zorglub = temporary(lasdd) notlasdd = 12 & zorglub = temporary(notlasdd) invp1=inv+1 nviv=string(invp1,format=fmtbase) commande= 'vvtmpstr=var'+nviv if not execute(commande) then message,'PB : attribution a vvtmp de la var numero '+nviv+'... stop' ; ; attribution des elements de la structure ou du tablo au vars de base pour ecrire definir la var-attr ds le ncdf ; sstr = size(vvtmpstr) nbdim = sstr[0] typcod = sstr[nbdim+1] if (where(oktypcodarr-typcod eq 0))[0] ne -1 then arr_struct[inv] = 0 ; --> var = scal or array of int, real, char, etc... if typcod eq 8 then arr_struct[inv] = 1 ; --> var = structure if arr_struct[inv] eq -1 then message,'PB : la var numero '+nviv+' est ni un array (int, float, string etc...) ni une structure... stop' case arr_struct[inv] of 0:begin ; --> var = scal or array of int, real, char, etc... vvtmp = vvtmpstr ssvv = size(vvtmp) nbdimvv[inv] = ssvv[0] typcodvv[inv] = ssvv[nbdimvv[inv]+1] if typcodvv[inv] eq 7 then begin ; les chaines de char ont un format particulier en tant que tablo pour ecriture netcdf... if nbdimvv[inv] eq 0 then ssvvdims = [ max(strlen(vvtmp))+1] else ssvvdims = [ max(strlen(vvtmp))+1,ssvv[1:nbdimvv[inv]] ] nbdimvv[inv] = nbdimvv[inv] + 1 endif else begin if nbdimvv[inv] eq 0 then ssvvdims = -12 else ssvvdims = ssvv[1:nbdimvv[inv]] endelse if n_elements(namevquick) eq 0 then nama[inv] = varst+nviv else nama[inv] = namevquick[inv] unlima = 0 ;dnama = zorglub ; non defini (car init avec temporary), default value fixed when dim are created (cf hereunder) end 1:begin ; --> var = structure nbtags[inv] = n_tags(vvtmpstr) tagnamas = tag_names(vvtmpstr) ; controle de la forme de la structure et def des elements ; 1) champ necessaire --> la variable fieldfound=0 for itg=0,nbtags[inv]-1 do begin if strlowcase(tagnamas[itg]) eq structfd_v then begin com= 'vvtmp=vvtmpstr.'+structfd_v if not execute(com) then message,'ERR : attribution de vvtmp, 1ere boucle sur les vars, var num '+nviv+'... stop' ssvv = size(vvtmp) nbdimvv[inv] = ssvv[0] typcodvv[inv] = ssvv[nbdimvv[inv]+1] if typcodvv[inv] eq 7 then begin ; les chaines de char ont un format particulier en tant que tablo pour ecriture netcdf... if nbdimvv[inv] eq 0 then ssvvdims = [ max(strlen(vvtmp))+1] $ else ssvvdims = [ max(strlen(vvtmp))+1,ssvv[1:nbdimvv[inv]] ] nbdimvv[inv] = nbdimvv[inv] + 1 endif else begin if nbdimvv[inv] eq 0 then ssvvdims = -12 else ssvvdims = ssvv[1:nbdimvv[inv]] endelse iattrv0[inv] = iattrv0[inv]+1 fieldfound=1 endif if fieldfound eq 1 then break endfor if fieldfound eq 0 then message,'ERR : le champ ''var'' est pas ds la structure (var num'+nviv+')... stop' ; 2) champ optionnel --> le nom de la var fieldfound=0 for itg=0,nbtags[inv]-1 do begin if strlowcase(tagnamas[itg]) eq structfd_n then begin iattrv0[inv] = iattrv0[inv]+1 com= 'nama[inv]=strcompress(vvtmpstr.'+structfd_n+')' if not execute(com) then message,'ERR : attribution de name of var num '+nviv+', 1ere boucle sur les vars... stop' if strlen(nama[inv]) eq 0 then message,'PB : nom de variable numero '+nviv+' vide, a respecifier...' fieldfound=1 endif if fieldfound eq 1 then break endfor if fieldfound eq 0 then if n_elements(namevquick) eq 0 then nama[inv] = varst+nviv else nama[inv] = namevquick[inv] ;fieldfd[inv] = fieldfound ; 3) champ optionnel --> si last dimension est unlimited fieldfound=0 for itg=0,nbtags[inv]-1 do begin if strlowcase(tagnamas[itg]) eq structfd_unl then begin iattrv0[inv] = iattrv0[inv]+1 com= 'unlima=vvtmpstr.'+structfd_unl if not execute(com) then message,'ERR : attribution de unlim of var num '+nviv+', 1ere boucle sur les vars... stop' if unlima ne 0 and unlima ne 1 then message,'PB : unlim vaut pas 0 ou 1 pour la var num '+nviv+'... stop' fieldfound=1 unl_imposed = 1 endif if fieldfound eq 1 then break endfor if fieldfound eq 0 then unlima = 0 ; unlimited=0 par defaut ; 4) champ optionnel --> nom des dimensions fieldfound=0 for itg=0,nbtags[inv]-1 do begin if strlowcase(tagnamas[itg]) eq structfd_dn then begin iattrv0[inv] = iattrv0[inv]+1 com= 'dnama=strcompress(vvtmpstr.'+structfd_dn+')' if not execute(com) then message,'ERR : attribution des dim name of var num '+nviv+', 1ere boucle sur les vars... stop' if n_elements(dnama) ne nbdimvv[inv] then message, 'PB : si on donne des noms de dim pour une var,' $ +' donner autant de noms que de dims pour la var... stop' aahh = strlen(dnama) if (where(aahh eq 0))[0] eq -1 or n_elements(where(aahh eq 0)) ne n_elements(dnama) then begin ; si on a pas que des chaines vides -> ok if (where(aahh eq 0))[0] ne -1 then $ message,'PB : un des noms (mais pas tous) des dim en input est vide... a respecifier... stop' if typcodvv[inv] eq 7 then dnama = ['d_strlen',dnama] ; on ajoute une dim donc un nom de dim aussi fieldfound=1 dnames_imposed = 1 ; si on donne des noms de dim, alors elles seront creees a coup sur ; (pas assimilees a d autres de meme taille ou autre...) endif else begin ; au cas ou on donne un tablo avec que des noms vide='', on considere que c est comme rien donner et on efface dnama zorglub = temporary(dnama) endelse ;print,'dnama=',dnama endif if fieldfound eq 1 then break endfor ;if fieldfound eq 0 then dnama = ... ; non def (car init avec temporary), default value fixed when dim are created (cf hereunder) end else:message,'wada t es pas la, impossible animal 1...' endcase if nbdimvv[inv] lt 0 or nbdimvv[inv] gt nbdimmax then message,'PB : sorry ben... moins de une ou plus de 99 dims... impossible... stop' if inv ge 1 then begin for invloc=0,inv-1 do if nama[inv] eq nama[invloc] then message,'PB : impossible de donner 2 noms identiques a 2 vars... stop' endif ;print,'NVIV = ',nviv ; on cree les structures pour chaque dim, afin de definir celles-ci ensuite if nbdimvv[inv] ne 0 then begin ; on a un vrai tablo, pas un scalaire ;print, 'var numero', nviv, ' , ssvv=', ssvv for iid = 0, nbdimvv[inv]-1 do begin iidp1 = iid+1 iidp1st = string(iidp1, format = fmtbase) ;nn = ssvv[iidp1] nn = ssvvdims[iid] ;print,'iidp1st = ',iidp1st ;if n_elements(strd02) ne 0 then begin ; ;print,'unlim d02 = ',strd02.unlimz ;endif if firstdimcreated eq 0 then aadd = [-1] else begin case iidp1 of ; (1) la dim de la var is the last one --> it can be unlimited nbdimvv[inv]:begin if oneunlim_all_samesizeandlast_unlim eq 1 then begin ; --> on update/create unlimited dimensions according to this one ptr_free,ptr_valid() for ikd=0,ndimtot-1 do begin ; loop on dims pour mettre les champs vardep_ndim des struc dim en liste chainee ikdp1st = string(ikd+1,format=fmtbase) com = 'strdlc = writenc_str2strlc(strd'+ikdp1st+')' if not execute(com) then message,'PB : loop on dim tot ('+ikdp1st+'), dim '+iidp1st+', var '+nviv+'... stop' if ikd eq 0 then supertab = [strdlc] else supertab = [supertab, strdlc] endfor ; on obtient ici supertab = [strd01lc ,strd02lc ....] writenc_unlimdim_update, dnames_imposed, unl_imposed, fmtbase, nviv, iidp1st, nn, dst,iid $ , supertabu = supertab, dimsizesu=dimsizes, unlimtabau=unlimtaba, unlimau=unlima $ , dimidasu=dimidas, ndimtotu=ndimtot, dnamossu=dnamoss, dnamau=dnama $ , impose_dnm_unlu = impose_dnm_unl for ikd=0,ndimtot-1 do begin ; on remet les struc avec liste chain en structures classiques du main prog ikdp1st = string(ikd+1,format=fmtbase) com = 'strd'+ikdp1st+' = writenc_strlc2str(supertab[ikd])' if not execute(com) then message,'PB : loop on dim tot ('+ikdp1st+'), dim '+iidp1st+', var '+nviv+'... stop' endfor endif ; oneunlim_all_samesizeandlast_unlim if dnames_imposed eq 1 then $ aadd = where(dimsizes-nn eq 0 and unlimtaba eq unlima and dnamoss eq dnama[iid]) else $ ; case sensitive sur EQ char aadd = where(dimsizes-nn eq 0 and unlimtaba eq unlima) ; la dim cherchee peut etre unlim car last end ; (2) la dim de la var is not last --> cannot be unlimited else : begin if dnames_imposed eq 1 then $ aadd = where(dimsizes - nn eq 0 and unlimtaba eq 0 and dnamoss eq dnama[iid]) else $ ; case sensitive sur EQ character aadd = where(dimsizes - nn eq 0 and unlimtaba eq 0) end endcase endelse ;if inv eq 3 and iid eq 2 then begin ;if inv eq 2 and iid eq 0 then begin ; ;print,'aadd inv 2, iid 0 =',aadd ; ;stop ;endif if aadd[0] eq -1 then begin ; cette taille de dim existe pas deja ou pas en meme unlimited style, donc on cree la dim ndimtot = ndimtot+1 ndst = string(ndimtot, format = fmtbase) if firstdimcreated eq 0 and iid eq 0 then begin ; premiere dim cree dimsizes = [nn] dimidas = [dst+ndst] if iidp1 eq nbdimvv[inv] then unlimtaba = [unlima] else unlimtaba = [0] if n_elements(dnama) ne 0 then dnamoss = [dnama[iid]] else dnamoss = [dimidas[ndimtot-1]] impose_dnm_unl = [dnames_imposed,unl_imposed] firstdimcreated = 1 endif else begin dimsizes = [dimsizes, nn] dimidas = [dimidas, dst+ndst] if iidp1 eq nbdimvv[inv] then unlimtaba = [unlimtaba,unlima] else unlimtaba = [unlimtaba,0] if n_elements(dnama) ne 0 then dnamoss = [dnamoss, dnama[iid]] else dnamoss = [dnamoss, dimidas[ndimtot-1]] impose_dnm_unl = [[impose_dnm_unl],[dnames_imposed,unl_imposed]] ; tablo: ix=2, jy=ndimtot endelse if iidp1 eq nbdimvv[inv] then lasto=1 else lasto=0 com = 'strd'+ndst+' = { dimid:dimidas[ndimtot-1],taille:nn,nomdim:dnamoss[ndimtot-1],unlimz:unlimtaba[ndimtot-1]' $ +',vardep_ndim:{a:[nama[inv]],b:[iidp1],c:[invp1],d:[lasto],impos:impose_dnm_unl[ndimtot-1]} } ' if not execute(com) then message, 'ERR : a la def (1) de la structure de dim'+iidp1st+', var'+nviv+'... stop' endif else begin ; cette taille de dim existe avec same unlimited style, on checke si c est ds la meme var ou pas nbsamedim = n_elements(aadd) ; au moins egal a 1 ou plus if dnames_imposed eq 1 then if nbsamedim gt 1 then message,'PB : impossible d avoir 2 dim identiques deja definies... stop' nbdsaminvar = 0 if not_samedimname_in_same_var eq 1 then begin ; ci-dessous: ; soit check 1ere dim of var: no same dim in var(nbdsaminvar=0), or elle existe deja, donc on utilise la 1ere identique ; soit on check la last (qui peut aussi etre la 1st), et si unlim=1 alors again: no same dim in var(nbdsaminvar=0), or ... ; soit on checke la last avec unlim=0 ou une var not last (donc unlim=0), et donc si size idem alors nbdsaminvar+1 if dnames_imposed eq 0 then begin if not (iid eq 0 or (iidp1 eq nbdimvv[inv] and unlima eq 1) ) then $ for iidloc = 0, iid-1 do if ssvvdims[iidloc] eq nn then nbdsaminvar = nbdsaminvar+1 endif ; else nbdsaminvar = 0 --> arrive si dnames_imposed = 1 endif ; else nbdsaminvar = 0 if nbdsaminvar lt nbsamedim then begin ; pas besoin de creer, on peut se servir d une dim deja definie, juste mise a jour de strd de aadd[nbdsaminvar]+1 ; on ne peut arriver que ici avec dnames_imposed = 1 car nbdsaminvar = 0 cf ci-dessus ;if inv eq 3 and iid eq 2 then ;print,'wada' strnbd = string(aadd[nbdsaminvar]+1, format = fmtbase) com = 'strdtmp = strd'+strnbd if not execute(com) then message, 'ERR : attribution strdtmp 1 (dim'+iidp1st+', var'+nviv+')...stop' if iidp1 eq nbdimvv[inv] then lasto=1 else lasto=0 aavardep_ndim = { a:[strdtmp.vardep_ndim.(0),nama[inv]],b:[strdtmp.vardep_ndim.(1),iidp1] $ ,c:[strdtmp.vardep_ndim.(2),invp1],d:[strdtmp.vardep_ndim.(3),lasto]} ;if iidp1 eq nbdimvv[inv] and unlima eq 1 then unlimnew = unlima else unlimnew = strdtmp.unlimz --> obsolete !!! unlimnew = strdtmp.unlimz ; unlimz reste inchange car la dim re-utilisee est selectionnee sur taille ET unlim ;if n_elements(dnama) ne 0 then dnamo = dnama[iid] else dnamo=strdtmp.nomdim if n_elements(dnama) ne 0 then if dnama[iid] ne strdtmp.nomdim then $ message,'PB : impossible d etre la, car update une dim qui a un nom impose different... stop' dnamo=strdtmp.nomdim ; on utilise le meme nom de l ancienne dim ok com='strd'+strnbd+'={dimid:strdtmp.dimid,taille:nn,nomdim:dnamo,unlimz:unlimnew,vardep_ndim:aavardep_ndim} ' if not execute(com) then message, 'ERR : update vardep,unlimz, dim'+strnbd+', loop: dim'+iidp1st+', var'+nviv+'... stop' ;if inv eq 3 and iid eq 2 then stop endif else if nbdsaminvar eq nbsamedim then begin ; on cree nouvelle dim, car cette taille de dim existe par exemple 2 fois avec 2 dimid noms differents ; mais on doit en creer une troisieme (meme taille, nom different) car une var contient 3 fois cette taille de dim... ; pour pouvoir etre ici, une condition necessaire est (car sinon nbdsaminvar=0 or nbsamedim > 0): ; not (iid eq 0 or (iidp1 eq nbdimvv[inv] and unlima eq 1)) ; donc on est (pas 1ere dim of var) ET (pas last dim of var OU pas unlim=1) ; donc je peux etre last dim mais alors en unlim=0 seulement, sinon je suis une dim du milieu (pas 1ere, ni last) ; DONC on ne cree jamais de dim unlim ici ndimtot = ndimtot+1 ndst = string(ndimtot, format = fmtbase) dimsizes = [dimsizes, nn] dimidas = [dimidas, dst+ndst] if iidp1 eq nbdimvv[inv] then unlimtaba = [unlimtaba,unlima] else unlimtaba = [unlimtaba,0] if unlimtaba[ndimtot-1] eq 1 then message,'PB : impossible de definir une structure de dim unlimited ici... stop' if n_elements(dnama) ne 0 then dnamoss = [dnamoss, dnama[iid]] else dnamoss = [dnamoss, dimidas[ndimtot-1]] if iidp1 eq nbdimvv[inv] then lasto=1 else lasto=0 impose_dnm_unl = [[impose_dnm_unl],[dnames_imposed,unl_imposed]] ; tablo: ix=2, jy=ndimtot, mis a jour com = 'strd'+ndst+' = { dimid:dimidas[ndimtot-1],taille:nn,nomdim:dnamoss[ndimtot-1],unlimz:unlimtaba[ndimtot-1]' $ +',vardep_ndim:{a:[nama[inv]],b:[iidp1],c:[invp1],d:[lasto] }} ' if not execute(com) then message, 'ERR : a la def (2) de la structure de dim'+iidp1st+', var'+nviv+'... stop' endif else message, 'ERR : impossible d avoir plus de dim identiques '+iidp1st+' ds la var'+nviv+'que deja definies... stop' endelse ; checke que l on ne vient pas de creer une 2ieme dim differentes en unlimited... ; (ncdf_dimdef stop autrement, car une seule dim unlimited allowed) if n_elements(where(unlimtaba eq 1)) ge 2 then message,'ERR : une 2ieme structure-dim unlimited (dim '+iidp1st+') vient ' $ +'d etre creee, mais on ne peut definir qu une unique dim unlimited en netcdf... stop' endfor endif ; else --> pas de dim a creer pour cette var qui est un scalaire ou string simple endfor ; ------------------------------------------------------------------- ; ; definition des dimensions ; ; ------------------------------------------------------------------- ; checke que l on n a pas mis deux dimensions differentes en unlimited... (ncdf_dimdef stop autrement, une seule dim unlimited) if n_elements(where(unlimtaba eq 1)) ge 2 then message,'ERR : plus de 2 dimensions unlimited ont ete prescrites... stop' ; commande de base pour definir une dim : ; ; idout_of_the_dim = NCDF_DIMDEF(idout_of_the_nc_file, 'name_of_dim', n_size_of_dim) ; ; EXPLES: ; ; xidout = NCDF_DIMDEF(idout, 'x', n1) ; ou pour unlimited : ; tidout = NCDF_DIMDEF(idout, 'time', /unlimited) ; sans donner la taille de la dim !!! ; ; RQ : ; ; - si on a deux dim avec le meme nom, la definition des dim renvoit un message d erreur, OK ; ; - si on definit une dim unlimited (t1idout par exemple), et si 2 var a1=fltarr(5) et a2=fltarr(7) se reclament de cette dim ; au moment du ncdf_vadef par id1=NCDF_VARDEF(idout,'a1',[t1idout],/FLOAT) et id2=...'a2'... ALORS la taille de la dim ; unlimited sera egale a la plus grde des 2 dims (ici 7) et les valeurs pour a1[5] et a1[6]seront mises a 9.96921e+36 ds le netcdf !!! ; --> ici on previent ce genre de choses, toutes les vars avec la dim unlim en dernier doivent avoir la meme taille pour ; cette dim, quitte a mettre des missing_value au prealable pour combler certains tablos a la bonne taille ; (plutot que des 9.96921e+36 non reconnaissable a priori) ; ; - avec une var tablo avec 2 (ou plus) dim de meme taille exple: fltarr(5,5), on peut ; soit definir 2 dim de nom differents et de meme taille d01idout=NCDF_DIMDEF(idout,'d01',5) et d02..= 'd02' puis ncdf_vardef([d01,d02]) ; soit definir UNE SEULE DIM d01idout de taille 5 et faire pour la var: ncdf_vardef(... [d01idout,d01idout] ...), aussi accepte for ind=0,ndimtot-1 do begin indp1st = string(ind+1,format=fmtbase) char1 = 'strd' & char2 = '.taille,' & char3 = '' com = 'if strd'+indp1st+'.unlimz eq 0 then ndstr= char1+indp1st+char2 else ndstr=char3' if not execute(com) then message,'ERR : computing de ndstr pour la def de la dim'+indp1st+'... stop' com = 'dimida = strd'+indp1st+'.dimid' if not execute(com) then message, 'ERR : attrib dim id, pour la def de la dim '+indp1st+'... stop' dimida = dimida+'idout' com = dimida+' = ncdf_dimdef(idout, strd'+indp1st+'.nomdim, '+ndstr+' unlimited=strd'+indp1st+'.unlimz)' if not execute(com) then message,'ERR : definition de la dim '+indp1st+'... stop' endfor ; ------------------------------------------------------------------- ; ; define mode --> 2ieme boucle sur les vars pour definir celles-ci ; ; ------------------------------------------------------------------- ; commande de base pour definir une var : ; ; id_of_the_var = NCDF_VARDEF(id_of_the_nc_file, 'name_of_the_var', [id_of_the_dim_of_the_var_in_the_right_order], /type_of_var) ; ; RQ : ; - si on veut definir une var unlimited, ca doit etre la derniere ; dim des variables. Si a2 = fltarr(n1, n4, n5, n3) alors la unlim ne ; peut etre que n3 ; - si on veut definir 2 vars avec le meme nom, on a un diag error par idl, ok ; ; EXPLE: ; id0 = NCDF_VARDEF(idout, 'a2', [xidout,tidout,yidout,zidout], /FLOAT) ; for inv=0,nbvars-1 do begin ; ; --> Def des vars ; ------------ nviv=string(inv+1,format=fmtbase) ; type de la var a ecrire tpv = intarr(6) case typcodvv[inv] of 1:tpv[0]=1 ; byte 2:tpv[1]=1 ; short (int) 3:tpv[2]=1 ; long 4:tpv[3]=1 ; float 5:tpv[4]=1 ; dble 7:tpv[5]=1 ; char else:message,'PB : le type de la var num '+nviv+' est pas accepte par ncdf idl (not byte,int,real...) ... stop' end flagstype = 'BYTE=tpv[0],SHORT=tpv[1],LONG=tpv[2],FLOAT=tpv[3],DOUBLE=tpv[4],CHAR=tpv[5]' listofdims = '' listofdimnams[inv] = '' if nbdimvv[inv] ne 0 then begin ; on a un vrai tablo, pas un scalaire --> on recherche le nom des dims de la var a mettre ds listofdims=... for iid = 0, nbdimvv[inv]-1 do begin ; boucle sur les dims de la var ds ordre des dim de la var iidp1 = iid+1 iidp1st = string(iid+1,format=fmtbase) ndimdepfd = 0 for ind=0,ndimtot-1 do begin ; boucle sur les dims globales qui ont ete definies precedemment indp1st = string(ind+1,format=fmtbase) com = 'namvararr = strd'+indp1st+'.vardep_ndim.(0)' if not execute(com) then message, 'ERR : attrib namvararr, dim glob '+indp1st+',dim var '+iidp1st+',var num '+nviv+'... stop' com = 'numdimvararr = strd'+indp1st+'.vardep_ndim.(1)' if not execute(com) then message, 'ERR : attrib numdimvararr, dim glob '+indp1st+',dim var '+iidp1st+',var num '+nviv+'... stop' aaa = where(namvararr eq nama[inv] and numdimvararr eq iidp1) if aaa[0] ne -1 then begin com = 'dimnam = strd'+indp1st+'.nomdim' if not execute(com) then message, 'ERR : attrib dimnam, dim glob '+indp1st+',dim var '+iidp1st+',var num '+nviv+'... stop' com = 'dimdep = strd'+indp1st+'.dimid' if not execute(com) then message, 'ERR : attrib dimdep, dim glob '+indp1st+',dim var '+iidp1st+',var num '+nviv+'... stop' dimdep = dimdep+'idout' ; check unlim en last dim ok com = 'unlimdd = strd'+indp1st+'.unlimz' if not execute(com) then message, 'ERR : attrib unlimdd, dim glob '+indp1st+',dim var '+iidp1st+',var num '+nviv+'... stop' if unlimdd eq 1 and iidp1 ne nbdimvv[inv] then $ message,'PB : cannot define var with unlim dim '+iidp1st+' which is not last of var'+nviv+' (dimglo'+indp1st+')... stop' IF unlimdd EQ 1 THEN dimnam = dimnam+'*' ; --- ndimdepfd=ndimdepfd + 1 endif endfor case ndimdepfd of 0:message,'PB : on ne trouve aucun nom de dim glob pour la dim '+iidp1st+' de la var '+nviv+'... stop' 1:begin if iid eq 0 then listofdims=dimdep else listofdims=listofdims+','+dimdep if iid eq 0 then listofdimnams[inv]=dimnam else listofdimnams[inv]=listofdimnams[inv]+','+dimnam end else:message,'PB : on trouve plus de 1 nom de dim glob pour la dim '+iidp1st+' de la var '+nviv+'... stop' endcase endfor listofdims='['+listofdims+'],' ; listofdims doit etre de la forme : '[...] ,' endif ; else listofdims = '' com='id'+nviv+'=NCDF_VARDEF(idout,nama[inv],'+listofdims+flagstype+')' if not execute(com) then message,'ERR : definition de la var '+nviv+' ... stop' ; ; --> Def des attributs de la var ; --------------------------- ; ds le cas d une structure: la def des attributs (si existent) a ete specifiee ds la structure missaval_flag = 0 if arr_struct[inv] eq 1 then begin ; --> ok var00 est une structure com= 'vvtmpstr=var'+nviv if not execute(com) then message,'ERR : attribution de vvtmpstr, 2ieme boucle sur les var, var num '+nviv+'... stop' if nbtags[inv] gt iattrv0[inv] then begin ; --> on a des attributs en plus nbattr = nbtags[inv] - iattrv0[inv] for iatr=0,nbattr-1 do begin iatrstp1=string(iatr+1,format=fmtbase) ;print, nviv, '--', iattrv0[inv], '--', iatr ss = size(vvtmpstr.(iattrv0[inv]+iatr)) if ss[0] ne 1 or ss[2] ne 8 or n_tags(vvtmpstr.(iattrv0[inv]+iatr)) ne 2 then $ message, 'PB : l attribut numero '+iatrstp1+' de la var'+nviv+' n est pas une struc de 2 elements... stop' attnamtmp = vvtmpstr.(iattrv0[inv]+iatr).(0) attxttmp = vvtmpstr.(iattrv0[inv]+iatr).(1) comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, attxttmp' if not execute(comm) then message,'PB : def attr numero'+iatrstp1+', var numero '+nviv+'... stop' if strlowcase(attnamtmp) eq 'missing_value' then begin ; --> si on trouve un attribut missval on memorise missaval_flag = 1 missaval = attxttmp endif endfor endif endif ; attributs par defaut: valid_min et valid_max et infos sur missing value if typcodvv[inv] ne 7 then begin ; --> si var est pas un char on peut calculer min et max case arr_struct[inv] of 0:com= 'vvtmp=var'+nviv 1:com= 'vvtmp=vvtmpstr.'+structfd_v else:message,'ERR : impossible to be there... stop' endcase if not execute(com) then message,'ERR : attribution de vvtmp, 2ieme boucle sur les var, var num '+nviv+'... stop' if not keyword_set(oknan) then begin aak = where(not(float(finite(vvtmp)))) if aak[0] ne -1 then $ message,'PB : la var numero '+nviv+' contient des nan... pas propre ds un fichier netcdf (cf utilisation ferret et autre soft)' $ +', remplacer par des missing ou bien activer le mot-cle /oknan pour tolerer l''ecriture de Nan ds le fichier nc... stop' endif writevalidminmax = 1 ; a priori on va ecrire un min et max value mais si que des missing alors on ne l ecrit pas en fait if missaval_flag eq 1 then begin ss = size(missaval) if ss[0] ne 0 or ss[1] ne typcodvv[inv] then message,'PB : la miss val est pas scalaire ou pas meme type que var '+nviv+'... stop' whhmiss = where(vvtmp eq missaval,complement=whhok) if whhmiss[0] eq -1 then begin if n_elements(vvtmp) gt 1 then begin attnamtmp = 'valid_min_max' attxttmp = 'missing value never occurs' comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, attxttmp' if not execute(comm) then message,'ERR : def extra attr miss val 0, var numero '+nviv+'... stop' endif aamax = max(vvtmp,min=aamin) endif else begin if whhok[0] ne -1 then begin if n_elements(vvtmp) gt 1 then begin attnamtmp = 'valid_min_max' attxttmp = 'missing value occurs' comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, attxttmp' if not execute(comm) then message,'ERR : def extra attr miss val 1, var numero '+nviv+'... stop' endif aamax = max(vvtmp[whhok],min=aamin) endif else begin ; on a que des missing value if n_elements(vvtmp) gt 1 then begin attnamtmp = 'valid_min_max' attxttmp = 'missing value always occurs' comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, attxttmp' if not execute(comm) then message,'ERR : def extra attr miss val 2, var numero '+nviv+'... stop' writevalidminmax = 0 endif else aamax = max(vvtmp,min=aamin) endelse endelse endif else begin aamax = max(vvtmp,min=aamin) attnamtmp = 'valid_min_max' attxttmp = 'no missing value defined' comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, attxttmp' if not execute(comm) then message,'ERR : def extra attr miss val 3, var numero '+nviv+'... stop' endelse if writevalidminmax then begin attnamtmp = 'valid_min' comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, aamin' if not execute(comm) then message,'ERR : def miss val attr min, var numero '+nviv+'... stop' attnamtmp = 'valid_max' comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, aamax' if not execute(comm) then message,'ERR : def miss val attr max, var numero '+nviv+'... stop' endif endif endfor ; -------------------------------------------------------- ; ; Definition des attributs globaux ; ; -------------------------------------------------------- attprod = 0 if n_elements(globattr) ne 0 then begin ; --> on a prescrit des attributs globaux if (size(globattr))[0] ne 1 or (size(globattr))[2] ne 8 then message, 'PB : les global attr doivent etre donne sous forme de struct... stop' nbtagsgb = n_tags(globattr) for igat = 0, nbtagsgb-1 do begin igatst = string(igat, format = '(i2.2)') ss = size(globattr.(igat)) if ss[0] ne 1 or ss[2] ne 8 or n_tags(globattr.(igat)) ne 2 then $ message, 'ERR : au glob attr numero'+igatst+' qui n est pas un structure de 2 elements... stop' gbatn = globattr.(igat).(0) gbatt = globattr.(igat).(1) NCDF_ATTPUT, idout, gbatn, gbatt, /global if gbatn eq 'Production' then attprod = 1 endfor endif if attprod eq 0 then begin producta = systime() NCDF_ATTPUT, idout, 'Production', producta, /GLOBAL endif ; -------------------------------------------------------- ; ; Fin de definition des variables ; ; -------------------------------------------------------- NCDF_CONTROL, idout, /ENDEF ; --> take the open netCDF file out of define mode and into data mode ; -------------------------------------------------------- ; ; Ecriture des variables ; ; -------------------------------------------------------- for inv=0,nbvars-1 do begin nviv=string(inv+1,format='(i2.2)') case arr_struct[inv] of 0: comm = 'NCDF_VARPUT, idout, id'+nviv+', var'+nviv ; --> tablo 1: comm = 'NCDF_VARPUT, idout, id'+nviv+', var'+nviv+'.'+structfd_v ; --> struct else:message,'ERR : ncdf_varput case...' endcase if writeout and inv eq 0 then print,'Writing fields : ' if writeout then print,' '+nama[inv]+'['+listofdimnams[inv]+'] = var'+nviv if not execute(comm) then message,'PB : ncdf_varput final... stop' endfor ; -------------------------------------------------------- ; ; Fermeture fichier netcdf ; ; -------------------------------------------------------- NCDF_CLOSE, idout if writeout then print,'Written to '+ncfile if writeout then print,'------------------------' ; -------------------------------------------------------- ; -------------------------------------------------------- ; -------------------------------------------------------- end ; exemples of var attr : ; ----------------------- ; rain:units = "mm/day" ; rain:valid_min = -32700 ; rain:valid_max = 32700 ; rain:valid_range = -32700, 32700 ; rain:standard_name = "rain1" ; rain:long_name = "monthly precipitation by merging gauge, 5 kinds of satellite estimates (GPI,OPI,SSM/I scattering, SSM/I emission and MSU)" ; rain:title = "monthly precipitation by merging gauge, 5 kinds of satellite estimates (GPI,OPI,SSM/I scattering, SSM/I emission and MSU)" ; rain:add_offset = 31.7f ; rain:scale_factor = 0.001f ; rain:missing_value = -1.f ; rain:lon = "nav_lon" ; rain:lat = "nav_lat" ; exemples of global attr : ; -------------------------- ; ; File_Name : trmm_1d_19980101_19981231_reg0.25.nc ; Model_Name : TRMM 3B42_V6 derived product ; Source_File : ftp://disc2.nascom.nasa.gov/data/TRMM/Gridded/Derived_Products/3B42_V6/Daily/'+iyystr+'/*.bin' ; IDL_Program_Name : zz08_read_plot_row_trmm_precip.pro ; Grid : regular 0.25 degres resolution ; Title : Weekly Topex/ers sea surface anomaly from oct 14th 1992 to feb 13th 2002 ; Associate_file : ... ; Description : ... ; ; exemple de creation fic ncdf avec fcts idl : ; -------------------------------------------- ; ; ; creation du fichier de sortie et ecriture des vars ; idout = NCDF_CREATE(fic+'2',/clobber) ; NCDF_CONTROL, idout, /nofill ; ; ; ; Dimension ; xidout = NCDF_DIMDEF(idout, 'x', nxx) ; yidout = NCDF_DIMDEF(idout, 'y', nyy) ; tidout = NCDF_DIMDEF(idout, 'time_counter', /unlimited) ; ; ; ; Attributs globaux ; NCDF_ATTPUT, idout, 'title', 'Weekly Topex/ers sea surface anomaly from oct 14th 1992 to feb 13th 2002', /GLOBAL ; NCDF_ATTPUT, idout, 'production', 'Clément de Boyer (cdblod@lodyc.jussieu.fr)', /GLOBAL ; ;NCDF_ATTPUT, idout, 'description' $ ; ; , ' ncecat 488 files of Topex/ers data on Indian Ocean and add a time counter', /GLOBAL ; NCDF_ATTPUT, idout, 'associate_file', prev_fic, /GLOBAL ; NCDF_ATTPUT, idout, 'time_stamp', systime(), /GLOBAL ; ; ; ; Def des variables ; id0 = NCDF_VARDEF(idout, 'nav_lon' , [xidout, yidout ], /FLOAT) ; id1 = NCDF_VARDEF(idout, 'nav_lat' , [xidout, yidout ], /FLOAT) ; id2 = NCDF_VARDEF(idout, 'time_counter' , [ tidout], /FLOAT) ; id3 = NCDF_VARDEF(idout, 'sla' , [xidout, yidout, tidout], /FLOAT) ; ; ; ; Attributs variable 0 : lon ; NCDF_ATTPUT, idout, id0, 'units', 'degrees_east' ; NCDF_ATTPUT, idout, id0, 'valid_min', min(lon) ; NCDF_ATTPUT, idout, id0, 'valid_max', max(lon) ; NCDF_ATTPUT, idout, id0, 'long_name', 'Longitude at t-point' ; ; ; ; Attributs variable 1 : lat ; NCDF_ATTPUT, idout, id1, 'units', 'degrees_north' ; NCDF_ATTPUT, idout, id1, 'valid_min', min(lat) ; NCDF_ATTPUT, idout, id1, 'valid_max', max(lat) ; NCDF_ATTPUT, idout, id1, 'long_name', 'Latitude at t-point' ; ; ; ; Attributs variable 2 : ; NCDF_ATTPUT, idout, id2, 'units', origt ; NCDF_ATTPUT, idout, id2, 'calendar','leap' ; NCDF_ATTPUT, idout, id2, 'title', 'Time' ; NCDF_ATTPUT, idout, id2, 'long_name', 'Time axis' ; NCDF_ATTPUT, idout, id2, 'time_origin ', origt ; ; christophe style ; ;ayear=strtrim(string(year(0)),1) ; ;amonth=strtrim(string(month(0),format="(i2.2)"),1) ; ;aday=strtrim(string(day(0),format="(i2.2)"),1) ; ;NCDF_ATTPUT, idout, id3, 'units', 'days since '+ayear+'-'+amonth+'-'+aday+' 00:00:00' ; ;NCDF_ATTPUT, idout, id3, 'calendar', 'gregorian' ; ;NCDF_ATTPUT, idout, id3, 'long_name', 'Time axis' ; ;NCDF_ATTPUT, idout, id3, 'time_origin ', ayear+'-'+b(month(0)-1)+'-'+aday+' 00:00:00' ; ; ; ; Attributs variable 3 : vv ; NCDF_ATTPUT, idout, id3, 'units', 'M' ; NCDF_ATTPUT, idout, id3, 'missing_value',missval ; NCDF_ATTPUT, idout, id3, 'valid_min', min(vv) ; if countnomiss ne 0 then vvmw=vv[vvw] ; NCDF_ATTPUT, idout, id3, 'valid_max', max(vvmw) ; NCDF_ATTPUT, idout, id3, 'long_name', 'sea level anomaly' ; NCDF_ATTPUT, idout, id3, 'short_name', 'sla' ; ; ; ; fin def des variables ; NCDF_CONTROL, idout, /ENDEF ; ; ; ; Ecriture des variables ; NCDF_VARPUT, idout, id0, lon ; la longitude, var 0 ; NCDF_VARPUT, idout, id1, lat ; la latitude, var 1 ; NCDF_VARPUT, idout, id2, ttt ; le time (calendrier), var 2 ; NCDF_VARPUT, idout, id3, vv ; la vv, var 3 ; ; ; ; Fermeture fichier netcdf ; NCDF_CLOSE, idout ; EXPLE de ncdf quickwrite... bof quoi...: ; ; ncfile='!my.nc' ; angle_attr={units:'degrees'} ; wind_attr={units:'m s-1'} ; press_attr={units:'pascals',missing_value:1e10} ; g_attr={units:'m s-2'} ; globattr={source:'My program',version:2} ; ; ncfields = 'pressure[longitude,latitude,time]=p:press_attr; ' $ ; + 'longitude[]=lons:angle_attr; ' $ ; + 'latitude[]=lats:angle_attr; ' $ ; + 'ubar[latitude,time]:wind_attr; ' $ ; + 'year[*time]=yr; ' $ ; + 'g=9.8:g_attr @ globattr' ; ; @ncdf_quickwrite ;