[312] | 1 | ;---------------------------------------------------------------------------------------------- |
---|
| 2 | ; |
---|
| 3 | ; @version |
---|
| 4 | ; $Id$ |
---|
| 5 | ; |
---|
| 6 | ;---------------------------------------------------------------------------------------------- |
---|
| 7 | ; |
---|
| 8 | ; |
---|
| 9 | ; secondary subroutines used in the main subroutine named : write_ncdf.pro |
---|
| 10 | ; ------------------------------------------------------------------------ |
---|
| 11 | ; |
---|
| 12 | ; |
---|
| 13 | ;---------------------------------------------------------------------------------------------- |
---|
| 14 | |
---|
| 15 | ; |
---|
| 16 | ; --- |
---|
| 17 | ; |
---|
| 18 | |
---|
| 19 | ;---------------------------------------------------------------------------------------------- |
---|
| 20 | ; |
---|
| 21 | ; |
---|
| 22 | ; SUBROUTINE (1)/(3) : |
---|
| 23 | ; |
---|
| 24 | ; subroutine utilise ds le cas ou NOT_OUASSALU n est pas active |
---|
| 25 | ; (default) et alors cela sert a uniformiser les dimensions qui sont |
---|
| 26 | ; en dernieres dim de vars en unlimited si une dim de meme taille est |
---|
| 27 | ; definie en unlimited et si eventuellement elles peuvent aussi etre |
---|
| 28 | ; definies comme telles i.e. on privilegie le type unlimited pour les |
---|
| 29 | ; dimensions en fin de var lorsque c''est possible et qu au moins un |
---|
| 30 | ; dim de meme type est demandee en unlimited |
---|
| 31 | ; |
---|
| 32 | ; cf details plus bas... |
---|
| 33 | ; |
---|
[327] | 34 | ;- |
---|
| 35 | pro writenc_unlimdim_update, dnames_imposed, unl_imposed, fmtbase, nviv $ |
---|
| 36 | , iidp1st, nn, dst, iid, SUPERTABU=supertab $ |
---|
| 37 | , DIMSIZESU=dimsizes, UNLIMTABAU=unlimtaba, UNLIMAU=unlima $ |
---|
| 38 | , DIMIDASU=dimidas, NDIMTOTU=ndimtot, DNAMOSSU=dnamoss, DNAMAU=dnama $ |
---|
| 39 | , IMPOSE_DNM_UNLU=impose_dnm_unl |
---|
[312] | 40 | |
---|
| 41 | |
---|
| 42 | ; ------- |
---|
| 43 | |
---|
| 44 | compile_opt idl2, strictarrsubs ; idl2 --> les entiers sont des long par defaut ET [...] obligatoire pour les tablo |
---|
| 45 | ; strictarrsubs --> pas de depassement de tablo |
---|
| 46 | |
---|
| 47 | ; ------- |
---|
| 48 | |
---|
| 49 | ; (1) mise en forme en structures classiques du main prog |
---|
| 50 | |
---|
| 51 | if n_elements(supertab) ne ndimtot then message,'PB : procedure write_ncdf_unlimdim_update init, (dim'+iodp1st+', var'+nviv+')... stop' |
---|
| 52 | for ikd=0,ndimtot-1 do begin |
---|
| 53 | ikdp1st = string(ikd+1,format=fmtbase) |
---|
| 54 | com = 'strd'+ikdp1st+' = writenc_strlc2str(supertab[ikd])' |
---|
| 55 | if not execute(com) then message,'PB : writenc_unlimdim_update, loop1 on dim tot ('+ikdp1st+'), dim '+iidp1st+', var '+nviv+'... stop' |
---|
| 56 | endfor |
---|
| 57 | |
---|
| 58 | ; ------- |
---|
| 59 | |
---|
| 60 | ; (2) traitement des structures de dim existantes, et comparaison a la dim courante (qui est last of var) |
---|
| 61 | |
---|
| 62 | ; --> on est en train de gerer une last dim d une var avec option oneunlim_all_samesizeandlast_unlim=1, |
---|
| 63 | ; i.e. : si une dim est definie en unlim=1 ALORS toutes les dim de meme taille ET last dim definie avant ou |
---|
| 64 | ; apres deviennent identiques a cette dim (ne font plus qu une, selon compatibilite nom de dim ET unlimited impose ou pas) |
---|
| 65 | ; |
---|
| 66 | ; DONC - soit cette dim est unlim=0 --> - soit on a deja une dim meme taille unlimited=1 alors: Si nom+unlim_impose compatibles, |
---|
| 67 | ; on passe notre dim courante a unlim=1 et elle sera assimile a celle qui |
---|
| 68 | ; existe deja avec le meme nom precedent (car meme caracteristiques). Si nom+unlim incompatibles, |
---|
| 69 | ; on va juste creer une nouvelle dim last not unlimited. |
---|
| 70 | ; |
---|
| 71 | ; - soit on a pas deja de dim meme taille et unlim=1, donc cas classique cette dim unlim=0 est |
---|
| 72 | ; creee ou assimilee a une existante si nom et taille compatibles |
---|
| 73 | ; |
---|
| 74 | ; - soit cette dim est unlim=1 --> - soit une dim unlim=1 existe deja, alors elle sera assimilee a celle-ci si noms compatibles |
---|
| 75 | ; |
---|
| 76 | ; - soit une dim unlim=1 existe pas deja, alors cas plus complexe : pour eventuellement |
---|
| 77 | ; les mettre a jour, on doit parcourir les dimensions de meme taille pour separer les variables |
---|
| 78 | ; dont la dim en question est la last, et les variables dont la dim est not la last |
---|
| 79 | ; - soit on n a pas de variables qui ont une dim de meme taille en last dim, alors pas de mise |
---|
| 80 | ; a jour a faire, on va creer une nouvelle dim, qui sera la dim unlim=1 du fichier |
---|
| 81 | ; - soit on a des variable(s) avec une dim last de meme taille unlim=0 ET nomdim compatible, |
---|
| 82 | ; DONC on doit mettre a jour les last dim(s) de ces variables, 3 cas: |
---|
| 83 | ; - une dim (unlim=0) contient que des vars qui en dependent en last dim et meme taille |
---|
| 84 | ; que dim courante --> alors selon compatibilite pour changer unlim et nomdim, on regroupe |
---|
| 85 | ; les vars qui ont last dim same size sous cette meme dim qui devient unlim=1 et a laquelle |
---|
| 86 | ; la dim courante sera assimilee |
---|
| 87 | ; - aucune dim contient que des vars en last dim et meme taille que dim courante --> alors |
---|
| 88 | ; on cree des ICI une NOUVELLE dim qui est identique a la dim courante pour que celle-ci y |
---|
| 89 | ; assimilee (pas creer 2 fois meme dim) ET qui contient les vars avec last dim qui sont |
---|
| 90 | ; compatibles en unlim dim et nomdim |
---|
| 91 | ; - n=plus de une dim (unlim=0) contient que des vars en last dim et meme taille que dim |
---|
| 92 | ; courante --> il faudrait supprimer n-1 dim pour les assimiler a l une d entre elles... |
---|
| 93 | ; en fait cela veut dire que pas assez de contraintes ont ete donne en entree aux dim |
---|
| 94 | ; donc WARNING pour dire qu en ajoutant des contraintes pour forcer dim unlim=0 ou 1 ou bien |
---|
| 95 | ; forcer le nom de la dim, alors on levera l ambiguite. |
---|
| 96 | |
---|
| 97 | |
---|
| 98 | |
---|
| 99 | if unlima eq 0 then begin |
---|
| 100 | |
---|
| 101 | ; si on a une last dim not unlim, on check si des dim meme taille unlim1 qui existent pour les utiliser as same dim |
---|
| 102 | ; --> si on trouve une dim meme taille et unlim=1 et nom ok alors on met la dim nbdimvv[inv] en unlim aussi |
---|
| 103 | |
---|
| 104 | aaddo = where(dimsizes - nn eq 0 and unlimtaba eq 1) |
---|
| 105 | if n_elements(aaddo) ne 1 then message,'PB : on a 1 ou 0 dim en unlimited (a), pas plus... stop' |
---|
| 106 | |
---|
| 107 | if aaddo[0] ne -1 then begin ; on a une dims unlim=1 deja definie et de meme taille |
---|
| 108 | |
---|
| 109 | strnbd = string(aaddo[0]+1,format=fmtbase) |
---|
| 110 | com = 'strdtmp = strd'+strnbd |
---|
| 111 | if not execute(com) then message, 'ERR : attrib strdtmp -1 (dim'+iodp1st+', var'+nviv+')...stop' |
---|
| 112 | samnamokchgunlim = 0 ; peu importe cette valeur car si elle change pas c parce que dnames_imposed=0 donc condition apres deja ok |
---|
| 113 | if dnames_imposed eq 1 then if strdtmp.nomdim eq dnama then samnamokchgunlim=1 else samnamokchgunlim=0 |
---|
| 114 | if (unl_imposed eq 0) and (dnames_imposed eq 0 or samnamokchgunlim) $ |
---|
| 115 | 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 |
---|
| 116 | |
---|
| 117 | endif |
---|
| 118 | |
---|
| 119 | endif else begin ; unlima = 1 --> cette last dim de la var est unlim=1 et donc unl_imposed = 1 aussi |
---|
| 120 | |
---|
| 121 | aaddo = where(dimsizes - nn eq 0 and unlimtaba eq 1) |
---|
| 122 | if n_elements(aaddo) ne 1 then message,'PB : on a 1 ou 0 dim en unlimited (b), pas plus... stop' |
---|
| 123 | |
---|
| 124 | 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...) |
---|
| 125 | ; on a pas de dim meme taille avec unlim=1, donc on cherche si on a des last dims de meme taille |
---|
| 126 | ; pour les mettre a jour question var et les rendre unlim=1 si possible ou creer un new dim unlim sinon |
---|
| 127 | 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 !!!! |
---|
| 128 | |
---|
| 129 | if aabb[0] ne -1 then begin |
---|
| 130 | |
---|
| 131 | nbsdd = n_elements(aabb) |
---|
| 132 | for iod=0,nbsdd-1 do begin ; on parcourt les dim de meme taille pr separer last dim ET not last dim |
---|
| 133 | iodp1st=string(iod+1,format=fmtbase) |
---|
| 134 | strnbd = string(aabb[iod]+1,format=fmtbase) |
---|
| 135 | com = 'strdtmp = strd'+strnbd |
---|
| 136 | if not execute(com) then message, 'ERR : attrib strdtmp 0a (dim'+iodp1st+', var'+nviv+')...stop' |
---|
| 137 | ; que si on peut modifier leur dim name |
---|
| 138 | IF dnames_imposed EQ 1 THEN if impose_dnm_unl[0,aabb[iod]] eq 1 and strdtmp.nomdim ne dnama then CONTINUE |
---|
| 139 | strvarsdim = strdtmp.vardep_ndim |
---|
| 140 | vnmarr = strvarsdim.(0) |
---|
| 141 | ddparr = strvarsdim.(1) |
---|
| 142 | nvararr = strvarsdim.(2) |
---|
| 143 | lastad = strvarsdim.(3) |
---|
| 144 | for iij=0,n_elements(nvararr)-1 do begin ;loop on var which depend on dim |
---|
| 145 | if lastad[iij] eq 1 then begin ; les var ou la dim est une last dim |
---|
| 146 | if n_elements(lasdd) eq 0 then $ |
---|
| 147 | lasdd = [ { u:aabb[iod]+1,v:[vnmarr[iij]],w:[ddparr[iij]] $ |
---|
| 148 | ,x:[nvararr[iij]],y:[lastad[iij]] } ] $ |
---|
| 149 | else $ |
---|
| 150 | lasdd = [ lasdd, { u:aabb[iod]+1,v:[vnmarr[iij]],w:[ddparr[iij]] $ |
---|
| 151 | ,x:[nvararr[iij]],y:[lastad[iij]] } ] |
---|
| 152 | endif else begin ; vars ou la dim est pas un last dim |
---|
| 153 | if n_elements(notlasdd) eq 0 then $ |
---|
| 154 | notlasdd = [ { u:aabb[iod]+1,v:[vnmarr[iij]],w:[ddparr[iij]] $ |
---|
| 155 | ,x:[nvararr[iij]],y:[lastad[iij]] } ] $ |
---|
| 156 | else $ |
---|
| 157 | notlasdd = [ notlasdd, { u:aabb[iod]+1,v:[vnmarr[iij]],w:[ddparr[iij]] $ |
---|
| 158 | ,x:[nvararr[iij]],y:[lastad[iij]] } ] |
---|
| 159 | endelse |
---|
| 160 | endfor |
---|
| 161 | endfor |
---|
| 162 | |
---|
| 163 | 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 |
---|
| 164 | |
---|
| 165 | listdwlast = lasdd[*].(0) |
---|
| 166 | nnndz=0 |
---|
| 167 | dimwzonlylast=-1 & zorglub=temporary(dimwzonlylast) |
---|
| 168 | |
---|
| 169 | dimdone = [-1] |
---|
| 170 | FOR iad = 0, n_elements(listdwlast)-1 DO BEGIN ; on parcourt les dims de listdwlast, mais que une fois par dim size |
---|
| 171 | IF (where(dimdone eq listdwlast[iad]))[0] EQ -1 THEN BEGIN ; si cette dim est pas encore faite, on la fait |
---|
| 172 | strnbdo = string(listdwlast[iad], format = fmtbase) |
---|
| 173 | com = 'strdtmp = strd'+strnbdo |
---|
| 174 | if not execute(com) then message, $ |
---|
| 175 | 'ERR : attrib strdtmp 0b (dim'+strnbdo+', var'+nviv+')...stop' |
---|
| 176 | ;print,'hello ',strdtmp.vardep_ndim.(3) |
---|
| 177 | if (where(strdtmp.vardep_ndim.(3) eq 0))[0] eq -1 and impose_dnm_unl[1, listdwlast[iad]-1] eq 0 then begin |
---|
| 178 | ; pour cette dim: que des var avec last ET son unlim est pas imposed: ok, on peut utiliser cette dim pour update |
---|
| 179 | dimwzonlylast = listdwlast[iad] |
---|
| 180 | nnndz = nnndz+1 |
---|
| 181 | endif |
---|
| 182 | IF iad EQ 0 THEN dimdone = [listdwlast[iad]] ELSE dimdone = [dimdone, listdwlast[iad]] |
---|
| 183 | endif |
---|
| 184 | ENDFOR |
---|
| 185 | |
---|
| 186 | updatevara=0 |
---|
| 187 | |
---|
| 188 | ;if inv eq 2 and iid eq 0 then stop |
---|
| 189 | ;if iidp1st eq '01' and nviv eq '03' then stop |
---|
| 190 | |
---|
| 191 | case nnndz of |
---|
| 192 | 1:begin ; 1 dim contient que des var avec last dim --> on s en sert pour update ok |
---|
| 193 | ; |
---|
| 194 | ; on ajoute ces vars (si plus de 1 existe) qui ont dim unlim a la struct de dim choisie |
---|
| 195 | ; |
---|
| 196 | strnbdu = string(dimwzonlylast,format=fmtbase) |
---|
| 197 | com = 'strdtmp1 = strd'+strnbdu |
---|
| 198 | if not execute(com) then message, $ |
---|
| 199 | 'ERR : attrib strdtmp 0c (dim'+iidp1st+', var'+nviv+')...stop' |
---|
| 200 | uubb = where(lasdd[*].(0) ne dimwzonlylast) ; autre dim avec var last=1 ? si oui update: |
---|
| 201 | if uubb[0] ne -1 then begin |
---|
| 202 | updatevara=1 |
---|
| 203 | bbvdnd = { a:[strdtmp1.vardep_ndim.(0),lasdd[uubb].(1) ] $ |
---|
| 204 | ,b:[strdtmp1.vardep_ndim.(1),lasdd[uubb].(2) ] $ |
---|
| 205 | ,c:[strdtmp1.vardep_ndim.(2),lasdd[uubb].(3) ] $ |
---|
| 206 | ,d:[strdtmp1.vardep_ndim.(3),lasdd[uubb].(4) ] } |
---|
| 207 | endif else bbvdnd = strdtmp1.vardep_ndim ; ici pas d update var a faire (updatevara=0) |
---|
| 208 | unlimtaba[dimwzonlylast-1] = 1 ; update de unlim !!! |
---|
| 209 | ;si dnames_imposed=1, on a selectionne des dims de meme nom ou nom non impose, donc nomdim=dnama[iid], |
---|
| 210 | ;si dnames_imposed=0, le nom de notre dim courante peut changer pour assimile a ancien nomdim dnamoss[dimwzonlylast-1] |
---|
| 211 | ; -> ok gere par dnames_imposed... continue plus haut |
---|
| 212 | if n_elements(dnama) ne 0 then dnamoss[dimwzonlylast-1] = dnama[iid] |
---|
| 213 | strdtmp2={ dimid:strdtmp1.dimid,taille:strdtmp1.taille,nomdim:dnamoss[dimwzonlylast-1] $ |
---|
| 214 | ,unlimz:unlimtaba[dimwzonlylast-1],vardep_ndim:bbvdnd} ; on passe en unlim=1 ICI |
---|
| 215 | com='strd'+strnbdu+'=strdtmp2' |
---|
| 216 | if not execute(com) then message, $ |
---|
| 217 | 'ERR : update strd unlim dim '+strnbdu+', loop: dim'+iidp1st+', var'+nviv+'... stop 0' |
---|
| 218 | strdtmp1 = 0 & strdtmp2 = 0 |
---|
| 219 | end |
---|
| 220 | 0:begin |
---|
| 221 | ; aucune dim ne contient que des vars en last dim --> on doit cree une new dim |
---|
| 222 | ; --> la dim iidp1st = nbdimvv sera donc pas creee mais assimilee a celle-ci |
---|
| 223 | ; on ne cree bien qu une seule dim au max par passage sur indice iid |
---|
| 224 | |
---|
| 225 | ; pour creer nouvelle dim a laquelle la courante sera assimilee, il faut que les variables |
---|
| 226 | ; ramenees dedans, proviennent de dim qui le permettent, vis a vis de nom de dim imposee et/ou unlim impose |
---|
| 227 | noka = 0 |
---|
| 228 | for iud=0,n_elements(lasdd)-1 do begin |
---|
| 229 | 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 |
---|
| 230 | ndst = string(ndimtot, format = fmtbase) |
---|
| 231 | if n_elements(dnama) ne 0 then dnamur = dnama[iid] else dnamur = dst+ndst |
---|
| 232 | if ( ( impose_dnm_unl[0, lasdd[iud].(0)-1 ] eq 0 ) or ( dnamur eq dnamoss[lasdd[iud].(0) -1]) ) then begin |
---|
| 233 | if noka eq 0 then begin |
---|
| 234 | lasddoka = [lasdd[iud]] |
---|
| 235 | listdwlastoka = [lasdd[iud].(0)] |
---|
| 236 | endif else begin |
---|
| 237 | lasddoka = [lasddoka,lasdd[iud]] |
---|
| 238 | listdwlastoka = [listdwlastoka,lasdd[iud].(0)] |
---|
| 239 | endelse |
---|
| 240 | noka = noka + 1 |
---|
| 241 | endif else begin |
---|
| 242 | if n_elements(notlasddoka) eq 0 then begin |
---|
| 243 | if n_elements(notlasdd) eq 0 then notlasddoka = [lasdd[iud]] $ |
---|
| 244 | else notlasddoka = [notlasdd, lasdd[iud]] |
---|
| 245 | endif else notlasddoka = [notlasddoka, lasdd[iud]] |
---|
| 246 | endelse |
---|
| 247 | endif |
---|
| 248 | endfor |
---|
| 249 | if noka ne 0 then begin |
---|
| 250 | updatevara=1 |
---|
| 251 | ndimtot = ndimtot+1 |
---|
| 252 | ndst = string(ndimtot, format = fmtbase) |
---|
| 253 | dimsizes = [dimsizes, nn] |
---|
| 254 | dimidas = [dimidas, dst+ndst] |
---|
| 255 | lasto=1 |
---|
| 256 | unlimtaba = [unlimtaba,unlima] ; rappel : unlima =1 |
---|
| 257 | if n_elements(dnama) ne 0 then dnamoss = [dnamoss, dnama[iid]] else dnamoss = [dnamoss, dimidas[ndimtot-1]] |
---|
| 258 | impose_dnm_unl = [[impose_dnm_unl],[dnames_imposed,unl_imposed]] ; tablo: ix=2, jy=ndimtot |
---|
| 259 | ddvdnd = { a:[lasddoka[*].(1) ] $ |
---|
| 260 | ,b:[lasddoka[*].(2) ] $ |
---|
| 261 | ,c:[lasddoka[*].(3) ] $ |
---|
| 262 | ,d:[lasddoka[*].(4) ] } |
---|
| 263 | com = 'strd'+ndst+' = { ' $ |
---|
| 264 | +' dimid:dimidas[ndimtot-1],taille:nn,nomdim:dnamoss[ndimtot-1],unlimz:unlimtaba[ndimtot-1]' $ |
---|
| 265 | +',vardep_ndim:ddvdnd } ' |
---|
| 266 | if not execute(com) then message, 'ERR : a la def (3) de la structure de dim' $ |
---|
| 267 | +iidp1st+', var'+nviv+'... stop' |
---|
| 268 | endif ; else aucune last var de dim est ok pour aller ds la nouvelle dim creable... elle se creera toute seule apres |
---|
| 269 | end |
---|
| 270 | else:begin |
---|
| 271 | print, ' *** WARNING !!! on trouve 2 dims ou plus, que l on peut mettre en unlimited (assimilees a la dim ' $ |
---|
| 272 | +'unlimited demandee)... pour ne pas choisir ou supprimer une dim, on ne change aucune dim en unlimited. ' $ |
---|
| 273 | +' --> Pour lever l''ambiguite si besoin, utiliser les champs unlim et dnames pour imposer des noms ' $ |
---|
| 274 | +'et carateristiques de dimensions et donner plus de contraintes pour la construction du netcdf (ou bien ' $ |
---|
| 275 | +'activer le mot cle /NOT_OUASSALU pour ne pas uniformiser les last dim des vars a unlimited dim).' |
---|
| 276 | ;message, 'PB Z : on ne peut avoir que 0 ou max 1 dim avec que des var lasto ' $ |
---|
| 277 | ; +'(dim'+iidp1st+', var'+nviv+')...stop' |
---|
| 278 | end |
---|
| 279 | endcase |
---|
| 280 | ; |
---|
| 281 | ; on doit egalement enlever ces vars des struct de dim ou on les a prises |
---|
| 282 | ; |
---|
| 283 | if updatevara eq 1 then begin |
---|
| 284 | |
---|
| 285 | if nnndz eq 0 then begin |
---|
| 286 | listdwlast = listdwlastoka |
---|
| 287 | notlasdd = notlasddoka |
---|
| 288 | endif |
---|
| 289 | |
---|
| 290 | dimdone = [-1] |
---|
| 291 | FOR iad = 0, n_elements(listdwlast)-1 DO BEGIN ; on parcourt les dims de listdwlast, mais que une fois par dim size |
---|
| 292 | IF (where(dimdone eq listdwlast[iad]))[0] EQ -1 THEN BEGIN ; si cette dim est pas encore faite, on la fait |
---|
| 293 | if nnndz eq 1 then if listdwlast[iad] eq dimwzonlylast then continue ;on saute dimwz si exist |
---|
| 294 | strnbdv = string(listdwlast[iad],format=fmtbase) |
---|
| 295 | com = 'strdtmp1 = strd'+strnbdv |
---|
| 296 | if not execute(com) then message, $ |
---|
| 297 | 'ERR : attrib strdtmp 0d dim loc'+strnbdv+' (dim'+iidp1st+', var'+nviv+')...stop' |
---|
| 298 | if n_elements(notlasdd) ne 0 then begin |
---|
| 299 | oobb = where(notlasdd[*].(0) eq listdwlast[iad]) ; dim de notlast concernee |
---|
| 300 | if oobb[0] eq -1 then message,'PB : 0 ou 1 max dim wz only last var ' $ |
---|
| 301 | +'dim loc'+istrnbdv+' (dim'+iidp1st+', var'+nviv+')...stop a PB Z expected' |
---|
| 302 | ccvdnd = { a:[ notlasdd[oobb].(1) ] $ |
---|
| 303 | ,b:[ notlasdd[oobb].(2) ] $ |
---|
| 304 | ,c:[ notlasdd[oobb].(3) ] $ |
---|
| 305 | ,d:[ notlasdd[oobb].(4) ] } |
---|
| 306 | strdtmp2={ dimid:strdtmp1.dimid,taille:strdtmp1.taille,nomdim:strdtmp1.nomdim $ |
---|
| 307 | ,unlimz:strdtmp1.unlimz,vardep_ndim:ccvdnd} |
---|
| 308 | com='strd'+strnbdv+'=strdtmp2' |
---|
| 309 | if not execute(com) then message, 'ERR : update strd unlim, dim loc'+strnbdv $ |
---|
| 310 | +', loop: dim'+iidp1st+', var'+nviv+'... stop 1' |
---|
| 311 | strdtmp1 = 0 & strdtmp2 = 0 |
---|
| 312 | ENDIF |
---|
| 313 | IF iad EQ 0 THEN dimdone = [listdwlast[iad]] ELSE dimdone = [dimdone, listdwlast[iad]] |
---|
| 314 | ENDIF |
---|
| 315 | endfor |
---|
| 316 | |
---|
| 317 | endif ; else pas besoin de faire update sur les var car on a juste mis unlim a 1 ds dimwzonlylas |
---|
| 318 | |
---|
| 319 | endif ; else... on n a pas de dim meme taille dont une var depend en last dim --> on va creer new dim |
---|
| 320 | |
---|
| 321 | endif ; else... pas de dim deja definie et de meme taille, donc on va creer une new dim |
---|
| 322 | |
---|
| 323 | 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 |
---|
| 324 | |
---|
| 325 | strnbd = string(aaddo[0]+1,format=fmtbase) |
---|
| 326 | com = 'strdtmp = strd'+strnbd |
---|
| 327 | if not execute(com) then message, 'ERR : attrib strdtmp 0d (dim'+iodp1st+', var'+nviv+')...stop' |
---|
[364] | 328 | if dnames_imposed eq 1 then if not (strdtmp.nomdim eq dnama[n_elements(dnama)-1]) then $ |
---|
[312] | 329 | message,'PB : on specifie 2 dimensions unlimited avec 2 noms differents... impossible... stop' |
---|
| 330 | |
---|
| 331 | endelse |
---|
| 332 | |
---|
| 333 | endelse |
---|
| 334 | |
---|
| 335 | ;print,'d',inv,unlima |
---|
| 336 | |
---|
| 337 | ; ------- |
---|
| 338 | |
---|
| 339 | ; (3) re-mise en forme en supertab pour passer au prog principal |
---|
| 340 | |
---|
| 341 | for ikd=0,ndimtot-1 do begin ; loop on dims pour mettre les champs vardep_ndim des struc dim en liste chainee |
---|
| 342 | ikdp1st = string(ikd+1,format=fmtbase) |
---|
| 343 | com = 'strdlc = writenc_str2strlc(strd'+ikdp1st+')' |
---|
| 344 | if not execute(com) then message,'PB : writenc_unlimdim_update loop2 on dim tot ('+ikdp1st+'), dim '+iidp1st+', var '+nviv+'... stop' |
---|
| 345 | if ikd eq 0 then supertab = [strdlc] else supertab = [supertab, strdlc] |
---|
| 346 | endfor ; on obtient ici supertab = [strd01lc ,strd02lc ....] |
---|
| 347 | |
---|
| 348 | end |
---|
| 349 | |
---|
| 350 | ;---------------------------------------------------------------------------------------------- |
---|
| 351 | |
---|
| 352 | |
---|
| 353 | ; |
---|
[327] | 354 | ;+ |
---|
[312] | 355 | ; SUBROUTINE (2)/(3) : |
---|
| 356 | ; |
---|
| 357 | ; on remplace la 4ieme structure de structa par une liste chainee afin |
---|
| 358 | ; d uniformaiser les format de strd (cf prog write_ncdf) pour les |
---|
| 359 | ; passer facilement en argument au sous-prog writenc_unlimdim_update, sous forme de tablo de structures de |
---|
| 360 | ; meme type !!!! (utilise si writenc_unlimdim_update est utilise i.e. dans le cas ou la cle NOT_OUASSALU |
---|
| 361 | ; est pas active, i.e. cas par defaut) |
---|
| 362 | ; |
---|
[327] | 363 | ;- |
---|
[312] | 364 | function writenc_str2strlc, structa |
---|
| 365 | |
---|
| 366 | ; -------- |
---|
| 367 | |
---|
| 368 | strdtmp = structa |
---|
| 369 | strvarsdim = strdtmp.vardep_ndim |
---|
| 370 | |
---|
| 371 | vnmarr = strvarsdim.(0) |
---|
| 372 | ddparr = strvarsdim.(1) |
---|
| 373 | nvararr = strvarsdim.(2) |
---|
| 374 | lastad = strvarsdim.(3) |
---|
| 375 | |
---|
| 376 | nvardepa = n_elements(lastad) |
---|
| 377 | |
---|
| 378 | if nvardepa lt 1 then message,'PB : aucune var ne depend de cette dim... impossible... stop' |
---|
| 379 | |
---|
| 380 | ; Create an anonymous strucutre to contain list elements. Note that |
---|
| 381 | ; the next field is initialized to be a null pointer. |
---|
| 382 | |
---|
| 383 | llistvofd01 = {vname:'', numdimdep:0, nvar:0, dlast:0, next:ptr_new()} |
---|
| 384 | |
---|
| 385 | if ptr_valid(fst_llistvofd01) then ptr_free,fst_llistvofd01 |
---|
| 386 | |
---|
| 387 | first_varsd01 = ptr_new(llistvofd01) |
---|
| 388 | |
---|
| 389 | current = first_varsd01 |
---|
| 390 | |
---|
| 391 | for iidv=0,nvardepa-1 do begin |
---|
| 392 | |
---|
| 393 | next = ptr_new({vname:'', numdimdep:0, nvar:0, dlast:0, next:ptr_new()}) |
---|
| 394 | |
---|
| 395 | ; set the name field of 'current' to the input string. |
---|
| 396 | |
---|
| 397 | (*current).vname = vnmarr[iidv] |
---|
| 398 | (*current).numdimdep = ddparr[iidv] |
---|
| 399 | (*current).nvar = nvararr[iidv] |
---|
| 400 | (*current).dlast = lastad[iidv] |
---|
| 401 | |
---|
| 402 | ; prepare the next field of 'current' to the pointer to the next list element. |
---|
| 403 | |
---|
| 404 | (*current).next = next |
---|
| 405 | |
---|
| 406 | ; copy the 'current' pointer to 'last' |
---|
| 407 | |
---|
| 408 | last = current |
---|
| 409 | |
---|
| 410 | ; make 'current' the next pointer. |
---|
| 411 | |
---|
| 412 | current = next |
---|
| 413 | |
---|
| 414 | endfor |
---|
| 415 | |
---|
| 416 | if ptr_valid(next) then ptr_free, next |
---|
| 417 | |
---|
| 418 | ; Set the _next_ field of the last element to the null pointer. |
---|
| 419 | |
---|
| 420 | if ptr_valid(last) then (*last).next = ptr_new() |
---|
| 421 | |
---|
| 422 | ; -------- |
---|
| 423 | |
---|
| 424 | strdout_ptr = { dimid:strdtmp.dimid, taille: strdtmp.taille , nomdim: strdtmp.nomdim , unlimz: strdtmp.unlimz $ |
---|
| 425 | ,vardep_ptr : first_varsd01 } |
---|
| 426 | |
---|
| 427 | return,strdout_ptr |
---|
| 428 | |
---|
| 429 | end |
---|
| 430 | |
---|
[327] | 431 | ;+ |
---|
[312] | 432 | ; |
---|
| 433 | ; SUBROUTINE (3)/(3) : |
---|
| 434 | ; |
---|
| 435 | ; convertit une structure contenant une liste |
---|
| 436 | ; chainee en structure classique utilisee par le main prog (utile pour |
---|
| 437 | ; passer ces structures en argument au sous-prog |
---|
| 438 | ; writenc_unlimdim_update, i.e. dans le cas ou la cle NOT_OUASSALU n |
---|
| 439 | ; est pas activee, i.e. cas par defaut) |
---|
| 440 | ; |
---|
| 441 | ; |
---|
[327] | 442 | ;- |
---|
[312] | 443 | function writenc_strlc2str, strwlist |
---|
| 444 | |
---|
| 445 | ptr_firstvars = strwlist.vardep_ptr |
---|
| 446 | |
---|
| 447 | ; create a second pointer to the heap variable pointed at by 'first' |
---|
| 448 | current = ptr_firstvars |
---|
| 449 | |
---|
| 450 | invdp = 0 |
---|
| 451 | |
---|
| 452 | while ptr_valid(current) do begin |
---|
| 453 | |
---|
| 454 | if invdp eq 0 then begin |
---|
| 455 | vnmarr = [ (*current).(0) ] |
---|
| 456 | ddparr = [ (*current).(1) ] |
---|
| 457 | nvararr = [ (*current).(2) ] |
---|
| 458 | lastad = [ (*current).(3) ] |
---|
| 459 | endif else begin |
---|
| 460 | vnmarr = [ vnmarr, (*current).(0) ] |
---|
| 461 | ddparr = [ ddparr, (*current).(1) ] |
---|
| 462 | nvararr = [ nvararr, (*current).(2) ] |
---|
| 463 | lastad = [ lastad, (*current).(3) ] |
---|
| 464 | endelse |
---|
| 465 | |
---|
| 466 | ; set 'current' equal to the pointer in its own next field. |
---|
| 467 | current = (*current).next |
---|
| 468 | |
---|
| 469 | invdp = invdp + 1 |
---|
| 470 | |
---|
| 471 | endwhile |
---|
| 472 | |
---|
| 473 | if invdp eq 0 then message,'PB : aucune var ne depend de cette dim... impossible 2 ... stop' |
---|
| 474 | |
---|
| 475 | strwolist = { dimid:strwlist.dimid, taille: strwlist.taille , nomdim: strwlist.nomdim , unlimz: strwlist.unlimz $ |
---|
| 476 | ,vardep_ndim: {a:vnmarr,b:ddparr,c:nvararr,d:lastad}} |
---|
| 477 | |
---|
| 478 | return, strwolist |
---|
| 479 | |
---|
| 480 | end |
---|
| 481 | |
---|
| 482 | ;---------------------------------------------------------------------------------------------- |
---|
| 483 | ; |
---|
| 484 | ; |
---|
| 485 | ; END SECONDARY SUBROUTINES |
---|
| 486 | ; ------------------------- |
---|
| 487 | ; |
---|
| 488 | ; |
---|
| 489 | ;---------------------------------------------------------------------------------------------- |
---|
| 490 | |
---|
| 491 | |
---|
| 492 | |
---|
| 493 | ; ... ... .... ... .. . .. . |
---|
| 494 | |
---|
| 495 | |
---|
| 496 | |
---|
| 497 | ;---------------------------------------------------------------------------------------------- |
---|
| 498 | ; |
---|
| 499 | ; |
---|
| 500 | ; MAIN SUBROUTINE |
---|
| 501 | ; --------------- |
---|
| 502 | ; |
---|
| 503 | ;---------------------------------------------------------------------------------------------- |
---|
| 504 | ;+ |
---|
| 505 | ; |
---|
| 506 | ; |
---|
| 507 | ; pro write_ncdf, var01,var02,var03,var04,var05,var06,var07,var08,var09,var10 $ |
---|
| 508 | ; ,var11,var12,var13,var14,var15,var16,var17,var18,var19,var20 $ |
---|
| 509 | ; ,var21,var22,var23,var24,var25,var26,var27,var28,var29,var30 $ |
---|
| 510 | ; ,FILENAME=filename $ |
---|
| 511 | ; ,GLOBATTR=globattr $ |
---|
| 512 | ; ,VARNAME=namevquick |
---|
| 513 | ; |
---|
| 514 | ; --------------------------------------------------------------------------------------------- |
---|
| 515 | ; |
---|
| 516 | ; @file_comments |
---|
| 517 | ; Construct a netcdf file containing up to 30 variables of any |
---|
| 518 | ; dimension (limited to 99 for now) with any attributes specified. |
---|
| 519 | ; We use structures to pass the fields (var and their attributes, and |
---|
| 520 | ; global attr) |
---|
| 521 | ; |
---|
[378] | 522 | ; @returns |
---|
[312] | 523 | ; a netcdf file containing the variable in the format specified |
---|
| 524 | ; through keywords and variables |
---|
| 525 | ; |
---|
| 526 | ; @param var01 {in}{required} |
---|
| 527 | ; - It can be simply a variable (scalar or array, of type : |
---|
| 528 | ; byte,int,long,float,double or string), or a structure |
---|
| 529 | ; containing the variable and its properties and attributes. At |
---|
| 530 | ; least one variable must be specified. |
---|
| 531 | ; - If a structure is given it should be of the following form (exple): |
---|
| 532 | ; vv1 = {var:xaxis,name:'nav_lon',dname:'x',at0:{a:'units',b:'degrees_east'},at1:{a:'title',b:'longitude'}} |
---|
| 533 | ; vv4 = {var:rain, name:'rain', unlim:1, dname:['x','y','t'],at0:{a:'units',b:'mm/day'},at4:{a:'missing_value',b:-9999.}} |
---|
| 534 | ; Namely, the if vv1 is a structure it MUST follow the following points: |
---|
| 535 | ; - attributes fields for the variable (at0,at1...) MUST be the last fields of the vv1 structure |
---|
| 536 | ; and name of those fields (at0,at1...) are not important. |
---|
| 537 | ; - attributes MUST themselves be given in the form of a 2 field structure, containing the |
---|
| 538 | ; name of the attribute (a string), and its value (can be any type as the ones of variable) |
---|
| 539 | ; - order of the first fields is not important but they MUST have the names: |
---|
| 540 | ; 'var' : for the variable (scalar or array, of type:byte,int,long,float,double or string) |
---|
| 541 | ; 'name' : for its name (a string), default value is var01,var02 etc... |
---|
| 542 | ; 'unlim' : = 1 to specify that the last dim of the var must be UNLIMITED, =0 or not specified otherwise |
---|
| 543 | ; 'dname' : to give the names of the dimensions of the variable, in the same order as the var dimensions. |
---|
| 544 | ; it is an array of string of dim = nbre de dim de la var. default is d01,d02 etc... |
---|
| 545 | ; - the field 'var' MUST be there (a variable) but every others are optional |
---|
| 546 | ; - if a missing value exists for the variable and one wants to specify it, it MUST be specified |
---|
| 547 | ; somewhere in one of the attributes and the name of this attribute MUST be 'missing_value' (to be taken |
---|
| 548 | ; into account in the computing of the min-max of the variable), missing_value being not case sensitive |
---|
| 549 | ; (MISSING_VALUE is also ok) |
---|
| 550 | ; |
---|
| 551 | ; @param var02, var03, .... var30 {in}{optional} |
---|
| 552 | ; All the variables/attributes to be written in the netcdf file, in |
---|
| 553 | ; the same way as the var01 (cf info above) |
---|
| 554 | ; |
---|
| 555 | ; @keyword filename {in}{optional} |
---|
| 556 | ; - a string giving the filename (including the path of the file) |
---|
| 557 | ; - if not specified, it is set to iodir+'writenclem.nc' |
---|
| 558 | ; |
---|
| 559 | ; @keyword globattr {in}{optional} |
---|
| 560 | ; - a structure containing the global attributes for the |
---|
| 561 | ; file. Similarly as for the attributes of the variable, this |
---|
| 562 | ; structure contains 2-fields structures which are the global |
---|
| 563 | ; attribute (first their name and second their value) |
---|
| 564 | ; exple: glbatt = {gb1:{a:'Grid',b:'regular 0.25'},gb2:{a:'Production',b:'clem'+systime()}} |
---|
| 565 | ; - if not specified in globattr, default case set production='date of |
---|
| 566 | ; day' as a global attribute |
---|
| 567 | ; |
---|
[378] | 568 | ; @keyword VARNAME {in}{optional} |
---|
[312] | 569 | ; - an array of char, same number of elements as the number of given |
---|
| 570 | ; var |
---|
| 571 | ; - if specified, it gives the names of the variables as an array for |
---|
| 572 | ; the default name values (if one of the var is structure and also has |
---|
| 573 | ; the name field given, then the latter will be the one chosen and not namevquick) |
---|
| 574 | ; |
---|
| 575 | ; @uses |
---|
[371] | 576 | ; <pro>cm_general</pro> for iodir variable |
---|
[312] | 577 | ; |
---|
| 578 | ; @examples |
---|
| 579 | ; |
---|
| 580 | ; 1) |
---|
[371] | 581 | ; IDL> write_ncdf, vvsst, btoa |
---|
[312] | 582 | ; |
---|
| 583 | ; 2) |
---|
[371] | 584 | ; IDL> write_ncdf, a1, {var:a2,name:'rain'}, ['up','down','fix'], a4, a5, {var:a6,unlim:1,name:'sst',dname:['x','y','z','time']} |
---|
[312] | 585 | ; |
---|
| 586 | ; 3) |
---|
[371] | 587 | ; IDL> write_ncdf,v031tr,msf031dn,msf031up,v031,vmaskloc,btoa,runame,titplo1,vargrid,nytt $ |
---|
[312] | 588 | ; ,varname = ['v031tr','msf031dn','msf031up','v031','vmaskloc','btoa','runame','titplo1','vargrid','nytt'] $ |
---|
| 589 | ; ,filename = iodir+'IDL_DATA/'+'waza3.nc' |
---|
| 590 | ; |
---|
| 591 | ; 4) |
---|
[371] | 592 | ; IDL> fileoutnc = iodir+'OBS/TRMM/'+'trmm_1d_'+iyystr+'0101_'+iyystr+'1231_reg0.25.nc' |
---|
| 593 | ; IDL> vv1 = {var:xaxis,name:'nav_lon',dname:'x',at1:{a:'units',b:'degrees_east'},at2:{a:'title',b:'longitude'}} |
---|
| 594 | ; IDL> vv2 = {var:yaxis,name:'nav_lat',dname:'y',at1:{a:'units',b:'degrees_north'},at2:{a:'title',b:'latitude'}} |
---|
| 595 | ; IDL> vv3 = {var:ttt,name:'time',dname:'time_counter',unlim:1,at1:{a:'units',b:timeunit},at2:{a:'title',b:'julian days'} $ |
---|
| 596 | ; IDL> vv4 = {var:rain_i2, name:'rain' $ |
---|
| 597 | ; ,at1:{a:'units',b:'mm/day'} $ |
---|
[312] | 598 | ; ,at2:{a:'title',b:'trmm daily accumulated rainfall derived from the 3-hourly product (mm)'} $ |
---|
[371] | 599 | ; ,at3:{a:'scale_factor',b:scala_factor} $ |
---|
| 600 | ; ,at4:{a:'add_offset',b:adda_offset} $ |
---|
| 601 | ; ,at5:{a:'missing_value',b:missaval_i2} $ |
---|
[312] | 602 | ; } |
---|
[371] | 603 | ; IDL> glbatt={ gb1:{a:'File_Name', b:'trmm_1d_'+iyystr+'0101_'+iyystr+'1231_reg0.25.nc'} $ |
---|
| 604 | ; ,gb2:{a:'Model_Name', b:'TRMM 3B42_V6 derived product'} $ |
---|
[312] | 605 | ; ,gb3:{a:'Source_File',b:'ftp://disc2.nascom.nasa.gov/data/TRMM/Gridded/Derived_Products/3B42_V6/Daily/'+iyystr+'/*.bin'} $ |
---|
| 606 | ; ,gb4:{a:'IDL_Program_Name', b:'zz08_read_plot_row_trmm_precip.pro (clement@jamstec.go.jp)'} $ |
---|
[371] | 607 | ; ,gb5:{a:'Grid', b:'regular 0.25 degres resolution'}$ |
---|
[312] | 608 | ; } |
---|
[371] | 609 | ; IDL> write_ncdf, vv1, vv2, vv3, vv4, filename=fileoutnc, globattr=glbatt |
---|
[312] | 610 | ; |
---|
| 611 | ; @history |
---|
| 612 | ; CBM 2007-09-10 |
---|
| 613 | ; |
---|
[371] | 614 | ; @todo |
---|
| 615 | ; clem |
---|
[312] | 616 | ; |
---|
[327] | 617 | ;- |
---|
[312] | 618 | pro write_ncdf, var01,var02,var03,var04,var05,var06,var07,var08,var09,var10 $ ; RQ : if more than 30 variables is needed, simply add |
---|
| 619 | ,var11,var12,var13,var14,var15,var16,var17,var18,var19,var20 $ ; var31,var32 etc... here and change nmaxvv to 32 ... |
---|
| 620 | ,var21,var22,var23,var24,var25,var26,var27,var28,var29,var30 $ |
---|
| 621 | ,FILENAME=filename $ |
---|
| 622 | ,GLOBATTR=globattr $ |
---|
| 623 | ,VARNAME=namevquick $ |
---|
| 624 | $ |
---|
[327] | 625 | ,NOT_SDISV=flag1 $ ; mots cles non utiles sauf cas particuliers... |
---|
| 626 | ,NOT_OUASSALU=flag2 $ |
---|
| 627 | ,OKNAN=oknan |
---|
[312] | 628 | |
---|
| 629 | ; |
---|
| 630 | ; --> subroutine a tester avec le prog zz10_test_write_ncdf.pro par exemple... |
---|
| 631 | ; ou bien zz08_read_plot_row_trmm_precip_b |
---|
| 632 | ; |
---|
| 633 | ; ------- |
---|
| 634 | |
---|
| 635 | compile_opt idl2, strictarrsubs ; idl2 --> les entiers sont des long par defaut ET [...] obligatoire pour les tablo |
---|
| 636 | ; strictarrsubs --> pas de depassement de tablo |
---|
| 637 | |
---|
| 638 | @cm_general ; pour iodir si filename n est pas defini |
---|
| 639 | |
---|
| 640 | ; ------- |
---|
| 641 | |
---|
| 642 | writeout = 1 ; 1 pour ecrire info de base a l ecriture des vars, 0 sinon |
---|
| 643 | |
---|
| 644 | ; ------- |
---|
| 645 | |
---|
| 646 | ; not_samedimname_in_same_var : |
---|
| 647 | ; 1 : si on rencontre 2 dim de meme taille et meme unlim type ds une var on |
---|
| 648 | ; cree 2 dim differentes pour ne pas avoir 2 ou plus meme noms de dim |
---|
| 649 | ; dans une meme var (default) |
---|
| 650 | ; 0 : on ne cree pas de dim nouvelle si on a la la meme taille et meme |
---|
| 651 | ; unlim dim definie deja pour cette var, exple: fltarr(n1,n1) ne |
---|
| 652 | ; creera qu une dim de nom 'x1' de taille n1 |
---|
| 653 | |
---|
| 654 | if keyword_set(flag1) then not_samedimname_in_same_var = 0 else not_samedimname_in_same_var = 1 |
---|
| 655 | |
---|
| 656 | ; ------- |
---|
| 657 | |
---|
| 658 | ; ci-dessous |
---|
| 659 | ; 0 pour definir une nouvelle dim par sa taille ET sa nature unlim, uniquement |
---|
| 660 | ; 1 pour definir une nouvelle dim de la meme maniere, ET que si une dim est definie en unlim ALORS toutes les dim |
---|
| 661 | ; de meme taille ET last dim definie avant ou apres deviennent identiques a cette dim (ne font plus qu une), plutot que de |
---|
| 662 | ; 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 --> |
---|
| 663 | ; on defini la meme dim de taille n0 ET unlim pour les 2 vars var01 et var02 !! (default) |
---|
| 664 | |
---|
| 665 | if keyword_set(flag2) then oneunlim_all_samesizeandlast_unlim = 0 else oneunlim_all_samesizeandlast_unlim = 1 |
---|
| 666 | |
---|
| 667 | ; ------- |
---|
| 668 | |
---|
| 669 | if writeout then print,'-------write_ncdf-------' |
---|
| 670 | |
---|
| 671 | ; ------- |
---|
| 672 | |
---|
| 673 | structfd_v = 'var' |
---|
| 674 | structfd_n = 'name' |
---|
| 675 | structfd_unl = 'unlim' |
---|
| 676 | structfd_dn = 'dname' |
---|
| 677 | |
---|
| 678 | ncfile_default = 'write_ncdf.nc' |
---|
| 679 | |
---|
| 680 | nmaxvv = 30 |
---|
| 681 | nbdimmax = 99 |
---|
| 682 | |
---|
| 683 | fmtbase='(i2.2)' ; lie au max de var et dim definissable, si moins de 99 i2.2 ok, sinon passer a i3.3 etc... |
---|
| 684 | |
---|
| 685 | ; ------- |
---|
| 686 | |
---|
| 687 | nbvars = n_params() |
---|
| 688 | |
---|
| 689 | if nbvars lt 1 then message,'ERR : donner au moins une var stp ... stop' |
---|
| 690 | if nbvars gt nmaxvv then message,'ERR : la fonction write_ncdf est pour le moment definie pour '+string(nmaxvv,format=fmtbase) $ |
---|
| 691 | +' variables. Pour l utiliser avec plus, simplement ajouter var31,var32 etc ds l''entete de la subroutine... stop' |
---|
| 692 | |
---|
| 693 | ; ------- |
---|
| 694 | |
---|
| 695 | if n_elements(namevquick) ne 0 and n_elements(namevquick) ne nbvars then $ |
---|
| 696 | message,'PB : varname=... (nom des vars par defaut) doit avoir le meme nombre d elements que le nbre de vars... stop' |
---|
| 697 | |
---|
| 698 | ; ----------------------------------------------------------------------------------------------------------- |
---|
| 699 | ; |
---|
| 700 | ; creation du fichier netcdf |
---|
| 701 | ; |
---|
| 702 | ; ----------------------------------------------------------------------------------------------------------- |
---|
| 703 | |
---|
| 704 | if not(keyword_set(filename)) then ncfile=iodir+ncfile_default else ncfile=filename |
---|
| 705 | |
---|
| 706 | nposdir = strpos(ncfile,'/',/reverse_search) ; --> controlle de l existence du path menant au fichier |
---|
| 707 | dirr=strmid(ncfile,0,nposdir+1) |
---|
| 708 | if file_test(dirr,/directory) eq 0 then message,'ERR : le directory donne pour le fichier .nc n existe pas --> dir = '+dirr |
---|
| 709 | |
---|
| 710 | idout = ncdf_create(ncfile,/clobber) ; --> create a netcdf file, automatically placed into define mode (/clobber = erase previous file) |
---|
| 711 | ncdf_control, idout, /nofill ; --> data in the netcdf file is not pre-filled with default fill values |
---|
| 712 | |
---|
| 713 | ; ----------------------------------------------------------------------------------------------------------- |
---|
| 714 | ; |
---|
| 715 | ; define mode --> 1ere boucle sur les vars pour trouver les dimensions a definir et leurs caracteristiques |
---|
| 716 | ; |
---|
| 717 | ; ----------------------------------------------------------------------------------------------------------- |
---|
| 718 | |
---|
| 719 | oktypcodarr = [1,2,3,4,5,7] ; --> correspond au type de var accepte par ncdf_vardef de idl : byte,int,long,float,double,string, |
---|
| 720 | |
---|
| 721 | varst='var' |
---|
| 722 | dst='d' |
---|
| 723 | |
---|
| 724 | dimiss='--' |
---|
| 725 | dim_gene=dimiss |
---|
| 726 | |
---|
| 727 | arr_struct = intarr(nbvars) - 1 |
---|
| 728 | iattrv0 = intarr(nbvars) ; indice du premier attribut ds la structure |
---|
| 729 | typcodvv = intarr(nbvars) - 1 |
---|
| 730 | nama = strarr(nbvars) |
---|
| 731 | nbdimvv = intarr(nbvars) |
---|
| 732 | nbtags = intarr(nbvars) |
---|
| 733 | listofdimnams = strarr(nbvars) |
---|
| 734 | ;fieldfd = intarr(nbvars) |
---|
| 735 | |
---|
| 736 | firstdimcreated = 0 |
---|
| 737 | ndimtot = 0 |
---|
| 738 | |
---|
| 739 | for inv=0,nbvars-1 do begin |
---|
| 740 | |
---|
| 741 | dnames_imposed = 0 |
---|
| 742 | unl_imposed = 0 |
---|
| 743 | |
---|
| 744 | ; init de var, qui doivent etre non def si non attribuee (cf plus bas) |
---|
| 745 | dnama = 12 & zorglub = temporary(dnama) |
---|
| 746 | lasdd = 12 & zorglub = temporary(lasdd) |
---|
| 747 | notlasdd = 12 & zorglub = temporary(notlasdd) |
---|
| 748 | |
---|
| 749 | invp1=inv+1 |
---|
| 750 | nviv=string(invp1,format=fmtbase) |
---|
| 751 | commande= 'vvtmpstr=var'+nviv |
---|
| 752 | if not execute(commande) then message,'PB : attribution a vvtmp de la var numero '+nviv+'... stop' |
---|
| 753 | |
---|
| 754 | ; |
---|
| 755 | ; attribution des elements de la structure ou du tablo au vars de base pour ecrire definir la var-attr ds le ncdf |
---|
| 756 | ; |
---|
| 757 | |
---|
| 758 | sstr = size(vvtmpstr) |
---|
| 759 | nbdim = sstr[0] |
---|
| 760 | typcod = sstr[nbdim+1] |
---|
| 761 | if (where(oktypcodarr-typcod eq 0))[0] ne -1 then arr_struct[inv] = 0 ; --> var = scal or array of int, real, char, etc... |
---|
| 762 | if typcod eq 8 then arr_struct[inv] = 1 ; --> var = structure |
---|
| 763 | 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' |
---|
| 764 | |
---|
| 765 | case arr_struct[inv] of |
---|
| 766 | |
---|
| 767 | 0:begin ; --> var = scal or array of int, real, char, etc... |
---|
| 768 | |
---|
| 769 | vvtmp = vvtmpstr |
---|
| 770 | ssvv = size(vvtmp) |
---|
| 771 | nbdimvv[inv] = ssvv[0] |
---|
| 772 | typcodvv[inv] = ssvv[nbdimvv[inv]+1] |
---|
| 773 | |
---|
| 774 | if typcodvv[inv] eq 7 then begin ; les chaines de char ont un format particulier en tant que tablo pour ecriture netcdf... |
---|
| 775 | if nbdimvv[inv] eq 0 then ssvvdims = [ max(strlen(vvtmp))+1] else ssvvdims = [ max(strlen(vvtmp))+1,ssvv[1:nbdimvv[inv]] ] |
---|
| 776 | nbdimvv[inv] = nbdimvv[inv] + 1 |
---|
| 777 | endif else begin |
---|
| 778 | if nbdimvv[inv] eq 0 then ssvvdims = -12 else ssvvdims = ssvv[1:nbdimvv[inv]] |
---|
| 779 | endelse |
---|
| 780 | |
---|
| 781 | if n_elements(namevquick) eq 0 then nama[inv] = varst+nviv else nama[inv] = namevquick[inv] |
---|
| 782 | |
---|
| 783 | unlima = 0 |
---|
| 784 | |
---|
| 785 | ;dnama = zorglub ; non defini (car init avec temporary), default value fixed when dim are created (cf hereunder) |
---|
| 786 | |
---|
| 787 | end |
---|
| 788 | |
---|
| 789 | 1:begin ; --> var = structure |
---|
| 790 | |
---|
| 791 | nbtags[inv] = n_tags(vvtmpstr) |
---|
| 792 | tagnamas = tag_names(vvtmpstr) |
---|
| 793 | |
---|
| 794 | ; controle de la forme de la structure et def des elements |
---|
| 795 | |
---|
| 796 | ; 1) champ necessaire --> la variable |
---|
| 797 | fieldfound=0 |
---|
| 798 | for itg=0,nbtags[inv]-1 do begin |
---|
| 799 | if strlowcase(tagnamas[itg]) eq structfd_v then begin |
---|
| 800 | com= 'vvtmp=vvtmpstr.'+structfd_v |
---|
| 801 | if not execute(com) then message,'ERR : attribution de vvtmp, 1ere boucle sur les vars, var num '+nviv+'... stop' |
---|
| 802 | ssvv = size(vvtmp) |
---|
| 803 | nbdimvv[inv] = ssvv[0] |
---|
| 804 | typcodvv[inv] = ssvv[nbdimvv[inv]+1] |
---|
| 805 | if typcodvv[inv] eq 7 then begin ; les chaines de char ont un format particulier en tant que tablo pour ecriture netcdf... |
---|
| 806 | if nbdimvv[inv] eq 0 then ssvvdims = [ max(strlen(vvtmp))+1] $ |
---|
| 807 | else ssvvdims = [ max(strlen(vvtmp))+1,ssvv[1:nbdimvv[inv]] ] |
---|
| 808 | nbdimvv[inv] = nbdimvv[inv] + 1 |
---|
| 809 | endif else begin |
---|
| 810 | if nbdimvv[inv] eq 0 then ssvvdims = -12 else ssvvdims = ssvv[1:nbdimvv[inv]] |
---|
| 811 | endelse |
---|
| 812 | iattrv0[inv] = iattrv0[inv]+1 |
---|
| 813 | fieldfound=1 |
---|
| 814 | endif |
---|
| 815 | if fieldfound eq 1 then break |
---|
| 816 | endfor |
---|
| 817 | if fieldfound eq 0 then message,'ERR : le champ ''var'' est pas ds la structure (var num'+nviv+')... stop' |
---|
| 818 | |
---|
| 819 | ; 2) champ optionnel --> le nom de la var |
---|
| 820 | fieldfound=0 |
---|
| 821 | for itg=0,nbtags[inv]-1 do begin |
---|
| 822 | if strlowcase(tagnamas[itg]) eq structfd_n then begin |
---|
| 823 | iattrv0[inv] = iattrv0[inv]+1 |
---|
| 824 | com= 'nama[inv]=strcompress(vvtmpstr.'+structfd_n+')' |
---|
| 825 | if not execute(com) then message,'ERR : attribution de name of var num '+nviv+', 1ere boucle sur les vars... stop' |
---|
| 826 | if strlen(nama[inv]) eq 0 then message,'PB : nom de variable numero '+nviv+' vide, a respecifier...' |
---|
| 827 | fieldfound=1 |
---|
| 828 | endif |
---|
| 829 | if fieldfound eq 1 then break |
---|
| 830 | endfor |
---|
| 831 | if fieldfound eq 0 then if n_elements(namevquick) eq 0 then nama[inv] = varst+nviv else nama[inv] = namevquick[inv] |
---|
| 832 | ;fieldfd[inv] = fieldfound |
---|
| 833 | |
---|
| 834 | ; 3) champ optionnel --> si last dimension est unlimited |
---|
| 835 | fieldfound=0 |
---|
| 836 | for itg=0,nbtags[inv]-1 do begin |
---|
| 837 | if strlowcase(tagnamas[itg]) eq structfd_unl then begin |
---|
| 838 | iattrv0[inv] = iattrv0[inv]+1 |
---|
| 839 | com= 'unlima=vvtmpstr.'+structfd_unl |
---|
| 840 | if not execute(com) then message,'ERR : attribution de unlim of var num '+nviv+', 1ere boucle sur les vars... stop' |
---|
| 841 | if unlima ne 0 and unlima ne 1 then message,'PB : unlim vaut pas 0 ou 1 pour la var num '+nviv+'... stop' |
---|
| 842 | fieldfound=1 |
---|
| 843 | unl_imposed = 1 |
---|
| 844 | endif |
---|
| 845 | if fieldfound eq 1 then break |
---|
| 846 | endfor |
---|
| 847 | if fieldfound eq 0 then unlima = 0 ; unlimited=0 par defaut |
---|
| 848 | |
---|
| 849 | ; 4) champ optionnel --> nom des dimensions |
---|
| 850 | fieldfound=0 |
---|
| 851 | for itg=0,nbtags[inv]-1 do begin |
---|
| 852 | if strlowcase(tagnamas[itg]) eq structfd_dn then begin |
---|
| 853 | iattrv0[inv] = iattrv0[inv]+1 |
---|
| 854 | com= 'dnama=strcompress(vvtmpstr.'+structfd_dn+')' |
---|
| 855 | if not execute(com) then message,'ERR : attribution des dim name of var num '+nviv+', 1ere boucle sur les vars... stop' |
---|
| 856 | if n_elements(dnama) ne nbdimvv[inv] then message, 'PB : si on donne des noms de dim pour une var,' $ |
---|
| 857 | +' donner autant de noms que de dims pour la var... stop' |
---|
| 858 | aahh = strlen(dnama) |
---|
| 859 | if (where(aahh eq 0))[0] eq -1 or n_elements(where(aahh eq 0)) ne n_elements(dnama) then begin |
---|
| 860 | ; si on a pas que des chaines vides -> ok |
---|
| 861 | if (where(aahh eq 0))[0] ne -1 then $ |
---|
| 862 | message,'PB : un des noms (mais pas tous) des dim en input est vide... a respecifier... stop' |
---|
| 863 | if typcodvv[inv] eq 7 then dnama = ['d_strlen',dnama] ; on ajoute une dim donc un nom de dim aussi |
---|
| 864 | fieldfound=1 |
---|
| 865 | dnames_imposed = 1 ; si on donne des noms de dim, alors elles seront creees a coup sur |
---|
| 866 | ; (pas assimilees a d autres de meme taille ou autre...) |
---|
| 867 | endif else begin |
---|
| 868 | ; au cas ou on donne un tablo avec que des noms vide='', on considere que c est comme rien donner et on efface dnama |
---|
| 869 | zorglub = temporary(dnama) |
---|
| 870 | endelse |
---|
| 871 | ;print,'dnama=',dnama |
---|
| 872 | endif |
---|
| 873 | if fieldfound eq 1 then break |
---|
| 874 | endfor |
---|
| 875 | ;if fieldfound eq 0 then dnama = ... ; non def (car init avec temporary), default value fixed when dim are created (cf hereunder) |
---|
| 876 | |
---|
| 877 | end |
---|
| 878 | |
---|
| 879 | else:message,'wada t es pas la, impossible animal 1...' |
---|
| 880 | |
---|
| 881 | endcase |
---|
| 882 | |
---|
| 883 | 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' |
---|
| 884 | if inv ge 1 then begin |
---|
| 885 | 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' |
---|
| 886 | endif |
---|
| 887 | |
---|
| 888 | ;print,'NVIV = ',nviv |
---|
| 889 | |
---|
| 890 | ; on cree les structures pour chaque dim, afin de definir celles-ci ensuite |
---|
| 891 | |
---|
| 892 | if nbdimvv[inv] ne 0 then begin ; on a un vrai tablo, pas un scalaire |
---|
| 893 | |
---|
| 894 | ;print, 'var numero', nviv, ' , ssvv=', ssvv |
---|
| 895 | |
---|
| 896 | for iid = 0, nbdimvv[inv]-1 do begin |
---|
| 897 | |
---|
| 898 | iidp1 = iid+1 |
---|
| 899 | iidp1st = string(iidp1, format = fmtbase) |
---|
| 900 | ;nn = ssvv[iidp1] |
---|
| 901 | nn = ssvvdims[iid] |
---|
| 902 | |
---|
| 903 | ;print,'iidp1st = ',iidp1st |
---|
| 904 | |
---|
| 905 | ;if n_elements(strd02) ne 0 then begin |
---|
| 906 | ; ;print,'unlim d02 = ',strd02.unlimz |
---|
| 907 | ;endif |
---|
| 908 | |
---|
| 909 | if firstdimcreated eq 0 then aadd = [-1] else begin |
---|
| 910 | |
---|
| 911 | case iidp1 of |
---|
| 912 | |
---|
| 913 | ; (1) la dim de la var is the last one --> it can be unlimited |
---|
| 914 | |
---|
| 915 | nbdimvv[inv]:begin |
---|
| 916 | |
---|
| 917 | if oneunlim_all_samesizeandlast_unlim eq 1 then begin ; --> on update/create unlimited dimensions according to this one |
---|
| 918 | ptr_free,ptr_valid() |
---|
| 919 | for ikd=0,ndimtot-1 do begin ; loop on dims pour mettre les champs vardep_ndim des struc dim en liste chainee |
---|
| 920 | ikdp1st = string(ikd+1,format=fmtbase) |
---|
| 921 | com = 'strdlc = writenc_str2strlc(strd'+ikdp1st+')' |
---|
| 922 | if not execute(com) then message,'PB : loop on dim tot ('+ikdp1st+'), dim '+iidp1st+', var '+nviv+'... stop' |
---|
| 923 | if ikd eq 0 then supertab = [strdlc] else supertab = [supertab, strdlc] |
---|
| 924 | endfor ; on obtient ici supertab = [strd01lc ,strd02lc ....] |
---|
| 925 | writenc_unlimdim_update, dnames_imposed, unl_imposed, fmtbase, nviv, iidp1st, nn, dst,iid $ |
---|
| 926 | , supertabu = supertab, dimsizesu=dimsizes, unlimtabau=unlimtaba, unlimau=unlima $ |
---|
| 927 | , dimidasu=dimidas, ndimtotu=ndimtot, dnamossu=dnamoss, dnamau=dnama $ |
---|
| 928 | , impose_dnm_unlu = impose_dnm_unl |
---|
| 929 | for ikd=0,ndimtot-1 do begin ; on remet les struc avec liste chain en structures classiques du main prog |
---|
| 930 | ikdp1st = string(ikd+1,format=fmtbase) |
---|
| 931 | com = 'strd'+ikdp1st+' = writenc_strlc2str(supertab[ikd])' |
---|
| 932 | if not execute(com) then message,'PB : loop on dim tot ('+ikdp1st+'), dim '+iidp1st+', var '+nviv+'... stop' |
---|
| 933 | endfor |
---|
| 934 | endif ; oneunlim_all_samesizeandlast_unlim |
---|
| 935 | |
---|
| 936 | if dnames_imposed eq 1 then $ |
---|
| 937 | aadd = where(dimsizes-nn eq 0 and unlimtaba eq unlima and dnamoss eq dnama[iid]) else $ ; case sensitive sur EQ char |
---|
| 938 | aadd = where(dimsizes-nn eq 0 and unlimtaba eq unlima) ; la dim cherchee peut etre unlim car last |
---|
| 939 | |
---|
| 940 | end |
---|
| 941 | |
---|
| 942 | ; (2) la dim de la var is not last --> cannot be unlimited |
---|
| 943 | |
---|
| 944 | else : begin |
---|
| 945 | |
---|
| 946 | if dnames_imposed eq 1 then $ |
---|
| 947 | aadd = where(dimsizes - nn eq 0 and unlimtaba eq 0 and dnamoss eq dnama[iid]) else $ ; case sensitive sur EQ character |
---|
| 948 | aadd = where(dimsizes - nn eq 0 and unlimtaba eq 0) |
---|
| 949 | |
---|
| 950 | end |
---|
| 951 | |
---|
| 952 | endcase |
---|
| 953 | |
---|
| 954 | endelse |
---|
| 955 | |
---|
| 956 | ;if inv eq 3 and iid eq 2 then begin |
---|
| 957 | ;if inv eq 2 and iid eq 0 then begin |
---|
| 958 | ; ;print,'aadd inv 2, iid 0 =',aadd |
---|
| 959 | ; ;stop |
---|
| 960 | ;endif |
---|
| 961 | |
---|
| 962 | if aadd[0] eq -1 then begin |
---|
| 963 | |
---|
| 964 | ; cette taille de dim existe pas deja ou pas en meme unlimited style, donc on cree la dim |
---|
| 965 | |
---|
| 966 | ndimtot = ndimtot+1 |
---|
| 967 | ndst = string(ndimtot, format = fmtbase) |
---|
| 968 | if firstdimcreated eq 0 and iid eq 0 then begin ; premiere dim cree |
---|
| 969 | dimsizes = [nn] |
---|
| 970 | dimidas = [dst+ndst] |
---|
| 971 | if iidp1 eq nbdimvv[inv] then unlimtaba = [unlima] else unlimtaba = [0] |
---|
| 972 | if n_elements(dnama) ne 0 then dnamoss = [dnama[iid]] else dnamoss = [dimidas[ndimtot-1]] |
---|
| 973 | impose_dnm_unl = [dnames_imposed,unl_imposed] |
---|
| 974 | firstdimcreated = 1 |
---|
| 975 | endif else begin |
---|
| 976 | dimsizes = [dimsizes, nn] |
---|
| 977 | dimidas = [dimidas, dst+ndst] |
---|
| 978 | if iidp1 eq nbdimvv[inv] then unlimtaba = [unlimtaba,unlima] else unlimtaba = [unlimtaba,0] |
---|
| 979 | if n_elements(dnama) ne 0 then dnamoss = [dnamoss, dnama[iid]] else dnamoss = [dnamoss, dimidas[ndimtot-1]] |
---|
| 980 | impose_dnm_unl = [[impose_dnm_unl],[dnames_imposed,unl_imposed]] ; tablo: ix=2, jy=ndimtot |
---|
| 981 | endelse |
---|
| 982 | if iidp1 eq nbdimvv[inv] then lasto=1 else lasto=0 |
---|
| 983 | com = 'strd'+ndst+' = { dimid:dimidas[ndimtot-1],taille:nn,nomdim:dnamoss[ndimtot-1],unlimz:unlimtaba[ndimtot-1]' $ |
---|
| 984 | +',vardep_ndim:{a:[nama[inv]],b:[iidp1],c:[invp1],d:[lasto],impos:impose_dnm_unl[ndimtot-1]} } ' |
---|
| 985 | if not execute(com) then message, 'ERR : a la def (1) de la structure de dim'+iidp1st+', var'+nviv+'... stop' |
---|
| 986 | |
---|
| 987 | endif else begin |
---|
| 988 | |
---|
| 989 | ; cette taille de dim existe avec same unlimited style, on checke si c est ds la meme var ou pas |
---|
| 990 | |
---|
| 991 | nbsamedim = n_elements(aadd) ; au moins egal a 1 ou plus |
---|
| 992 | |
---|
| 993 | if dnames_imposed eq 1 then if nbsamedim gt 1 then message,'PB : impossible d avoir 2 dim identiques deja definies... stop' |
---|
| 994 | |
---|
| 995 | nbdsaminvar = 0 |
---|
| 996 | if not_samedimname_in_same_var eq 1 then begin |
---|
| 997 | ; ci-dessous: |
---|
| 998 | ; soit check 1ere dim of var: no same dim in var(nbdsaminvar=0), or elle existe deja, donc on utilise la 1ere identique |
---|
| 999 | ; 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 ... |
---|
| 1000 | ; soit on checke la last avec unlim=0 ou une var not last (donc unlim=0), et donc si size idem alors nbdsaminvar+1 |
---|
| 1001 | if dnames_imposed eq 0 then begin |
---|
| 1002 | if not (iid eq 0 or (iidp1 eq nbdimvv[inv] and unlima eq 1) ) then $ |
---|
| 1003 | for iidloc = 0, iid-1 do if ssvvdims[iidloc] eq nn then nbdsaminvar = nbdsaminvar+1 |
---|
| 1004 | endif ; else nbdsaminvar = 0 --> arrive si dnames_imposed = 1 |
---|
| 1005 | endif ; else nbdsaminvar = 0 |
---|
| 1006 | |
---|
| 1007 | if nbdsaminvar lt nbsamedim then begin |
---|
| 1008 | |
---|
| 1009 | ; pas besoin de creer, on peut se servir d une dim deja definie, juste mise a jour de strd de aadd[nbdsaminvar]+1 |
---|
| 1010 | |
---|
| 1011 | ; on ne peut arriver que ici avec dnames_imposed = 1 car nbdsaminvar = 0 cf ci-dessus |
---|
| 1012 | |
---|
| 1013 | ;if inv eq 3 and iid eq 2 then ;print,'wada' |
---|
| 1014 | |
---|
| 1015 | strnbd = string(aadd[nbdsaminvar]+1, format = fmtbase) |
---|
| 1016 | com = 'strdtmp = strd'+strnbd |
---|
| 1017 | if not execute(com) then message, 'ERR : attribution strdtmp 1 (dim'+iidp1st+', var'+nviv+')...stop' |
---|
| 1018 | if iidp1 eq nbdimvv[inv] then lasto=1 else lasto=0 |
---|
| 1019 | aavardep_ndim = { a:[strdtmp.vardep_ndim.(0),nama[inv]],b:[strdtmp.vardep_ndim.(1),iidp1] $ |
---|
| 1020 | ,c:[strdtmp.vardep_ndim.(2),invp1],d:[strdtmp.vardep_ndim.(3),lasto]} |
---|
| 1021 | ;if iidp1 eq nbdimvv[inv] and unlima eq 1 then unlimnew = unlima else unlimnew = strdtmp.unlimz --> obsolete !!! |
---|
| 1022 | unlimnew = strdtmp.unlimz ; unlimz reste inchange car la dim re-utilisee est selectionnee sur taille ET unlim |
---|
| 1023 | ;if n_elements(dnama) ne 0 then dnamo = dnama[iid] else dnamo=strdtmp.nomdim |
---|
| 1024 | if n_elements(dnama) ne 0 then if dnama[iid] ne strdtmp.nomdim then $ |
---|
| 1025 | message,'PB : impossible d etre la, car update une dim qui a un nom impose different... stop' |
---|
| 1026 | dnamo=strdtmp.nomdim ; on utilise le meme nom de l ancienne dim ok |
---|
| 1027 | com='strd'+strnbd+'={dimid:strdtmp.dimid,taille:nn,nomdim:dnamo,unlimz:unlimnew,vardep_ndim:aavardep_ndim} ' |
---|
| 1028 | if not execute(com) then message, 'ERR : update vardep,unlimz, dim'+strnbd+', loop: dim'+iidp1st+', var'+nviv+'... stop' |
---|
| 1029 | |
---|
| 1030 | ;if inv eq 3 and iid eq 2 then stop |
---|
| 1031 | |
---|
| 1032 | endif else if nbdsaminvar eq nbsamedim then begin |
---|
| 1033 | |
---|
| 1034 | ; on cree nouvelle dim, car cette taille de dim existe par exemple 2 fois avec 2 dimid noms differents |
---|
| 1035 | ; mais on doit en creer une troisieme (meme taille, nom different) car une var contient 3 fois cette taille de dim... |
---|
| 1036 | |
---|
| 1037 | ; pour pouvoir etre ici, une condition necessaire est (car sinon nbdsaminvar=0 or nbsamedim > 0): |
---|
| 1038 | ; not (iid eq 0 or (iidp1 eq nbdimvv[inv] and unlima eq 1)) |
---|
| 1039 | ; donc on est (pas 1ere dim of var) ET (pas last dim of var OU pas unlim=1) |
---|
| 1040 | ; donc je peux etre last dim mais alors en unlim=0 seulement, sinon je suis une dim du milieu (pas 1ere, ni last) |
---|
| 1041 | ; DONC on ne cree jamais de dim unlim ici |
---|
| 1042 | |
---|
| 1043 | ndimtot = ndimtot+1 |
---|
| 1044 | ndst = string(ndimtot, format = fmtbase) |
---|
| 1045 | dimsizes = [dimsizes, nn] |
---|
| 1046 | dimidas = [dimidas, dst+ndst] |
---|
| 1047 | if iidp1 eq nbdimvv[inv] then unlimtaba = [unlimtaba,unlima] else unlimtaba = [unlimtaba,0] |
---|
| 1048 | if unlimtaba[ndimtot-1] eq 1 then message,'PB : impossible de definir une structure de dim unlimited ici... stop' |
---|
| 1049 | if n_elements(dnama) ne 0 then dnamoss = [dnamoss, dnama[iid]] else dnamoss = [dnamoss, dimidas[ndimtot-1]] |
---|
| 1050 | if iidp1 eq nbdimvv[inv] then lasto=1 else lasto=0 |
---|
| 1051 | impose_dnm_unl = [[impose_dnm_unl],[dnames_imposed,unl_imposed]] ; tablo: ix=2, jy=ndimtot, mis a jour |
---|
| 1052 | com = 'strd'+ndst+' = { dimid:dimidas[ndimtot-1],taille:nn,nomdim:dnamoss[ndimtot-1],unlimz:unlimtaba[ndimtot-1]' $ |
---|
| 1053 | +',vardep_ndim:{a:[nama[inv]],b:[iidp1],c:[invp1],d:[lasto] }} ' |
---|
| 1054 | if not execute(com) then message, 'ERR : a la def (2) de la structure de dim'+iidp1st+', var'+nviv+'... stop' |
---|
| 1055 | |
---|
| 1056 | endif else message, 'ERR : impossible d avoir plus de dim identiques '+iidp1st+' ds la var'+nviv+'que deja definies... stop' |
---|
| 1057 | |
---|
| 1058 | endelse |
---|
| 1059 | |
---|
| 1060 | ; checke que l on ne vient pas de creer une 2ieme dim differentes en unlimited... |
---|
| 1061 | ; (ncdf_dimdef stop autrement, car une seule dim unlimited allowed) |
---|
| 1062 | |
---|
| 1063 | if n_elements(where(unlimtaba eq 1)) ge 2 then message,'ERR : une 2ieme structure-dim unlimited (dim '+iidp1st+') vient ' $ |
---|
| 1064 | +'d etre creee, mais on ne peut definir qu une unique dim unlimited en netcdf... stop' |
---|
| 1065 | |
---|
| 1066 | endfor |
---|
| 1067 | |
---|
| 1068 | endif ; else --> pas de dim a creer pour cette var qui est un scalaire ou string simple |
---|
| 1069 | |
---|
| 1070 | endfor |
---|
| 1071 | |
---|
| 1072 | ; ------------------------------------------------------------------- |
---|
| 1073 | ; |
---|
| 1074 | ; definition des dimensions |
---|
| 1075 | ; |
---|
| 1076 | ; ------------------------------------------------------------------- |
---|
| 1077 | |
---|
| 1078 | |
---|
| 1079 | ; checke que l on n a pas mis deux dimensions differentes en unlimited... (ncdf_dimdef stop autrement, une seule dim unlimited) |
---|
| 1080 | |
---|
| 1081 | if n_elements(where(unlimtaba eq 1)) ge 2 then message,'ERR : plus de 2 dimensions unlimited ont ete prescrites... stop' |
---|
| 1082 | |
---|
| 1083 | ; commande de base pour definir une dim : |
---|
| 1084 | ; |
---|
| 1085 | ; idout_of_the_dim = NCDF_DIMDEF(idout_of_the_nc_file, 'name_of_dim', n_size_of_dim) |
---|
| 1086 | ; |
---|
| 1087 | ; EXPLES: |
---|
| 1088 | ; |
---|
| 1089 | ; xidout = NCDF_DIMDEF(idout, 'x', n1) |
---|
| 1090 | ; ou pour unlimited : |
---|
| 1091 | ; tidout = NCDF_DIMDEF(idout, 'time', /unlimited) ; sans donner la taille de la dim !!! |
---|
| 1092 | ; |
---|
| 1093 | ; RQ : |
---|
| 1094 | ; |
---|
| 1095 | ; - si on a deux dim avec le meme nom, la definition des dim renvoit un message d erreur, OK |
---|
| 1096 | ; |
---|
| 1097 | ; - 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 |
---|
| 1098 | ; au moment du ncdf_vadef par id1=NCDF_VARDEF(idout,'a1',[t1idout],/FLOAT) et id2=...'a2'... ALORS la taille de la dim |
---|
| 1099 | ; 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 !!! |
---|
| 1100 | ; --> ici on previent ce genre de choses, toutes les vars avec la dim unlim en dernier doivent avoir la meme taille pour |
---|
| 1101 | ; cette dim, quitte a mettre des missing_value au prealable pour combler certains tablos a la bonne taille |
---|
| 1102 | ; (plutot que des 9.96921e+36 non reconnaissable a priori) |
---|
| 1103 | ; |
---|
| 1104 | ; - avec une var tablo avec 2 (ou plus) dim de meme taille exple: fltarr(5,5), on peut |
---|
| 1105 | ; 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]) |
---|
| 1106 | ; soit definir UNE SEULE DIM d01idout de taille 5 et faire pour la var: ncdf_vardef(... [d01idout,d01idout] ...), aussi accepte |
---|
| 1107 | |
---|
| 1108 | for ind=0,ndimtot-1 do begin |
---|
| 1109 | indp1st = string(ind+1,format=fmtbase) |
---|
| 1110 | char1 = 'strd' & char2 = '.taille,' & char3 = '' |
---|
| 1111 | com = 'if strd'+indp1st+'.unlimz eq 0 then ndstr= char1+indp1st+char2 else ndstr=char3' |
---|
| 1112 | if not execute(com) then message,'ERR : computing de ndstr pour la def de la dim'+indp1st+'... stop' |
---|
| 1113 | com = 'dimida = strd'+indp1st+'.dimid' |
---|
| 1114 | if not execute(com) then message, 'ERR : attrib dim id, pour la def de la dim '+indp1st+'... stop' |
---|
| 1115 | dimida = dimida+'idout' |
---|
| 1116 | com = dimida+' = ncdf_dimdef(idout, strd'+indp1st+'.nomdim, '+ndstr+' unlimited=strd'+indp1st+'.unlimz)' |
---|
| 1117 | if not execute(com) then message,'ERR : definition de la dim '+indp1st+'... stop' |
---|
| 1118 | endfor |
---|
| 1119 | |
---|
| 1120 | |
---|
| 1121 | ; ------------------------------------------------------------------- |
---|
| 1122 | ; |
---|
| 1123 | ; define mode --> 2ieme boucle sur les vars pour definir celles-ci |
---|
| 1124 | ; |
---|
| 1125 | ; ------------------------------------------------------------------- |
---|
| 1126 | |
---|
| 1127 | ; commande de base pour definir une var : |
---|
| 1128 | ; |
---|
| 1129 | ; 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) |
---|
| 1130 | ; |
---|
| 1131 | ; RQ : |
---|
| 1132 | ; - si on veut definir une var unlimited, ca doit etre la derniere |
---|
| 1133 | ; dim des variables. Si a2 = fltarr(n1, n4, n5, n3) alors la unlim ne |
---|
| 1134 | ; peut etre que n3 |
---|
| 1135 | ; - si on veut definir 2 vars avec le meme nom, on a un diag error par idl, ok |
---|
| 1136 | ; |
---|
| 1137 | ; EXPLE: |
---|
| 1138 | ; id0 = NCDF_VARDEF(idout, 'a2', [xidout,tidout,yidout,zidout], /FLOAT) |
---|
| 1139 | ; |
---|
| 1140 | |
---|
| 1141 | for inv=0,nbvars-1 do begin |
---|
| 1142 | |
---|
| 1143 | ; |
---|
| 1144 | ; --> Def des vars |
---|
| 1145 | ; ------------ |
---|
| 1146 | |
---|
| 1147 | nviv=string(inv+1,format=fmtbase) |
---|
| 1148 | |
---|
| 1149 | ; type de la var a ecrire |
---|
| 1150 | tpv = intarr(6) |
---|
| 1151 | case typcodvv[inv] of |
---|
| 1152 | 1:tpv[0]=1 ; byte |
---|
| 1153 | 2:tpv[1]=1 ; short (int) |
---|
| 1154 | 3:tpv[2]=1 ; long |
---|
| 1155 | 4:tpv[3]=1 ; float |
---|
| 1156 | 5:tpv[4]=1 ; dble |
---|
| 1157 | 7:tpv[5]=1 ; char |
---|
| 1158 | else:message,'PB : le type de la var num '+nviv+' est pas accepte par ncdf idl (not byte,int,real...) ... stop' |
---|
| 1159 | end |
---|
| 1160 | flagstype = 'BYTE=tpv[0],SHORT=tpv[1],LONG=tpv[2],FLOAT=tpv[3],DOUBLE=tpv[4],CHAR=tpv[5]' |
---|
| 1161 | |
---|
| 1162 | listofdims = '' |
---|
| 1163 | listofdimnams[inv] = '' |
---|
| 1164 | 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=... |
---|
| 1165 | |
---|
| 1166 | for iid = 0, nbdimvv[inv]-1 do begin ; boucle sur les dims de la var ds ordre des dim de la var |
---|
| 1167 | |
---|
| 1168 | iidp1 = iid+1 |
---|
| 1169 | iidp1st = string(iid+1,format=fmtbase) |
---|
| 1170 | |
---|
| 1171 | ndimdepfd = 0 |
---|
| 1172 | for ind=0,ndimtot-1 do begin ; boucle sur les dims globales qui ont ete definies precedemment |
---|
| 1173 | indp1st = string(ind+1,format=fmtbase) |
---|
| 1174 | com = 'namvararr = strd'+indp1st+'.vardep_ndim.(0)' |
---|
| 1175 | if not execute(com) then message, 'ERR : attrib namvararr, dim glob '+indp1st+',dim var '+iidp1st+',var num '+nviv+'... stop' |
---|
| 1176 | com = 'numdimvararr = strd'+indp1st+'.vardep_ndim.(1)' |
---|
| 1177 | if not execute(com) then message, 'ERR : attrib numdimvararr, dim glob '+indp1st+',dim var '+iidp1st+',var num '+nviv+'... stop' |
---|
| 1178 | aaa = where(namvararr eq nama[inv] and numdimvararr eq iidp1) |
---|
| 1179 | if aaa[0] ne -1 then begin |
---|
| 1180 | com = 'dimnam = strd'+indp1st+'.nomdim' |
---|
| 1181 | if not execute(com) then message, 'ERR : attrib dimnam, dim glob '+indp1st+',dim var '+iidp1st+',var num '+nviv+'... stop' |
---|
| 1182 | com = 'dimdep = strd'+indp1st+'.dimid' |
---|
| 1183 | if not execute(com) then message, 'ERR : attrib dimdep, dim glob '+indp1st+',dim var '+iidp1st+',var num '+nviv+'... stop' |
---|
| 1184 | dimdep = dimdep+'idout' |
---|
| 1185 | ; check unlim en last dim ok |
---|
| 1186 | com = 'unlimdd = strd'+indp1st+'.unlimz' |
---|
| 1187 | if not execute(com) then message, 'ERR : attrib unlimdd, dim glob '+indp1st+',dim var '+iidp1st+',var num '+nviv+'... stop' |
---|
| 1188 | if unlimdd eq 1 and iidp1 ne nbdimvv[inv] then $ |
---|
| 1189 | message,'PB : cannot define var with unlim dim '+iidp1st+' which is not last of var'+nviv+' (dimglo'+indp1st+')... stop' |
---|
| 1190 | IF unlimdd EQ 1 THEN dimnam = dimnam+'*' |
---|
| 1191 | ; --- |
---|
| 1192 | ndimdepfd=ndimdepfd + 1 |
---|
| 1193 | endif |
---|
| 1194 | endfor |
---|
| 1195 | |
---|
| 1196 | case ndimdepfd of |
---|
| 1197 | 0:message,'PB : on ne trouve aucun nom de dim glob pour la dim '+iidp1st+' de la var '+nviv+'... stop' |
---|
| 1198 | 1:begin |
---|
| 1199 | if iid eq 0 then listofdims=dimdep else listofdims=listofdims+','+dimdep |
---|
| 1200 | if iid eq 0 then listofdimnams[inv]=dimnam else listofdimnams[inv]=listofdimnams[inv]+','+dimnam |
---|
| 1201 | end |
---|
| 1202 | else:message,'PB : on trouve plus de 1 nom de dim glob pour la dim '+iidp1st+' de la var '+nviv+'... stop' |
---|
| 1203 | endcase |
---|
| 1204 | |
---|
| 1205 | endfor |
---|
| 1206 | |
---|
| 1207 | listofdims='['+listofdims+'],' ; listofdims doit etre de la forme : '[...] ,' |
---|
| 1208 | |
---|
| 1209 | endif ; else listofdims = '' |
---|
| 1210 | |
---|
| 1211 | com='id'+nviv+'=NCDF_VARDEF(idout,nama[inv],'+listofdims+flagstype+')' |
---|
| 1212 | if not execute(com) then message,'ERR : definition de la var '+nviv+' ... stop' |
---|
| 1213 | |
---|
| 1214 | ; |
---|
| 1215 | ; --> Def des attributs de la var |
---|
| 1216 | ; --------------------------- |
---|
| 1217 | |
---|
| 1218 | ; ds le cas d une structure: la def des attributs (si existent) a ete specifiee ds la structure |
---|
| 1219 | |
---|
| 1220 | missaval_flag = 0 |
---|
| 1221 | |
---|
| 1222 | if arr_struct[inv] eq 1 then begin ; --> ok var00 est une structure |
---|
| 1223 | |
---|
| 1224 | com= 'vvtmpstr=var'+nviv |
---|
| 1225 | if not execute(com) then message,'ERR : attribution de vvtmpstr, 2ieme boucle sur les var, var num '+nviv+'... stop' |
---|
| 1226 | |
---|
| 1227 | if nbtags[inv] gt iattrv0[inv] then begin ; --> on a des attributs en plus |
---|
| 1228 | nbattr = nbtags[inv] - iattrv0[inv] |
---|
| 1229 | for iatr=0,nbattr-1 do begin |
---|
| 1230 | iatrstp1=string(iatr+1,format=fmtbase) |
---|
| 1231 | ;print, nviv, '--', iattrv0[inv], '--', iatr |
---|
| 1232 | ss = size(vvtmpstr.(iattrv0[inv]+iatr)) |
---|
| 1233 | if ss[0] ne 1 or ss[2] ne 8 or n_tags(vvtmpstr.(iattrv0[inv]+iatr)) ne 2 then $ |
---|
| 1234 | message, 'PB : l attribut numero '+iatrstp1+' de la var'+nviv+' n est pas une struc de 2 elements... stop' |
---|
| 1235 | attnamtmp = vvtmpstr.(iattrv0[inv]+iatr).(0) |
---|
| 1236 | attxttmp = vvtmpstr.(iattrv0[inv]+iatr).(1) |
---|
| 1237 | comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, attxttmp' |
---|
| 1238 | if not execute(comm) then message,'PB : def attr numero'+iatrstp1+', var numero '+nviv+'... stop' |
---|
| 1239 | if strlowcase(attnamtmp) eq 'missing_value' then begin ; --> si on trouve un attribut missval on memorise |
---|
| 1240 | missaval_flag = 1 |
---|
| 1241 | missaval = attxttmp |
---|
| 1242 | endif |
---|
| 1243 | endfor |
---|
| 1244 | endif |
---|
| 1245 | |
---|
| 1246 | endif |
---|
| 1247 | |
---|
| 1248 | ; attributs par defaut: valid_min et valid_max et infos sur missing value |
---|
| 1249 | |
---|
| 1250 | if typcodvv[inv] ne 7 then begin ; --> si var est pas un char on peut calculer min et max |
---|
| 1251 | |
---|
| 1252 | case arr_struct[inv] of |
---|
| 1253 | 0:com= 'vvtmp=var'+nviv |
---|
| 1254 | 1:com= 'vvtmp=vvtmpstr.'+structfd_v |
---|
| 1255 | else:message,'ERR : impossible to be there... stop' |
---|
| 1256 | endcase |
---|
| 1257 | |
---|
| 1258 | if not execute(com) then message,'ERR : attribution de vvtmp, 2ieme boucle sur les var, var num '+nviv+'... stop' |
---|
| 1259 | |
---|
| 1260 | if not keyword_set(oknan) then begin |
---|
| 1261 | aak = where(not(float(finite(vvtmp)))) |
---|
| 1262 | if aak[0] ne -1 then $ |
---|
| 1263 | message,'PB : la var numero '+nviv+' contient des nan... pas propre ds un fichier netcdf (cf utilisation ferret et autre soft)' $ |
---|
| 1264 | +', remplacer par des missing ou bien activer le mot-cle /oknan pour tolerer l''ecriture de Nan ds le fichier nc... stop' |
---|
| 1265 | endif |
---|
| 1266 | |
---|
| 1267 | 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 |
---|
| 1268 | |
---|
| 1269 | if missaval_flag eq 1 then begin |
---|
| 1270 | |
---|
| 1271 | ss = size(missaval) |
---|
| 1272 | 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' |
---|
| 1273 | whhmiss = where(vvtmp eq missaval,complement=whhok) |
---|
| 1274 | if whhmiss[0] eq -1 then begin |
---|
| 1275 | if n_elements(vvtmp) gt 1 then begin |
---|
| 1276 | attnamtmp = 'valid_min_max' |
---|
| 1277 | attxttmp = 'missing value never occurs' |
---|
| 1278 | comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, attxttmp' |
---|
| 1279 | if not execute(comm) then message,'ERR : def extra attr miss val 0, var numero '+nviv+'... stop' |
---|
| 1280 | endif |
---|
| 1281 | aamax = max(vvtmp,min=aamin) |
---|
| 1282 | endif else begin |
---|
| 1283 | if whhok[0] ne -1 then begin |
---|
| 1284 | if n_elements(vvtmp) gt 1 then begin |
---|
| 1285 | attnamtmp = 'valid_min_max' |
---|
| 1286 | attxttmp = 'missing value occurs' |
---|
| 1287 | comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, attxttmp' |
---|
| 1288 | if not execute(comm) then message,'ERR : def extra attr miss val 1, var numero '+nviv+'... stop' |
---|
| 1289 | endif |
---|
| 1290 | aamax = max(vvtmp[whhok],min=aamin) |
---|
| 1291 | endif else begin ; on a que des missing value |
---|
| 1292 | if n_elements(vvtmp) gt 1 then begin |
---|
| 1293 | attnamtmp = 'valid_min_max' |
---|
| 1294 | attxttmp = 'missing value always occurs' |
---|
| 1295 | comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, attxttmp' |
---|
| 1296 | if not execute(comm) then message,'ERR : def extra attr miss val 2, var numero '+nviv+'... stop' |
---|
| 1297 | writevalidminmax = 0 |
---|
| 1298 | endif else aamax = max(vvtmp,min=aamin) |
---|
| 1299 | endelse |
---|
| 1300 | endelse |
---|
| 1301 | |
---|
| 1302 | endif else begin |
---|
| 1303 | |
---|
| 1304 | aamax = max(vvtmp,min=aamin) |
---|
| 1305 | attnamtmp = 'valid_min_max' |
---|
| 1306 | attxttmp = 'no missing value defined' |
---|
| 1307 | comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, attxttmp' |
---|
| 1308 | if not execute(comm) then message,'ERR : def extra attr miss val 3, var numero '+nviv+'... stop' |
---|
| 1309 | |
---|
| 1310 | endelse |
---|
| 1311 | |
---|
| 1312 | if writevalidminmax then begin |
---|
| 1313 | attnamtmp = 'valid_min' |
---|
| 1314 | comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, aamin' |
---|
| 1315 | if not execute(comm) then message,'ERR : def miss val attr min, var numero '+nviv+'... stop' |
---|
| 1316 | attnamtmp = 'valid_max' |
---|
| 1317 | comm = 'NCDF_ATTPUT, idout, id'+nviv+', attnamtmp, aamax' |
---|
| 1318 | if not execute(comm) then message,'ERR : def miss val attr max, var numero '+nviv+'... stop' |
---|
| 1319 | endif |
---|
| 1320 | |
---|
| 1321 | endif |
---|
| 1322 | |
---|
| 1323 | endfor |
---|
| 1324 | |
---|
| 1325 | ; -------------------------------------------------------- |
---|
| 1326 | ; |
---|
| 1327 | ; Definition des attributs globaux |
---|
| 1328 | ; |
---|
| 1329 | ; -------------------------------------------------------- |
---|
| 1330 | |
---|
| 1331 | attprod = 0 |
---|
| 1332 | |
---|
| 1333 | if n_elements(globattr) ne 0 then begin ; --> on a prescrit des attributs globaux |
---|
| 1334 | |
---|
| 1335 | 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' |
---|
| 1336 | nbtagsgb = n_tags(globattr) |
---|
| 1337 | for igat = 0, nbtagsgb-1 do begin |
---|
| 1338 | igatst = string(igat, format = '(i2.2)') |
---|
| 1339 | ss = size(globattr.(igat)) |
---|
| 1340 | if ss[0] ne 1 or ss[2] ne 8 or n_tags(globattr.(igat)) ne 2 then $ |
---|
| 1341 | message, 'ERR : au glob attr numero'+igatst+' qui n est pas un structure de 2 elements... stop' |
---|
| 1342 | gbatn = globattr.(igat).(0) |
---|
| 1343 | gbatt = globattr.(igat).(1) |
---|
| 1344 | NCDF_ATTPUT, idout, gbatn, gbatt, /global |
---|
| 1345 | if gbatn eq 'Production' then attprod = 1 |
---|
| 1346 | endfor |
---|
| 1347 | |
---|
| 1348 | endif |
---|
| 1349 | |
---|
| 1350 | if attprod eq 0 then begin |
---|
| 1351 | producta = systime() |
---|
| 1352 | NCDF_ATTPUT, idout, 'Production', producta, /GLOBAL |
---|
| 1353 | endif |
---|
| 1354 | |
---|
| 1355 | ; -------------------------------------------------------- |
---|
| 1356 | ; |
---|
| 1357 | ; Fin de definition des variables |
---|
| 1358 | ; |
---|
| 1359 | ; -------------------------------------------------------- |
---|
| 1360 | |
---|
| 1361 | |
---|
| 1362 | NCDF_CONTROL, idout, /ENDEF ; --> take the open netCDF file out of define mode and into data mode |
---|
| 1363 | |
---|
| 1364 | |
---|
| 1365 | ; -------------------------------------------------------- |
---|
| 1366 | ; |
---|
| 1367 | ; Ecriture des variables |
---|
| 1368 | ; |
---|
| 1369 | ; -------------------------------------------------------- |
---|
| 1370 | |
---|
| 1371 | |
---|
| 1372 | for inv=0,nbvars-1 do begin |
---|
| 1373 | |
---|
| 1374 | nviv=string(inv+1,format='(i2.2)') |
---|
| 1375 | |
---|
| 1376 | case arr_struct[inv] of |
---|
| 1377 | 0: comm = 'NCDF_VARPUT, idout, id'+nviv+', var'+nviv ; --> tablo |
---|
| 1378 | 1: comm = 'NCDF_VARPUT, idout, id'+nviv+', var'+nviv+'.'+structfd_v ; --> struct |
---|
| 1379 | else:message,'ERR : ncdf_varput case...' |
---|
| 1380 | endcase |
---|
| 1381 | |
---|
| 1382 | if writeout and inv eq 0 then print,'Writing fields : ' |
---|
| 1383 | if writeout then print,' '+nama[inv]+'['+listofdimnams[inv]+'] = var'+nviv |
---|
| 1384 | |
---|
| 1385 | if not execute(comm) then message,'PB : ncdf_varput final... stop' |
---|
| 1386 | |
---|
| 1387 | endfor |
---|
| 1388 | |
---|
| 1389 | ; -------------------------------------------------------- |
---|
| 1390 | ; |
---|
| 1391 | ; Fermeture fichier netcdf |
---|
| 1392 | ; |
---|
| 1393 | ; -------------------------------------------------------- |
---|
| 1394 | |
---|
| 1395 | NCDF_CLOSE, idout |
---|
| 1396 | |
---|
| 1397 | if writeout then print,'Written to '+ncfile |
---|
| 1398 | if writeout then print,'------------------------' |
---|
| 1399 | |
---|
| 1400 | ; -------------------------------------------------------- |
---|
| 1401 | ; -------------------------------------------------------- |
---|
| 1402 | ; -------------------------------------------------------- |
---|
| 1403 | |
---|
| 1404 | end |
---|
| 1405 | |
---|
| 1406 | ; exemples of var attr : |
---|
| 1407 | ; ----------------------- |
---|
| 1408 | ; rain:units = "mm/day" |
---|
| 1409 | ; rain:valid_min = -32700 |
---|
| 1410 | ; rain:valid_max = 32700 |
---|
| 1411 | ; rain:valid_range = -32700, 32700 |
---|
| 1412 | ; rain:standard_name = "rain1" |
---|
| 1413 | ; rain:long_name = "monthly precipitation by merging gauge, 5 kinds of satellite estimates (GPI,OPI,SSM/I scattering, SSM/I emission and MSU)" |
---|
| 1414 | ; rain:title = "monthly precipitation by merging gauge, 5 kinds of satellite estimates (GPI,OPI,SSM/I scattering, SSM/I emission and MSU)" |
---|
| 1415 | ; rain:add_offset = 31.7f |
---|
| 1416 | ; rain:scale_factor = 0.001f |
---|
| 1417 | ; rain:missing_value = -1.f |
---|
| 1418 | ; rain:lon = "nav_lon" |
---|
| 1419 | ; rain:lat = "nav_lat" |
---|
| 1420 | |
---|
| 1421 | ; exemples of global attr : |
---|
| 1422 | ; -------------------------- |
---|
| 1423 | ; |
---|
| 1424 | ; File_Name : trmm_1d_19980101_19981231_reg0.25.nc |
---|
| 1425 | ; Model_Name : TRMM 3B42_V6 derived product |
---|
| 1426 | ; Source_File : ftp://disc2.nascom.nasa.gov/data/TRMM/Gridded/Derived_Products/3B42_V6/Daily/'+iyystr+'/*.bin' |
---|
| 1427 | ; IDL_Program_Name : zz08_read_plot_row_trmm_precip.pro |
---|
| 1428 | ; Grid : regular 0.25 degres resolution |
---|
| 1429 | ; Title : Weekly Topex/ers sea surface anomaly from oct 14th 1992 to feb 13th 2002 |
---|
| 1430 | ; Associate_file : ... |
---|
| 1431 | ; Description : ... |
---|
| 1432 | |
---|
| 1433 | ; |
---|
| 1434 | ; exemple de creation fic ncdf avec fcts idl : |
---|
| 1435 | ; -------------------------------------------- |
---|
| 1436 | ; |
---|
| 1437 | ; ; creation du fichier de sortie et ecriture des vars |
---|
| 1438 | ; idout = NCDF_CREATE(fic+'2',/clobber) |
---|
| 1439 | ; NCDF_CONTROL, idout, /nofill |
---|
| 1440 | ; ; |
---|
| 1441 | ; ; Dimension |
---|
| 1442 | ; xidout = NCDF_DIMDEF(idout, 'x', nxx) |
---|
| 1443 | ; yidout = NCDF_DIMDEF(idout, 'y', nyy) |
---|
| 1444 | ; tidout = NCDF_DIMDEF(idout, 'time_counter', /unlimited) |
---|
| 1445 | ; ; |
---|
| 1446 | ; ; Attributs globaux |
---|
| 1447 | ; NCDF_ATTPUT, idout, 'title', 'Weekly Topex/ers sea surface anomaly from oct 14th 1992 to feb 13th 2002', /GLOBAL |
---|
| 1448 | ; NCDF_ATTPUT, idout, 'production', 'Clément de Boyer (cdblod@lodyc.jussieu.fr)', /GLOBAL |
---|
| 1449 | ; ;NCDF_ATTPUT, idout, 'description' $ |
---|
| 1450 | ; ; , ' ncecat 488 files of Topex/ers data on Indian Ocean and add a time counter', /GLOBAL |
---|
| 1451 | ; NCDF_ATTPUT, idout, 'associate_file', prev_fic, /GLOBAL |
---|
| 1452 | ; NCDF_ATTPUT, idout, 'time_stamp', systime(), /GLOBAL |
---|
| 1453 | ; ; |
---|
| 1454 | ; ; Def des variables |
---|
| 1455 | ; id0 = NCDF_VARDEF(idout, 'nav_lon' , [xidout, yidout ], /FLOAT) |
---|
| 1456 | ; id1 = NCDF_VARDEF(idout, 'nav_lat' , [xidout, yidout ], /FLOAT) |
---|
| 1457 | ; id2 = NCDF_VARDEF(idout, 'time_counter' , [ tidout], /FLOAT) |
---|
| 1458 | ; id3 = NCDF_VARDEF(idout, 'sla' , [xidout, yidout, tidout], /FLOAT) |
---|
| 1459 | ; ; |
---|
| 1460 | ; ; Attributs variable 0 : lon |
---|
| 1461 | ; NCDF_ATTPUT, idout, id0, 'units', 'degrees_east' |
---|
| 1462 | ; NCDF_ATTPUT, idout, id0, 'valid_min', min(lon) |
---|
| 1463 | ; NCDF_ATTPUT, idout, id0, 'valid_max', max(lon) |
---|
| 1464 | ; NCDF_ATTPUT, idout, id0, 'long_name', 'Longitude at t-point' |
---|
| 1465 | ; ; |
---|
| 1466 | ; ; Attributs variable 1 : lat |
---|
| 1467 | ; NCDF_ATTPUT, idout, id1, 'units', 'degrees_north' |
---|
| 1468 | ; NCDF_ATTPUT, idout, id1, 'valid_min', min(lat) |
---|
| 1469 | ; NCDF_ATTPUT, idout, id1, 'valid_max', max(lat) |
---|
| 1470 | ; NCDF_ATTPUT, idout, id1, 'long_name', 'Latitude at t-point' |
---|
| 1471 | ; ; |
---|
| 1472 | ; ; Attributs variable 2 : |
---|
| 1473 | ; NCDF_ATTPUT, idout, id2, 'units', origt |
---|
| 1474 | ; NCDF_ATTPUT, idout, id2, 'calendar','leap' |
---|
| 1475 | ; NCDF_ATTPUT, idout, id2, 'title', 'Time' |
---|
| 1476 | ; NCDF_ATTPUT, idout, id2, 'long_name', 'Time axis' |
---|
| 1477 | ; NCDF_ATTPUT, idout, id2, 'time_origin ', origt |
---|
| 1478 | ; ; christophe style |
---|
| 1479 | ; ;ayear=strtrim(string(year(0)),1) |
---|
| 1480 | ; ;amonth=strtrim(string(month(0),format="(i2.2)"),1) |
---|
| 1481 | ; ;aday=strtrim(string(day(0),format="(i2.2)"),1) |
---|
| 1482 | ; ;NCDF_ATTPUT, idout, id3, 'units', 'days since '+ayear+'-'+amonth+'-'+aday+' 00:00:00' |
---|
| 1483 | ; ;NCDF_ATTPUT, idout, id3, 'calendar', 'gregorian' |
---|
| 1484 | ; ;NCDF_ATTPUT, idout, id3, 'long_name', 'Time axis' |
---|
| 1485 | ; ;NCDF_ATTPUT, idout, id3, 'time_origin ', ayear+'-'+b(month(0)-1)+'-'+aday+' 00:00:00' |
---|
| 1486 | ; ; |
---|
| 1487 | ; ; Attributs variable 3 : vv |
---|
| 1488 | ; NCDF_ATTPUT, idout, id3, 'units', 'M' |
---|
| 1489 | ; NCDF_ATTPUT, idout, id3, 'missing_value',missval |
---|
| 1490 | ; NCDF_ATTPUT, idout, id3, 'valid_min', min(vv) |
---|
| 1491 | ; if countnomiss ne 0 then vvmw=vv[vvw] |
---|
| 1492 | ; NCDF_ATTPUT, idout, id3, 'valid_max', max(vvmw) |
---|
| 1493 | ; NCDF_ATTPUT, idout, id3, 'long_name', 'sea level anomaly' |
---|
| 1494 | ; NCDF_ATTPUT, idout, id3, 'short_name', 'sla' |
---|
| 1495 | ; ; |
---|
| 1496 | ; ; fin def des variables |
---|
| 1497 | ; NCDF_CONTROL, idout, /ENDEF |
---|
| 1498 | ; ; |
---|
| 1499 | ; ; Ecriture des variables |
---|
| 1500 | ; NCDF_VARPUT, idout, id0, lon ; la longitude, var 0 |
---|
| 1501 | ; NCDF_VARPUT, idout, id1, lat ; la latitude, var 1 |
---|
| 1502 | ; NCDF_VARPUT, idout, id2, ttt ; le time (calendrier), var 2 |
---|
| 1503 | ; NCDF_VARPUT, idout, id3, vv ; la vv, var 3 |
---|
| 1504 | ; ; |
---|
| 1505 | ; ; Fermeture fichier netcdf |
---|
| 1506 | ; NCDF_CLOSE, idout |
---|
| 1507 | |
---|
| 1508 | |
---|
| 1509 | |
---|
| 1510 | |
---|
| 1511 | ; EXPLE de ncdf quickwrite... bof quoi...: |
---|
| 1512 | ; |
---|
| 1513 | ; ncfile='!my.nc' |
---|
| 1514 | ; angle_attr={units:'degrees'} |
---|
| 1515 | ; wind_attr={units:'m s-1'} |
---|
| 1516 | ; press_attr={units:'pascals',missing_value:1e10} |
---|
| 1517 | ; g_attr={units:'m s-2'} |
---|
| 1518 | ; globattr={source:'My program',version:2} |
---|
| 1519 | ; |
---|
| 1520 | ; ncfields = 'pressure[longitude,latitude,time]=p:press_attr; ' $ |
---|
| 1521 | ; + 'longitude[]=lons:angle_attr; ' $ |
---|
| 1522 | ; + 'latitude[]=lats:angle_attr; ' $ |
---|
| 1523 | ; + 'ubar[latitude,time]:wind_attr; ' $ |
---|
| 1524 | ; + 'year[*time]=yr; ' $ |
---|
| 1525 | ; + 'g=9.8:g_attr @ globattr' |
---|
| 1526 | ; |
---|
| 1527 | ; @ncdf_quickwrite |
---|
| 1528 | ; |
---|