Context Navigation

write_ncdf.pro @ 312

Last change on this file since 312 was 312, checked in by cdblod, 16 years ago
add write_ncdf.pro
Property svn:executable set to ``* Property svn:keywords set to `Id`
File size: 76.8 KB

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

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

Download in other formats:

Original Format