Context Navigation

source: trunk/SOURCES/Netcdf-routines/sortie_netcdf_GRISLI_mod.0.2-hassine.f90 @ 65

Last change on this file since 65 was 65, checked in by dumas, 8 years ago
Deleting unused variables and move old sources
File size: 52.6 KB

Line
1	!> \file sortie_netcdf_GRISLI_mod.0.2-hassine.f90
2	!! Sorties_ncdf_grisli for netcdf output
3	!<
4
5
6	!>\namespace sorties_ncdf_grisli
7	!!\author CatRitz
8	!!\author Hassine
9	!!\date 2010
10	!!@note netcdf output with the same variables number as the horizontal output
11	!!@note used modules:
12	!!@note - netcdf
13	!!@note - runparam
14	!!@note - io_netcdf_grisli
15	!!@note - module3D_phy
16	!<
17
18	module sorties_ncdf_grisli
19
20	use netcdf
21	use geography ! permet d'avoir nx et ny et geoplace
22	use runparam ! permet d'avoir tbegin,tend,runname,dirout
23	use io_netcdf_grisli
24	use module3d_phy
25	use tracer_vars ! aurel neem
26	!use icetemp_declar
27
28	implicit none
29
30	!variables netcdf
31
32	character(len=100), dimension(:),allocatable :: fil_sortie !< nom du fichier sortie
33	integer, dimension(:),allocatable :: status !< erreur operations io netcdf
34	integer, dimension(:),allocatable :: ncid !< numero unite, ident variable
35	character(len=80), dimension(:), allocatable :: basename !< basename des fichier ncdf de sortie
36	real :: dtncdf !< pas de temps des sorties
37
38	integer :: i_debug !< pour les variables debug
39	integer :: num_init_nc=0 !< numero de l'initialisation init_sortie
40	! Pour chaque variable :
41	!____________________________________
42
43	integer,parameter :: nnc=300 !< nombre max de variables
44
45	! numero, classe, type de noeud, nom
46
47	integer,dimension(nnc) :: ivar_nc !< tableau qui contient les itab des var choisies
48	integer,dimension(nnc) :: cvar_nc !< tableau qui contient les class des var choisies
49	character(len=1),dimension(nnc) :: ntype_nc !< tableau qui contient les type des noeuds des var choisies
50	character(len=20),dimension(nnc) :: namevar !< nom de la variable
51
52	! caracteristiques definies dans Description_Variables.dat
53	integer :: ilin !< numero d'apparition dans Description_Variables.dat
54	character(len=100),dimension(nnc) :: longnamevar !< nom long de la variable
55	character(len=100),dimension(nnc) :: standardnamevar !< nom standard de la variable
56	character(len=20), dimension(nnc) :: unitsvar !< unite de la variable
57	character(len=200),dimension(nnc) :: descripvar !< descrition de la variable
58
59	! aspects sorties temporelle
60	integer,dimension(nnc) :: interv !< entier qui code quel dtsortie utiliser
61	integer,dimension(nnc) :: isort_time_ncdf !< 1 si sortie au temps time
62	integer,dimension(nnc) :: isortie=0 !< si isortie=0, pas de sortie du tout.
63	real, dimension(nnc) :: dtsortvar_ncdf !< pas de temps de sortie de chaque variable corres
64	character(len=20),dimension(nnc) :: varname !< le nom de la variable (lu dans LISTE-VAR-NETCDF.dat)
65
66
67	! dimensions des differents tableaux selon majeur,mineur ... dimensions pour routines netcdf
68	character(len=20),dimension(3) :: dimnames2dxymaj !< pour tableau 2d pour les noeud majeur
69	character(len=20),dimension(3) :: dimnames2dxmin !< pour tableau 2d pour les noeud x mineur
70	character(len=20),dimension(3) :: dimnames2dymin !< pour tableau 2d pour les noeud y mineur
71	character(len=20),dimension(3) :: dimnames2dxymin !< pour tableau 2d pour les noeud mineur
72
73
74	! pour les variables 3 d
75	character(len=20),dimension(4) :: dimnames3dxymaj !< pour 3d troisieme dim est nz
76	character(len=20),dimension(4) :: dimnames3dxmin !< pour 3d troisieme dim est nz
77	character(len=20),dimension(4) :: dimnames3dymin !< pour 3d troisieme dim est nz
78	character(len=20),dimension(4) :: dimnames3dxymin !< pour 3d troisieme dim est nz
79	character(len=20),dimension(4) :: dimnames3dbis !< pour 3d troisieme dim est nz+nzm
80
81
82	! definition des pas de temps de sortie
83	integer :: ndtsortie_ncdf !< nombre de dtsortie ncdf
84	integer :: npredeft !< nombre de temps de sortie ncdf predefinis
85	integer :: iglob_ncdf=0
86	integer :: tsortie !< indice dans le tableau dtsortie_ncdf
87	real,dimension(:),allocatable :: predef_tsort !< tableau des temps predefinis pour sorties
88	double precision, dimension(:),allocatable :: dtsortie_ncdf!< tableau des dtsortie : dimension (ndtsortie_ncdf)
89
90
91	! caracteristiques allocatables
92
93	integer:: nptypenode !< nombre de type de node a sortir
94	character (len=1),dimension(:,:),allocatable ::type_node !< tableau des type des noeuds
95
96	integer :: class_var !< class de variable qu'on veut sortir
97	integer :: nclassout !< nombre de class a sortir
98	integer,dimension(:),allocatable :: class_var_out !< tableau des class a sortir
99
100	!character(len=5) ::node_var !< type de noeud sur lequel on sort nos variables
101	integer,dimension(:),allocatable :: nbsnap !< numero du snapshot dans le fichier
102	integer,dimension(:),allocatable :: logic_snap
103	integer,dimension(:),allocatable :: nbsnap_max !< nb max de snapshots par fichier
104
105	!< dans les sortie netcdf
106	!< pour limiter le nombre de snapshots par fichier a nsnap_max,
107	!< on numerote les archives netcdf
108	!< au fur et a mesure des besoins
109
110	integer,dimension(:),allocatable:: nrecs !< compteur pour les enregistrements temps
111	!< des variables dans chaque fichier
112	integer,dimension(:),allocatable:: idef_time !< 1 ou 0 si le temp est defini ou non
113	integer,dimension(:,:),allocatable:: idef !< 1 ou 0 si la varaible est defini ou non
114	integer,dimension(:),allocatable :: num_ncdf_file !< compteur des fichiers netcdf par class
115
116	real*8, dimension(:,:), pointer :: tab => null() !< tableau 2d real ecrit dans le fichier
117	real*8, dimension(:,:,:), pointer :: tab1 => null() !< tableau 3d real
118	real*8, dimension(:,:,:), pointer :: tab1T => null() !< tableau 3d real pour la temperature
119
120
121
122
123	! variables de travail (lectures, ...)
124	!______________________________________
125
126	! pour les lectures de variables (valeurs mises ensuite dans des tableaux)
127	character (len = 100) :: long_name !< long name of the given variable
128	character (len = 100) :: standard_name !< standard name of the given variable
129	character (len = 20) :: unit !< unit of the given variable
130	character (len = 200) :: descriptions !< description of the given variable
131
132	character(len=20) ::charint !< character de la tranche de temps dans le netcdf
133	integer :: itab !< numero de tableau
134	integer :: ntab !< nombre de tableaux
135	integer :: cdftest !< pour declancher une sortie netcdf
136	integer :: posis=0
137
138
139	character(len=20),dimension(nnc) :: name_file_var !< nom du fichier ! A enlever ??
140	character(len=20) :: name !< nom de variable
141	character (len=10) :: comment !< variable de travail
142	integer,parameter :: nvar = nnc !< nombre maxi de variables dans liste-var-netcdf.dat
143	character (len=10) :: varchar
144	integer :: varnum
145
146
147	contains
148
149
150	!> Subroutine initialise the list of variables to write in the netcdf file
151	!<
152
153	subroutine init_out_ncdf
154
155	implicit none
156	integer :: err
157	integer :: num_file=22
158	integer :: i1,i2,i3
159	integer :: i,j,k
160	character(len=20) :: name1
161	character(len=20) :: name2
162	character (len=5) :: nodetype ! centered or staggered
163	integer :: nsnap ! maximum number of snapshots per nc file
164	character (len=100) :: long
165	character (len=100) :: standard
166	character (len=20) :: units
167	character (len=200) :: descrip
168
169
170	if (ncdf_type.eq.0) call lect_netcdf_type !< pour lire la valeur de nccdf_type (machine dependant)
171
172	! initialise les tableaux
173	!----------------------------
174	! dtsortie_ncdf, predef_tsort
175	! isortie,interv,dtsortvar_ncdf,varname
176
177	! lecture des pas de temps de sortie
178	!------------------------------------
179	! open(num_file,file='../'//trim(dirsource)//'/Fichiers-parametres/'//geoplace//'_TEMPS-NETCDF.dat')
180	open(num_file,file=trim(dirsource)//'/Fichiers-parametres/'//geoplace//'_TEMPS-NETCDF.dat',status='old')
181
182
183	! passe les commentaires qui se terminent par une ligne de ~~~
184	comment1: do k=1,500
185	read(num_file,'(a10)') comment
186	if (comment.eq.'~~~~~~~~~~') exit comment1
187	end do comment1
188
189	! lecture de la class des variables a sortir
190	read(num_file,*) nclassout
191
192	if (.not.allocated(class_var_out) .and. .not.allocated(nbsnap_max) .and. .not.allocated(logic_snap)) then
193	allocate(class_var_out(nclassout), nbsnap_max(nclassout), logic_snap(nclassout))
194	logic_snap=0
195	end if
196
197	read(num_file,*) class_var_out
198
199	read(num_file,*) ! saute une ligne
200	! lecture frequences de sortie
201	read(num_file,*) ndtsortie_ncdf
202
203	if (.not.allocated(dtsortie_ncdf)) then
204	allocate(dtsortie_ncdf(ndtsortie_ncdf))
205	end if
206
207	do k=1,ndtsortie_ncdf
208	read(num_file,*) dtsortie_ncdf(k)
209	end do
210
211	read(num_file,*) ! saute une ligne
212	! lecture pas de temps predefinis
213	read(num_file,*) npredeft
214
215	if (.not.allocated(predef_tsort)) then
216	allocate(predef_tsort(npredeft),stat=err)
217	if (err/=0) then
218	print *,"erreur a l'allocation du tableau dt-out_netcdf ",err
219	stop 4
220	end if
221	end if
222
223	do k=1,npredeft
224	read(num_file,*) predef_tsort(k)
225	end do
226
227	comment3: do k=1,500
228	read(num_file,'(a10)') comment
229	if (comment.eq.'----------') exit comment3
230	end do comment3
231
232	close(num_file)
233
234	! lecture des variables et de leur frequence de sortie
235	!-----------------------------------------------------------
236
237	! open(num_file,file='../'//trim(dirsource)//'/Fichiers-parametres/'//geoplace//'_LISTE-VAR-NETCDF.dat')
238	open(num_file,file=trim(dirsource)//'/Fichiers-parametres/'//geoplace//'_LISTE-VAR-NETCDF.dat')
239
240	!saute les commentaires
241	comment2: do k=1,500
242	read(num_file,'(a10)') comment
243	if (comment.eq.'~~~~~~~~~~') exit comment2
244	end do comment2
245
246	! allocate the array of node types
247	if (.not.allocated(type_node)) then
248	allocate(type_node(nclassout,4))
249	end if
250
251	read(num_file,*) !Saut du premier ========
252
253	do
254	read(num_file,*,end=530,err=510) class_var,nsnap,nptypenode
255
256	classout:do j=1,nclassout
257	if (class_var_out(j) .eq. class_var) then
258	nbsnap_max(j)= nsnap
259	read(num_file,*,end=530,err=510) type_node(j,1:nptypenode)
260	read(num_file,*,end=530,err=510) !pour le saut de ligne
261
262	do k=1,200
263	read(num_file,*,end=530,err=510) varchar
264	if (varchar .eq. "==========") then
265	go to 520
266	end if
267	read(num_file,*,end=530,err=510) varnum
268	read(num_file,*,end=530,err=510) i1,i2,i3
269	varname(varnum)=varchar
270	isortie(varnum)=i1
271	tsortie=i2
272	interv(varnum)=i3
273	if ((tsortie.gt.0).and.(tsortie.le.ndtsortie_ncdf)) then
274	dtsortvar_ncdf(varnum)=dtsortie_ncdf(tsortie)
275	else
276	dtsortvar_ncdf(varnum)=-1.e10
277	endif
278	do
279	read(num_file,'(a10)',end=530,err=510) comment
280	if (comment.eq.'----------') exit !pour le saut des commentaires
281	end do
282	!read(num_file,*) !pour saut de ligne
283	end do
284	end if
285	end do classout
286	510 continue
287	comment4: do k=1,500
288	read(num_file,'(a10)',end=530,err=510) comment
289	if (comment.eq.'==========') exit comment4
290	end do comment4
291	520 continue
292	end do
293	530 continue
294	close (num_file)
295
296	! lecture des nom des tableaux a sortir en netcdf
297
298	!open(num_file,file='../'//trim(dirsource)//'/Netcdf-routines/Description_Variables.dat')
299	open(num_file,file=trim(dirsource)//'/Netcdf-routines/Description_Variables.dat')
300
301	do !saut des commentaires et des variables 1D
302	read(num_file,'(a10)') comment
303	if (comment.eq.'==========') exit
304	end do
305
306	ilin=0
307
308	do
309	read(num_file,*,end=230,err=210) name2
310	if (name2 .eq. '--------------------') then
311	go to 220
312	end if
313	read(num_file,*) i2, name1,i2
314	classoutt: do j=1,nclassout
315	if (i2.eq.class_var_out(j)) then
316	read(num_file,*,end=230,err=210) nodetype
317	read(num_file,*,end=230,err=210) long
318	read(num_file,*,end=230,err=210) standard
319	read(num_file,*,end=230,err=210) units
320	read(num_file,*,end=230,err=210) descrip
321
322	! boucle sur les numeros de variables. C'est le nom name1 qui va retrouver le numero
323	boucle_var: do i=1,nvar
324	if (varname(i).eq.name1)then
325	i3=isortie(i)
326	i1=i
327	go to 200
328	else
329	i3=0
330	end if
331	end do boucle_var
332	200 continue
333	if (i3 .eq. 1) then
334	do k=1,nptypenode ! recherche le type de noeud k, dans ceux ouverts pour la classe j
335	if ( type_node(j,k) .eq. nodetype ) then
336	ilin=ilin+1
337	ivar_nc(ilin)=i1
338	cvar_nc(ilin)=i2
339	ntype_nc(ilin)=nodetype
340	namevar(ilin)=name1
341	name_file_var(ilin)=name2
342	longnamevar(ilin)=long
343	standardnamevar(ilin)=standard
344	unitsvar(ilin)=units
345	descripvar(ilin)=descrip
346	! if (itracebug.eq.1) write(num_tracebug,*) ilin,namevar(ilin)
347
348	end if
349
350	end do
351	end if
352	if (ilin.eq.nnc) exit ! nnc parameter nombre max de variables
353	go to 220
354	end if
355	end do classoutt
356	210 continue
357	do
358	read(num_file,'(a10)',end=230,err=210) comment
359	if (comment.eq.'----------') exit
360	end do
361	220 continue
362	end do
363	230 ntab=ilin
364	close(num_file)
365
366	return
367	end subroutine init_out_ncdf
368
369	!> Subroutine test for all variables if the netcdf output is done at a given time
370	!! @param tsortie = time of output
371	!<
372
373	subroutine testsort_time_ncdf(tsortie)
374
375	implicit none
376	!< local variables
377	double precision :: tsortie
378	real :: difftime !< difference tsortie-predef_tsort(npr)
379	real :: debtime !< difference abs(tsortie-tbegin)
380	real :: fintime !< difference abs(tsortie-tend)
381	integer :: ipredef
382	integer :: ideb
383	integer :: ifin
384	integer :: npr
385	integer :: i !< indices de travail
386
387	if (itracebug.eq.1) call tracebug(' Entree dans routine testsort_time_ncdf')
388	isort_time_ncdf(:)=0
389	! recherche si ce pas de temps est un pas de temps predefini
390	ipredef=0
391	ideb=0
392	ifin=0
393
394	predef: do npr=1,npredeft
395	difftime=abs(tsortie-predef_tsort(npr))
396	if (difftime.lt.dtmin) then
397	ipredef=1
398	exit predef
399	end if
400	debtime=abs(tsortie-tbegin)
401	fintime=abs(tsortie-tend)
402
403	if ((debtime.lt.dtmin).or.(nt.eq.1)) ideb=1
404	if (fintime.lt.dtmin) ifin=1
405	end do predef
406
407	! boucle sur les numeros de variables
408	boucle_var: do i=1,ntab
409
410	! if (itracebug.eq.1) write(num_tracebug,*)' var :',i,' boucle sur ',ntab
411
412	if (isortie(ivar_nc(i)).eq.0) then ! variables non attribuees et
413	! variables ou isortie est explicitement 0
414	isort_time_ncdf(ivar_nc(i))=0
415	else ! variables dont on veut la sortie
416
417	if (dtsortvar_ncdf(ivar_nc(i)).eq. -1.e10) then
418
419	if ((interv(ivar_nc(i)).eq.-1)) then
420	! premier+dernier
421	if ((ideb .eq.1).or.(ifin.eq.1)) then
422	isort_time_ncdf(ivar_nc(i))=1
423	end if
424	end if
425
426	if (interv(ivar_nc(i)).eq.0) then
427	! ne sort que le premier pas de temps
428	if (ideb .eq.1) then
429	isort_time_ncdf(ivar_nc(i))=1
430	end if
431	end if
432
433	if ((interv(ivar_nc(i)).eq.1)) then
434	! premier + dernier + predefinis
435	if ((ipredef.eq.1)) then
436	isort_time_ncdf(ivar_nc(i))=1
437	else if (ideb .eq.1) then
438	isort_time_ncdf(ivar_nc(i))=1
439	else if (ifin.eq.1) then
440	isort_time_ncdf(ivar_nc(i))=1
441	end if
442	end if
443
444	else
445
446	if ((interv(ivar_nc(i)).eq.-1)) then
447	! premier+dernier
448	if ((ideb .eq.1).or.(ifin.eq.1)) then
449	isort_time_ncdf(ivar_nc(i))=1
450	end if
451	end if
452
453	if (interv(ivar_nc(i)).eq.0) then
454	! ne sort que le premier pas de temps
455	if (ideb .eq.1) then
456	isort_time_ncdf(ivar_nc(i))=1
457	end if
458	end if
459
460	if ((interv(ivar_nc(i)).eq.1)) then
461	! premier + dernier + predefinis
462	if ((ipredef.eq.1)) then
463	isort_time_ncdf(ivar_nc(i))=1
464	else if (ideb .eq.1) then
465	isort_time_ncdf(ivar_nc(i))=1
466	else if (ifin.eq.1) then
467	isort_time_ncdf(ivar_nc(i))=1
468	end if
469	end if
470
471	if (mod(abs(tsortie),dtsortvar_ncdf(ivar_nc(i))).lt.dble(dtmin)) then
472	isort_time_ncdf(ivar_nc(i))=1
473	end if
474
475	end if
476	endif
477
478	end do boucle_var
479
480	iglob_ncdf=maxval(isort_time_ncdf)
481
482	return
483
484	end subroutine testsort_time_ncdf
485
486	!> subroutine initialise netcdf file
487	!<
488	subroutine init_sortie_ncdf
489
490	implicit none
491
492	integer :: j
493	character(len=2) :: class,numero
494
495
496	if (itracebug.eq.1) call tracebug(' Entree dans routine init_sortie_ncdf')
497
498	if (.not.allocated(basename) .and. .not.allocated(fil_sortie) .and. .not.allocated(ncid) &
499	.and. .not.allocated(status) ) then
500	allocate(basename(nclassout),fil_sortie(nclassout) &
501	,ncid(nclassout), status(nclassout))
502	end if
503
504	if (.not.allocated(nrecs) .and. .not.allocated(nbsnap) .and. .not.allocated(num_ncdf_file) &
505	.and. .not. allocated(idef) .and. .not. allocated(idef_time)) then
506	allocate(nrecs(nclassout),nbsnap(nclassout),num_ncdf_file(nclassout),idef(nclassout,ntab),idef_time(nclassout))
507	nrecs=1
508	idef=0
509	idef_time=0
510	num_ncdf_file=0
511	end if
512
513	if (maxval(logic_snap) .eq. 0) then
514	do j=1,nclassout
515	nrecs(j)=1
516	idef(j,:)=0
517	idef_time(j)=0
518	nbsnap(j)=0
519	! numerote le fichier sortie
520	num_ncdf_file(j)=num_ncdf_file(j)+1
521	! numerotation pour le nom de fichier
522	write(numero,'(i2.2)') num_ncdf_file(j)
523	write (class,'(i2.2)') class_var_out(j)
524
525	!basename(j)=trim(dirnameout)//'Netcdf-Resu/'//runname//'_class'//class//'_'//numero
526	basename(j)=trim(dirnameout)//runname//'_class'//class//'_'//numero
527	fil_sortie(j)=trim(basename(j))//'.nc'
528	! 4 go a revoir
529	!status = nf90_create(trim(fil_sortie),and(nf90_write,nf90_64bit_offset,nf90_hdf5),ncid)
530
531	if (ncdf_type.eq.32) then
532	status(j) = nf90_create(trim(fil_sortie(j)),nf90_write,ncid(j)) ! creation du fichier
533	else if (ncdf_type.eq.64) then
534	status(j) = nf90_create(trim(fil_sortie(j)),and(nf90_write,nf90_64bit_offset),ncid(j)) ! r2d2
535	else
536	write(6,*)'pb de valeur de netcdf_type dans sortie_netcdf :',ncdf_type
537	endif
538
539	status(j) = nf90_close(ncid(j)) ! fermeture
540
541
542
543	call write_ncdf_dim('x',trim(fil_sortie(j)),nx) ! dimensions des variables/tableaux noeud majeur en x
544	call write_ncdf_dim('y',trim(fil_sortie(j)),ny) ! dimensions des variables/tableaux noeud majeur en y
545
546	call write_ncdf_dim('x1',trim(fil_sortie(j)),nx) ! dimensions des variables/tableaux noeud mineur en x
547	call write_ncdf_dim('y1',trim(fil_sortie(j)),ny) ! dimensions des variables/tableaux noeud mineur en y
548
549	! pour les variables 3d
550	call write_ncdf_dim('z',trim(fil_sortie(j)),nz)
551	call write_ncdf_dim('nzzm',trim(fil_sortie(j)),nz+nzm)
552	!----------------------------------------------------
553	call write_ncdf_dim('time',trim(fil_sortie(j)),0)
554	end do
555
556	else
557	nrecs(posis)=1
558	idef(posis,:)=0
559	idef_time(posis)=0
560	nbsnap(posis)=0
561	! numerote le fichier sortie
562	num_ncdf_file(posis)=num_ncdf_file(posis)+1
563	! numerotation pour le nom de fichier
564	write(numero,'(i2.2)') num_ncdf_file(posis)
565	write (class,'(i2.2)') class_var_out(posis)
566
567	!basename(posis)=trim(dirnameout)//'Netcdf-Resu/'//runname//'_class'//class//'_'//numero
568	basename(posis)=trim(dirnameout)//runname//'_class'//class//'_'//numero
569	fil_sortie(posis)=trim(basename(posis))//'.nc'
570	! 4 go a revoir
571	!status = nf90_create(trim(fil_sortie),and(nf90_write,nf90_64bit_offset,nf90_hdf5),ncid)
572
573	if (ncdf_type.eq.32) then
574	status(posis) = nf90_create(trim(fil_sortie(posis)),nf90_write,ncid(posis)) ! creation du fichier
575	else if (ncdf_type.eq.64) then
576	status(posis) = nf90_create(trim(fil_sortie(posis)),and(nf90_write,nf90_64bit_offset),ncid(posis)) !r2d2
577	else
578	write(6,*)'pb de valeur de netcdf_type dans sortie_netcdf :', ncdf_type
579	endif
580
581
582
583
584	status(posis) = nf90_close(ncid(posis)) ! fermeture
585
586	call write_ncdf_dim('x',trim(fil_sortie(posis)),nx) ! dimensions des variables/tableaux noeud majeur en x
587	call write_ncdf_dim('y',trim(fil_sortie(posis)),ny) ! dimensions des variables/tableaux noeud majeur en y
588
589	call write_ncdf_dim('x1',trim(fil_sortie(posis)),nx) ! dimensions des variables/tableaux noeud mineur en x
590	call write_ncdf_dim('y1',trim(fil_sortie(posis)),ny) ! dimensions des variables/tableaux noeud mineur en y
591
592	call write_ncdf_dim('z',trim(fil_sortie(posis)),nz)
593	call write_ncdf_dim('nzzm',trim(fil_sortie(posis)),nz+nzm)
594	call write_ncdf_dim('time',trim(fil_sortie(posis)),0)
595
596	logic_snap(posis)=0
597
598	end if
599
600	! ecriture d'un tableau tab 2d
601	dimnames2dxymaj(1)='x'
602	dimnames2dxymaj(2)='y'
603	dimnames2dxymaj(3)='time'
604
605
606	dimnames2dxmin(1)='x1'
607	dimnames2dxmin(2)='y'
608	dimnames2dxmin(3)='time'
609
610
611	dimnames2dymin(1)='x'
612	dimnames2dymin(2)='y1'
613	dimnames2dymin(3)='time'
614
615	dimnames2dxymin(1)='x1'
616	dimnames2dxymin(2)='y1'
617	dimnames2dxymin(3)='time'
618
619	! pour les variables 3d a voir apres
620	dimnames3dxymaj(1)='x'
621	dimnames3dxymaj(2)='y'
622	dimnames3dxymaj(3)='z'
623	dimnames3dxymaj(4)='time'
624
625	dimnames3dxmin(1)='x1'
626	dimnames3dxmin(2)='y'
627	dimnames3dxmin(3)='z'
628	dimnames3dxmin(4)='time'
629
630	dimnames3dymin(1)='x'
631	dimnames3dymin(2)='y1'
632	dimnames3dymin(3)='z'
633	dimnames3dymin(4)='time'
634
635	dimnames3dxymin(1)='x1'
636	dimnames3dxymin(2)='y1'
637	dimnames3dxymin(3)='z'
638	dimnames3dxymin(4)='time'
639
640	dimnames3dbis(1)='x'
641	dimnames3dbis(2)='y'
642	dimnames3dbis(3)='nzzm'
643	dimnames3dbis(4)='time'
644
645	end subroutine init_sortie_ncdf
646
647
648	!>subroutine write the netcdf results
649	!<
650
651	subroutine sortie_ncdf_cat
652	implicit none
653	real (kind=kind(0.d0)) :: timetmp !< variable intermediaire
654	character(len=20) :: nametmp !< nom intermediaire
655	real*8,pointer,dimension(:) :: liste_time => null() !< liste des snapshot des variables ecrites en netcdf
656	real*8,pointer,dimension(:) :: x,y,x1,y1,z,nzzm
657	real*8,pointer,dimension(:,:):: lat,lon => null()
658	integer :: i,j,l,k,p
659	logical :: fait
660
661
662	! instructions
663	if (itracebug.eq.1) call tracebug(' Entree dans routine sortie_netcdf_cat')
664
665
666	! new version of netcdf output in order to be compatible with
667	! ferret conventions
668
669	! if ( time .le. 0. ) then
670	! timetmp = -time
671	! nametmp = 'p_'
672	! else
673	timetmp = time
674	nametmp = 'f_'
675	! endif
676
677	if (.not.associated(tab)) allocate(tab(nx,ny))
678	if (.not.associated(tab1)) allocate(tab1(nx,ny,nz))
679	if (.not.associated(tab1T)) allocate(tab1T(nx,ny,nz+nzm))
680
681	if (.not.associated(liste_time)) then
682	allocate(liste_time(1))
683	liste_time(1)=-1
684	end if
685
686	liste_times: if ((liste_time(1) .ne.timetmp) .or.(liste_time(1) .eq. -1) ) then
687	liste_time(1)= timetmp
688	! print*,"time outncdf=",liste_time(1)
689	write(charint,'(i0)') floor(timetmp)
690	nametmp = trim(nametmp)//trim(charint)//'_'
691	timetmp = 100.*(timetmp - floor(timetmp))
692
693	write(charint,'(i0)') floor(timetmp)
694	nametmp = trim(nametmp)//trim(charint)
695
696	!commentaire cytise
697	write(charint,'(f0.3)') time
698
699	classes_files: do k=1,nclassout
700
701	! Rajoute par Micha
702
703	if (.not.allocated(nbsnap) ) then
704	call init_sortie_ncdf
705	end if
706
707	! fin de la modif Micha
708
709	if (nbsnap(k).ge.nbsnap_max(k)) then ! test si on a depasse le nombre de snapshots
710	logic_snap(k)=1
711	posis=k
712	call init_sortie_ncdf
713	end if
714
715
716
717	! Write_Ncdf_var is the generic name for the ncdf subroutines that write variables.
718	! write_ncdf_var(varname,dimname,file,tabvar,typevar)
719
720	! ecrit le temps
721	call write_ncdf_var('time','time',trim(fil_sortie(k)),liste_time,nbsnap(k)+1,idef_time(k),'double')
722
723	fait = .FALSE.
724
725	boucle_var: do l=1,ntab
726
727	! if (itracebug.eq.1) write(num_tracebug,*)' var :',l,' dans netcdf_cat boucle_var ',ntab
728
729	if (cvar_nc(l) .eq. class_var_out(k)) then
730	itab=ivar_nc(l)
731	! les numeros dans ces tests doivent correspondre
732	! au premier numero de chaque ligne de liste_tab_ncdf.dat
733	if (itab.eq.1) then
734	tab(:,:) = s(:,:)
735	end if
736	if (itab.eq.2) then
737	tab(:,:) = h(:,:)
738	end if
739	if (itab.eq.3) then
740	tab(:,:) = bsoc(:,:)
741	end if
742	if (itab.eq.4) then
743	tab(:,:) = mk(:,:)
744	end if
745	if (itab.eq.5) then
746	tab(:,:) = hdot(:,:)
747	end if
748	if (itab.eq.6) then
749	tab(:,:) = s(:,:)-s0(:,:)
750	end if
751	if (itab.eq.7) then
752	tab(:,:) = b(:,:)
753	end if
754	if (itab.eq.8) then
755	tab(:,:) = socle_cry(:,:)
756	end if
757	if (itab.eq.9) then
758	tab(:,:) = mk_init(:,:)
759	end if
760	if (itab.eq.10) then
761	tab(:,:) = bm(:,:)
762	end if
763	if (itab.eq.11) then
764	tab(:,:) = acc(:,:)
765	end if
766	if (itab.eq.12) then
767	tab(:,:) = bm(:,:)-acc(:,:)
768	end if
769	if (itab.eq.13) then
770	tab(:,:) = calv(:,:)
771	end if
772	if (itab.eq.14) then
773	tab(:,:) = dhdt(:,:)
774	end if
775	if (itab.eq.15) then
776	tab(:,:) = bm(:,:)-bmelt(:,:)
777	end if
778	if (itab.eq.16) then
779	where (mk.gt.0)
780	tab(:,:) = bm(:,:)-bmelt(:,:)
781	elsewhere
782	tab(:,:)=-9999
783	end where
784	end if
785	if (itab.eq.18) then
786	tab(:,:) = tann(:,:)
787	end if
788	if (itab.eq.19) then
789	tab(:,:) = tjuly(:,:)
790	end if
791	if (itab.eq.20) then
792	tab(:,:) = t(:,:,nz)-tpmp(:,:,nz)
793	end if
794	if (itab.eq.23) then
795	tab(:,:) = -3.17098e-05*ghf(:,:)
796	end if
797	if (itab.eq.24) then
798	tab(:,:) = phid(:,:)*3.17098e-05
799	end if
800	if (itab.eq.25) then
801	tab(:,:) = bmelt(:,:)
802	end if
803	if (itab.eq.30) then
804	tab(:,:) = ((uxbar(:,:)+eoshift(uxbar(:,:),shift=1,boundary=0.,dim=1))*0.5)
805	end if
806	if (itab.eq.31) then
807	tab(:,:) = ((uybar(:,:)+eoshift(uybar(:,:),shift=1,boundary=0.,dim=2))*0.5)
808	end if
809	if (itab.eq.32) then
810	tab(:,:) = uxbar(:,:)
811	end if
812	if (itab.eq.33) then
813	tab(:,:) = uybar(:,:)
814	end if
815	if (itab.eq.34) then
816	tab(:,:) = ux(:,:,nz)
817	end if
818	if (itab.eq.35) then
819	tab(:,:) = uy(:,:,nz)
820	end if
821	if (itab.eq.36) then
822	tab(:,:) = (((uxbar(:,:)+eoshift(uxbar(:,:),shift=1,boundary=0.,dim=1))**2+ &
823	(uybar(:,:)+eoshift(uybar(:,:),shift=1,boundary=0.,dim=2))2)0.5)*0.5
824	end if
825	if (itab.eq.37) then
826	tab(:,:) = (((ux(:,:,nz)+eoshift(ux(:,:,nz),shift=1,boundary=0.,dim=1))**2+ &
827	(uy(:,:,nz)+eoshift(uy(:,:,nz),shift=1,boundary=0.,dim=2))2)0.5)*0.5
828	end if
829	if (itab.eq.38) then
830	tab(:,:) = ux(:,:,1)-ux(:,:,nz)
831	end if
832	if (itab.eq.39) then
833	tab(:,:) = uy(:,:,1)-uy(:,:,nz)
834	end if
835
836	if (itab.eq.40) then
837	tab(:,:) = frotmx(:,:)
838	end if
839	if (itab.eq.41) then
840	tab(:,:) = frotmy(:,:)
841	end if
842	if (itab.eq.42) then
843	tab(:,:) = tobmx(:,:)
844	end if
845	if (itab.eq.43) then
846	tab(:,:) = tobmy(:,:)
847	end if
848	if (itab.eq.44) then
849	tab(:,:) = taushelf(:,:)
850	end if
851	if (itab.eq.45) then
852	tab(:,:) = epsxx(:,:)
853	end if
854	if (itab.eq.46) then
855	tab(:,:) = epsyy(:,:)
856	end if
857	if (itab.eq.47) then
858	tab(:,:) = epsxy(:,:)
859	end if
860	if (itab.eq.48) then
861	tab(:,:) = eps(:,:)
862	end if
863	if (itab.eq.49) then
864	tab(:,:) = Abar(:,:)
865	end if
866	if (itab.eq.50) then
867	tab(:,:) = pvi(:,:)
868	end if
869	if (itab.eq.51) then
870	tab(:,:) = pvm(:,:)
871	end if
872	if (itab.eq.52) then
873	tab(:,:) = betamx(:,:)
874	end if
875	if (itab.eq.53) then
876	tab(:,:) = betamy(:,:)
877	endif
878
879	if (itracebug.eq.1) call tracebug(' avant appel beta_centre')
880
881
882	if (itab.eq.54) then
883	tab(:,:) = beta_centre(:,:)
884	endif
885	if (itab.eq.60) then
886	tab(:,:) = hwater(:,:)
887	end if
888	if (itab.eq.61) then
889	tab(:,:) = hdotwater(:,:)
890	end if
891	if (itab.eq.62) then
892	tab(:,:) = pgx(:,:)
893	end if
894	if (itab.eq.63) then
895	tab(:,:) = pgy(:,:)
896	end if
897	if (itab.eq.64) then
898	tab(:,:) = kond(:,:)
899	end if
900	if (itab.eq.65) then
901	tab(:,:) = phiwx(:,:)
902	end if
903	if (itab.eq.66) then
904	tab(:,:) = phiwy(:,:)
905	end if
906	if (itab.eq.68) then
907	tab(:,:) = neffmx(:,:)
908	end if
909	if (itab.eq.69) then
910	tab(:,:) = neffmy(:,:)
911	end if
912
913	if (itab.eq.70) then ! posx : grounded -> 0, , grzone ->1 ilemx->2 flot->3
914	do j=1,ny
915	do i=1,nx
916	if (gzmx(i,j)) then
917	if (ilemx(i,j)) then ! ile
918	tab(i,j)=2
919	else
920	tab(i,j)=1 ! grounded zone
921	endif
922	else if (flotmx(i,j)) then ! flottant
923	if (hmx(i,j).gt.1.) then
924	tab(i,j)=3
925	else
926	tab(i,j)=4
927	endif
928	else ! pose
929	tab(i,j)=0
930	endif
931	end do
932	end do
933	end if
934	if (itab.eq.71) then ! posy : grounded -> 0, , grzone ->1 ilemx->2 flot->3
935	do j=1,ny
936	do i=1,nx
937	if (gzmy(i,j)) then
938	if (ilemy(i,j)) then
939	tab(i,j)=2
940	else
941	tab(i,j)=1
942	endif
943	else if (flotmy(i,j)) then
944	if (hmy(i,j).gt.1.) then
945	tab(i,j)=3
946	else
947	tab(i,j)=4
948	endif
949	else
950	tab(i,j)=0
951	endif
952	end do
953	end do
954	end if
955	if (itab.eq.72) then
956	tab(:,:) = frontfacex(:,:)
957	end if
958	if (itab.eq.73) then
959	tab(:,:) = frontfacey(:,:)
960	end if
961
962	!SORTIE 3D
963
964	if (itab.eq.74) then
965	!tab1(:,:,:)=CP(:,:,:) A voir declarer dans ice temp declar
966	end if
967
968	if (itab.eq.75) then
969	!tab1(:,:,:)=CT(:,:,:) A voir declarer dans ice temp declar
970	end if
971
972	if (itab.eq.76) then
973	tab1(:,:,:)=SUX(:,:,:)
974	end if
975
976	if (itab.eq.77) then
977	tab1(:,:,:)=SUY(:,:,:)
978	end if
979
980	if (itab.eq.78) then
981	tab1(:,:,:)=TPMP(:,:,:)
982	end if
983
984	if (itab.eq.79) then
985	tab1(:,:,:)=UX(:,:,:)
986	end if
987
988	if (itab.eq.80) then
989	tab1(:,:,:)=UY(:,:,:)
990	end if
991
992	if (itab.eq.81) then
993	tab1(:,:,:)=UZR(:,:,:)
994	end if
995
996	if (itab.eq.82) then
997	!tab1(:,:,:)=Chaldef_maj(:,:,:) A voir declarer dans ice temp declar
998	end if
999
1000	if (itab.eq.83) then
1001	tab1T(:,:,:)= t(:,:,:)
1002	end if
1003
1004	if (itab.eq.84) then
1005	tab1(:,:,:)= xdep_out(:,:,:) ! aurel neem
1006	end if
1007	if (itab.eq.85) then
1008	tab1(:,:,:)= ydep_out(:,:,:) ! aurel neem
1009	end if
1010	if (itab.eq.86) then
1011	tab1(:,:,:)= tdep_out(:,:,:) ! aurel neem
1012	end if
1013
1014	! if (itab.eq.100) then ! vitesse de surface amplitude
1015	! tab(:,:)= sqrt(ux(:,:,1)ux(:,:,1)+uy(:,:,1)uy(:,:,1)) ! aurel neem
1016	! end if
1017
1018	! sorties pour debug
1019	! if (itab.eq.101) tab(:,:) = debug_3d(:,:,1)
1020
1021	debug_loop : do i_debug=101,nnc-1
1022	if (itab.eq.i_debug) then
1023	tab(:,:)=debug_3d(:,:,itab-100)
1024	exit debug_loop
1025	endif
1026	end do debug_loop
1027
1028	name =trim(namevar(l))
1029
1030	if (isort_time_ncdf(itab).eq.1) then
1031
1032	! pour les classe 3, sortir les champs 2D necessaires
1033
1034	if ((cvar_nc(l) .eq. 3 ).and.( fait .eqv. .FALSE.)) then
1035
1036	boucle_var2: do p=1,ntab
1037	! if (itracebug.eq.1) write(num_tracebug,*)' var :',p,' dans netcdf_cat boucle_var2 '
1038
1039	if (ivar_nc(p) .eq. 1) then
1040	tab(:,:) = s(:,:)
1041
1042	call write_ncdf_var('S',dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,p),'double')
1043	endif
1044
1045	if (ivar_nc(p) .eq. 2) then
1046	tab(:,:) = h(:,:)
1047	call write_ncdf_var('H',dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,p),'double')
1048	endif
1049
1050	if (ivar_nc(p) .eq. 3) then
1051	tab(:,:) = bsoc(:,:)
1052	call write_ncdf_var('Bsoc',dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,p),'double')
1053	endif
1054
1055	if (ivar_nc(p) .eq. 7) then
1056	tab(:,:) = b(:,:)
1057	call write_ncdf_var('B',dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,p),'double')
1058	exit boucle_var2
1059	endif
1060	end do boucle_var2
1061
1062	fait = .TRUE.
1063
1064	end if
1065
1066	if (ntype_nc(l) .eq. 'o' ) then
1067	if (cvar_nc(l) .eq. 3) then
1068	if (name .eq. 'T') then
1069	CALL Write_Ncdf_var(name,dimnames3dbis,TRIM(fil_sortie(k)),tab1T,nrecs(k),idef(k,l),'double')
1070	else
1071	CALL Write_Ncdf_var(name,dimnames3dxymaj,TRIM(fil_sortie(k)),tab1,nrecs(k),idef(k,l),'double')
1072	end if
1073	else
1074	call write_ncdf_var(name,dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,l),'double')
1075	end if
1076	long_name=longnamevar(l)
1077	standard_name=standardnamevar(l)
1078	unit=unitsvar(l)
1079	descriptions=descripvar(l)
1080	status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf
1081	if (status(k)/=nf90_noerr) then
1082	write(,)"unable to open netcdf file : ",fil_sortie(k)
1083	stop
1084	endif
1085	call ncdf_var_info (status(k),ncid(k),name, long_name, standard_name, unit, descriptions)
1086	status(k) = nf90_close(ncid(k))
1087	else
1088	if (ntype_nc(l) .eq. '>') then
1089	if (cvar_nc(l) .eq. 3) then
1090	CALL Write_Ncdf_var(name,dimnames3dxmin,TRIM(fil_sortie(k)),tab1,nrecs(k),idef(k,l),'double')
1091	else
1092	call write_ncdf_var(name,dimnames2dxmin,trim(fil_sortie(k)),tab,nrecs(k),idef(k,l),'double')
1093	end if
1094	long_name=longnamevar(l)
1095	standard_name=standardnamevar(l)
1096	unit=unitsvar(l)
1097	descriptions=descripvar(l)
1098	status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf
1099	if (status(k)/=nf90_noerr) then
1100	write(,)"unable to open netcdf file : ",fil_sortie(k)
1101	stop
1102	endif
1103	call ncdf_var_info (status(k),ncid(k),name, long_name, standard_name, unit, descriptions)
1104	status(k) = nf90_close(ncid(k))
1105	else
1106	if (ntype_nc(l) .eq. '^') then
1107	if (cvar_nc(l) .eq. 3) then
1108	CALL Write_Ncdf_var(name,dimnames3dymin,TRIM(fil_sortie(k)),tab1,nrecs(k),idef(k,l),'double')
1109	else
1110	call write_ncdf_var(name,dimnames2dymin,trim(fil_sortie(k)),tab,nrecs(k),idef(k,l),'double')
1111	end if
1112	long_name=longnamevar(l)
1113	standard_name=standardnamevar(l)
1114	unit=unitsvar(l)
1115	descriptions=descripvar(l)
1116	status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf
1117	if (status(k)/=nf90_noerr) then
1118	write(,)"unable to open netcdf file : ",fil_sortie(k)
1119	stop
1120	endif
1121	call ncdf_var_info (status(k),ncid(k),name, long_name, standard_name, unit, descriptions)
1122	status(k) = nf90_close(ncid(k))
1123	else
1124	if (ntype_nc(l) .eq. 'x') then
1125	if (cvar_nc(l) .eq. 3) then
1126	CALL Write_Ncdf_var(name,dimnames3dxymin,TRIM(fil_sortie(k)),tab1,nrecs(k),idef(k,l),'double')
1127	else
1128	call write_ncdf_var(name,dimnames2dxymin,trim(fil_sortie(k)),tab,nrecs(k),idef(k,l),'double')
1129	end if
1130	long_name=longnamevar(l)
1131	standard_name=standardnamevar(l)
1132	unit=unitsvar(l)
1133	descriptions=descripvar(l)
1134	status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf
1135	if (status(k)/=nf90_noerr) then
1136	write(,)"unable to open netcdf file : ",fil_sortie(k)
1137	stop
1138	endif
1139	call ncdf_var_info (status(k),ncid(k),name, long_name, standard_name, unit, descriptions)
1140	status(k) = nf90_close(ncid(k))
1141	end if
1142	end if
1143	end if
1144	end if
1145	end if
1146	end if
1147	! if (itracebug.eq.1) write(num_tracebug,*)' classe',k,' dans netcdf_cat boucle_var '
1148
1149	end do boucle_var
1150
1151	! if (itracebug.eq.1) write(num_tracebug,*)'apres boucle var',l,'classe',k
1152
1153	ksnap: if ( nbsnap(k) .eq. 0) then ! pour le faire 1 fois
1154	! if (itracebug.eq.1) write(num_tracebug,*)'avant allocate nbsnap'
1155	allocate(x(nx),y(ny),x1(nx),y1(ny),z(nz),nzzm(nz+nzm),lat(nx,ny),lon(nx,ny))
1156
1157	! attention le xmin est en km, le remettre en m
1158	! write(6,*) 'bornes domaine dans netcdf',xmin,xmax,ymin,ymax
1159	do i=1,nx
1160	x(i)=xmin1000.+(i-1)dx
1161	x1(i)=(xmin1000.+dx/2)+(i-1)dx
1162	end do
1163
1164	do i=1,ny
1165	y(i)=ymin1000.+(i-1)dy
1166	y1(i)=(ymin1000.+dy/2)+(i-1)dy
1167	end do
1168
1169	z(1)=0.
1170	z(nz)=1.
1171	nzzm(1)=0.
1172	nzzm(nz)=1.
1173	do i=1,nz
1174	if ((i.ne.1).and.(i.ne.nz))then
1175	z(i)=(i-1.)/(nz-1.)
1176	nzzm(i)=(i-1.)/(nz-1.)
1177	end if
1178	end do
1179
1180	do i= nz+1 ,nz+nzm
1181	nzzm(i)=i-nz+1
1182	end do
1183
1184	lat(:,:)=ylat(:,:)
1185	lon(:,:)=xlong(:,:)
1186
1187	! open(72,file='../'//trim(dirsource)//'/Netcdf-routines/Description_Variables.dat')
1188	open(72,file=trim(dirsource)//'/Netcdf-routines/Description_Variables.dat')
1189
1190	do
1191	read(72,'(a10)') comment
1192	if (comment.eq.'~~~~~~~~~~') exit
1193	end do
1194	! if (itracebug.eq.1) write(num_tracebug,*)'avant sortie x,y,lon,lat',k
1195
1196	call write_ncdf_var('x','x',trim(fil_sortie(k)),x,'double')
1197	call write_ncdf_var('y','y',trim(fil_sortie(k)),y,'double')
1198
1199	call write_ncdf_var('x1','x1',trim(fil_sortie(k)),x1,'double')
1200	call write_ncdf_var('y1','y1',trim(fil_sortie(k)),y1,'double')
1201
1202	call write_ncdf_var('z','z',trim(fil_sortie(k)),z,'double')
1203	call write_ncdf_var('nzzm','nzzm',trim(fil_sortie(k)),nzzm,'double')
1204
1205	call write_ncdf_var('lat',dimnames2dxymaj ,trim(fil_sortie(k)),lat,'double')
1206	call write_ncdf_var('lon',dimnames2dxymaj ,trim(fil_sortie(k)),lon,'double')
1207
1208	status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf
1209	if (status(k)/=nf90_noerr) then
1210	write(,)"unable to open netcdf file : ",fil_sortie(k)
1211	stop
1212	endif
1213
1214	! lecture des dimensions dans le fichier Description
1215	! time
1216	read(72,*)
1217	read(72,*)
1218	read(72,*)
1219	read(72,*)
1220	read(72,*) long_name
1221	read(72,*) standard_name
1222	read(72,*) unit
1223	read(72,*) descriptions
1224	read(72,*)
1225
1226	call ncdf_var_info (status(k),ncid(k),trim('time'), long_name, standard_name, unit, descriptions)
1227
1228	! x
1229	read(72,*)
1230	read(72,*)
1231	read(72,*)
1232	read(72,*) long_name
1233	read(72,*) standard_name
1234	read(72,*) unit
1235	read(72,*) descriptions
1236	read(72,*)
1237
1238	call ncdf_var_info (status(k),ncid(k),trim('x'), long_name, standard_name, unit, descriptions)
1239
1240	! x1
1241	read(72,*)
1242	read(72,*)
1243	read(72,*)
1244	read(72,*) long_name
1245	read(72,*) standard_name
1246	read(72,*) unit
1247	read(72,*) descriptions
1248	read(72,*)
1249
1250	call ncdf_var_info (status(k),ncid(k),trim('x1'), long_name, standard_name, unit, descriptions)
1251	! y
1252	read(72,*)
1253	read(72,*)
1254	read(72,*)
1255	read(72,*) long_name
1256	read(72,*) standard_name
1257	read(72,*) unit
1258	read(72,*) descriptions
1259	read(72,*)
1260
1261	call ncdf_var_info (status(k),ncid(k),trim('y'), long_name, standard_name, unit, descriptions)
1262	! y1
1263
1264	read(72,*)
1265	read(72,*)
1266	read(72,*)
1267	read(72,*) long_name
1268	read(72,*) standard_name
1269	read(72,*) unit
1270	read(72,*) descriptions
1271	read(72,*)
1272
1273	call ncdf_var_info (status(k),ncid(k),trim('y1'), long_name, standard_name, unit, descriptions)
1274
1275	! sigma coordinate
1276
1277	read(72,*)
1278	read(72,*)
1279	read(72,*)
1280	read(72,*) long_name
1281	read(72,*) standard_name
1282	read(72,*) unit
1283	read(72,*) descriptions
1284	read(72,*)
1285
1286	call ncdf_var_info (status(k),ncid(k),trim('z'), long_name, standard_name, unit, descriptions)
1287
1288	! coordinate in the bedrock
1289
1290	read(72,*)
1291	read(72,*)
1292	read(72,*)
1293	read(72,*) long_name
1294	read(72,*) standard_name
1295	read(72,*) unit
1296	read(72,*) descriptions
1297	read(72,*)
1298
1299	call ncdf_var_info (status(k),ncid(k),trim('nzzm'), long_name, standard_name, unit, descriptions)
1300
1301
1302	read(72,*)
1303	read(72,*)
1304	read(72,*)
1305	read(72,*) long_name
1306	read(72,*) standard_name
1307	read(72,*) unit
1308	read(72,*) descriptions
1309	read(72,*)
1310
1311	call ncdf_var_info (status(k),ncid(k),trim('lat'), long_name, standard_name, unit, descriptions)
1312
1313	read(72,*)
1314	read(72,*)
1315	read(72,*)
1316	read(72,*) long_name
1317	read(72,*) standard_name
1318	read(72,*) unit
1319	read(72,*) descriptions
1320	read(72,*)
1321
1322	call ncdf_var_info (status(k),ncid(k),trim('lon'), long_name, standard_name, unit, descriptions)
1323	!global attributes
1324	call ncdf_global_attributes (status(k),ncid(k))
1325
1326	status(k) = nf90_close(ncid(k))
1327	!free memory
1328	deallocate(x,y,x1,y1,z,nzzm,lat,lon)
1329	! closing files
1330	close(72)
1331	end if ksnap
1332	! if (itracebug.eq.1) write(num_tracebug,*)'apres ksnap, classe', k
1333	nrecs(k)=nrecs(k)+1
1334	nbsnap(k)=nbsnap(k)+1
1335	end do classes_files
1336	end if liste_times
1337	! if (itracebug.eq.1) write(num_tracebug,*)'avant deallocate'
1338	deallocate(tab,tab1,tab1T)
1339	! if (itracebug.eq.1) write(num_tracebug,*)'apres deallocate'
1340	if (itracebug.eq.1) call tracebug(' sortie de routine sortie_ncdf_cat ')
1341	return
1342
1343	end subroutine sortie_ncdf_cat
1344
1345
1346	!> Subroutine write global attribute in the netcdf file
1347	!!@param stats = status of the given netcdf file
1348	!!@param ncdf_id = identificator of the given netcdf file
1349	!>
1350
1351	subroutine ncdf_global_attributes (stats,ncdf_id)
1352	!< arguments
1353	integer :: ncdf_id,stats
1354	!< local variables
1355	character (len = 20), parameter :: conventions="Conventions"
1356	character (len = 20), parameter :: title="Title"
1357	character (len = 20), parameter :: creator="Creator"
1358	character (len = 20), parameter :: history="History"
1359	character (len = 20), parameter :: references="References"
1360	character (len = 20), parameter :: comments="Comments"
1361	! instruction
1362	stats = nf90_put_att(ncdf_id,nf90_global,conventions,' ********TO DO***** ')
1363	stats = nf90_put_att(ncdf_id,nf90_global,title,' ********TO DO***** ')
1364	stats = nf90_put_att(ncdf_id,nf90_global,creator,' ********TO DO***** ')
1365	stats = nf90_put_att(ncdf_id,nf90_global,history,' ********TO DO***** ')
1366	stats = nf90_put_att(ncdf_id,nf90_global,references,' ********TO DO***** ')
1367	stats = nf90_put_att(ncdf_id,nf90_global,comments,' ********TO DO***** ')
1368	end subroutine ncdf_global_attributes
1369
1370
1371	!> Subroutine write informations related to data in the netcdf file
1372	!!@param stats = status of the given netcdf file
1373	!!@param ncdf_id = identificator of the given netcdf file
1374	!!@param name_var = name of the given variable
1375	!!@param long_name = long name for the given variable
1376	!!@param standard_name = standard name for the given variable
1377	!!@param unit = unit for the given variable
1378	!!@param descriptions = descriptions of the give varaible
1379	!>
1380
1381	subroutine ncdf_var_info (stats,ncdf_id,name_var, long_name, standard_name, unit, descriptions)
1382
1383	character(len=*) :: name_var ! nom de variable
1384	! liste des infos correspondant au variable d'interret
1385	character (len = 100), parameter :: longname = "long_name"
1386	character (len = 100) :: long_name
1387
1388	character (len = 100), parameter :: standardname = "standard_name"
1389	character (len = 100):: standard_name
1390
1391	character (len = 20), parameter :: units = "units"
1392	character (len = 20) :: unit
1393
1394	character (len = 200), parameter :: description = "descriptions"
1395	character (len = 200) :: descriptions
1396
1397	integer :: stats,ncdf_id,varid ! variables netcdf
1398	stats = nf90_inq_varid(ncdf_id,name_var,varid)
1399	stats = nf90_redef(ncdf_id)
1400	stats = nf90_put_att(ncdf_id,varid,longname,long_name)
1401	stats = nf90_put_att(ncdf_id,varid,standardname,standard_name)
1402	stats = nf90_put_att(ncdf_id,varid,units,unit)
1403	stats = nf90_put_att(ncdf_id,varid,description,descriptions)
1404
1405	end subroutine ncdf_var_info
1406
1407	end module sorties_ncdf_grisli

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

Download in other formats: