Context Navigation

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

Last change on this file since 22 was 22, checked in by roche, 8 years ago
Petites adaptations diverses du code pour compilation en gfortran. Ajout d un Makefile flexible a option pour choisir ifort ou gfortran.
File size: 52.5 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 !< tableau 2d real ecrit dans le fichier
117	real*8, dimension(:,:,:), pointer :: tab1 !< tableau 3d real
118	real*8, dimension(:,:,:), pointer :: tab1T !< 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,l
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,j,k !< 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
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	allocate(tab(nx,ny),tab1(nx,ny,nz),tab1T(nx,ny,nz+nzm))
678
679	if (.not.associated(liste_time)) then
680	allocate(liste_time(1))
681	liste_time(1)=-1
682	end if
683
684	liste_times: if ((liste_time(1) .ne.timetmp) .or.(liste_time(1) .eq. -1) ) then
685	liste_time(1)= timetmp
686	! print*,"time outncdf=",liste_time(1)
687	write(charint,'(i0)') floor(timetmp)
688	nametmp = trim(nametmp)//trim(charint)//'_'
689	timetmp = 100.*(timetmp - floor(timetmp))
690
691	write(charint,'(i0)') floor(timetmp)
692	nametmp = trim(nametmp)//trim(charint)
693
694	!commentaire cytise
695	write(charint,'(f0.3)') time
696
697	classes_files: do k=1,nclassout
698
699	! Rajoute par Micha
700
701	if (.not.allocated(nbsnap) ) then
702	call init_sortie_ncdf
703	end if
704
705	! fin de la modif Micha
706
707	if (nbsnap(k).ge.nbsnap_max(k)) then ! test si on a depasse le nombre de snapshots
708	logic_snap(k)=1
709	posis=k
710	call init_sortie_ncdf
711	end if
712
713
714
715	! Write_Ncdf_var is the generic name for the ncdf subroutines that write variables.
716	! write_ncdf_var(varname,dimname,file,tabvar,typevar)
717
718	! ecrit le temps
719	call write_ncdf_var('time','time',trim(fil_sortie(k)),liste_time,nbsnap(k)+1,idef_time(k),'double')
720
721	fait = .FALSE.
722
723	boucle_var: do l=1,ntab
724
725	! if (itracebug.eq.1) write(num_tracebug,*)' var :',l,' dans netcdf_cat boucle_var ',ntab
726
727	if (cvar_nc(l) .eq. class_var_out(k)) then
728	itab=ivar_nc(l)
729	! les numeros dans ces tests doivent correspondre
730	! au premier numero de chaque ligne de liste_tab_ncdf.dat
731	if (itab.eq.1) then
732	tab(:,:) = s(:,:)
733	end if
734	if (itab.eq.2) then
735	tab(:,:) = h(:,:)
736	end if
737	if (itab.eq.3) then
738	tab(:,:) = bsoc(:,:)
739	end if
740	if (itab.eq.4) then
741	tab(:,:) = mk(:,:)
742	end if
743	if (itab.eq.5) then
744	tab(:,:) = hdot(:,:)
745	end if
746	if (itab.eq.6) then
747	tab(:,:) = s(:,:)-s0(:,:)
748	end if
749	if (itab.eq.7) then
750	tab(:,:) = b(:,:)
751	end if
752	if (itab.eq.8) then
753	tab(:,:) = socle_cry(:,:)
754	end if
755	if (itab.eq.9) then
756	tab(:,:) = mk_init(:,:)
757	end if
758	if (itab.eq.10) then
759	tab(:,:) = bm(:,:)
760	end if
761	if (itab.eq.11) then
762	tab(:,:) = acc(:,:)
763	end if
764	if (itab.eq.12) then
765	tab(:,:) = bm(:,:)-acc(:,:)
766	end if
767	if (itab.eq.13) then
768	tab(:,:) = calv(:,:)
769	end if
770	if (itab.eq.14) then
771	tab(:,:) = dhdt(:,:)
772	end if
773	if (itab.eq.15) then
774	tab(:,:) = bm(:,:)-bmelt(:,:)
775	end if
776	if (itab.eq.16) then
777	where (mk.gt.0)
778	tab(:,:) = bm(:,:)-bmelt(:,:)
779	elsewhere
780	tab(:,:)=-9999
781	end where
782	end if
783	if (itab.eq.18) then
784	tab(:,:) = tann(:,:)
785	end if
786	if (itab.eq.19) then
787	tab(:,:) = tjuly(:,:)
788	end if
789	if (itab.eq.20) then
790	tab(:,:) = t(:,:,nz)-tpmp(:,:,nz)
791	end if
792	if (itab.eq.23) then
793	tab(:,:) = -3.17098e-05*ghf(:,:)
794	end if
795	if (itab.eq.24) then
796	tab(:,:) = phid(:,:)*3.17098e-05
797	end if
798	if (itab.eq.25) then
799	tab(:,:) = bmelt(:,:)
800	end if
801	if (itab.eq.30) then
802	tab(:,:) = ((uxbar(:,:)+eoshift(uxbar(:,:),shift=1,boundary=0.,dim=1))*0.5)
803	end if
804	if (itab.eq.31) then
805	tab(:,:) = ((uybar(:,:)+eoshift(uybar(:,:),shift=1,boundary=0.,dim=2))*0.5)
806	end if
807	if (itab.eq.32) then
808	tab(:,:) = uxbar(:,:)
809	end if
810	if (itab.eq.33) then
811	tab(:,:) = uybar(:,:)
812	end if
813	if (itab.eq.34) then
814	tab(:,:) = ux(:,:,nz)
815	end if
816	if (itab.eq.35) then
817	tab(:,:) = uy(:,:,nz)
818	end if
819	if (itab.eq.36) then
820	tab(:,:) = (((uxbar(:,:)+eoshift(uxbar(:,:),shift=1,boundary=0.,dim=1))**2+ &
821	(uybar(:,:)+eoshift(uybar(:,:),shift=1,boundary=0.,dim=2))2)0.5)*0.5
822	end if
823	if (itab.eq.37) then
824	tab(:,:) = (((ux(:,:,nz)+eoshift(ux(:,:,nz),shift=1,boundary=0.,dim=1))**2+ &
825	(uy(:,:,nz)+eoshift(uy(:,:,nz),shift=1,boundary=0.,dim=2))2)0.5)*0.5
826	end if
827	if (itab.eq.38) then
828	tab(:,:) = ux(:,:,1)-ux(:,:,nz)
829	end if
830	if (itab.eq.39) then
831	tab(:,:) = uy(:,:,1)-uy(:,:,nz)
832	end if
833
834	if (itab.eq.40) then
835	tab(:,:) = frotmx(:,:)
836	end if
837	if (itab.eq.41) then
838	tab(:,:) = frotmy(:,:)
839	end if
840	if (itab.eq.42) then
841	tab(:,:) = tobmx(:,:)
842	end if
843	if (itab.eq.43) then
844	tab(:,:) = tobmy(:,:)
845	end if
846	if (itab.eq.44) then
847	tab(:,:) = taushelf(:,:)
848	end if
849	if (itab.eq.45) then
850	tab(:,:) = epsxx(:,:)
851	end if
852	if (itab.eq.46) then
853	tab(:,:) = epsyy(:,:)
854	end if
855	if (itab.eq.47) then
856	tab(:,:) = epsxy(:,:)
857	end if
858	if (itab.eq.48) then
859	tab(:,:) = eps(:,:)
860	end if
861	if (itab.eq.49) then
862	tab(:,:) = Abar(:,:)
863	end if
864	if (itab.eq.50) then
865	tab(:,:) = pvi(:,:)
866	end if
867	if (itab.eq.51) then
868	tab(:,:) = pvm(:,:)
869	end if
870	if (itab.eq.52) then
871	tab(:,:) = betamx(:,:)
872	end if
873	if (itab.eq.53) then
874	tab(:,:) = betamy(:,:)
875	endif
876
877	if (itracebug.eq.1) call tracebug(' avant appel beta_centre')
878
879
880	if (itab.eq.54) then
881	tab(:,:) = beta_centre(:,:)
882	endif
883	if (itab.eq.60) then
884	tab(:,:) = hwater(:,:)
885	end if
886	if (itab.eq.61) then
887	tab(:,:) = hdotwater(:,:)
888	end if
889	if (itab.eq.62) then
890	tab(:,:) = pgx(:,:)
891	end if
892	if (itab.eq.63) then
893	tab(:,:) = pgy(:,:)
894	end if
895	if (itab.eq.64) then
896	tab(:,:) = kond(:,:)
897	end if
898	if (itab.eq.65) then
899	tab(:,:) = phiwx(:,:)
900	end if
901	if (itab.eq.66) then
902	tab(:,:) = phiwy(:,:)
903	end if
904	if (itab.eq.68) then
905	tab(:,:) = neffmx(:,:)
906	end if
907	if (itab.eq.69) then
908	tab(:,:) = neffmy(:,:)
909	end if
910
911	if (itab.eq.70) then ! posx : grounded -> 0, , grzone ->1 ilemx->2 flot->3
912	do j=1,ny
913	do i=1,nx
914	if (gzmx(i,j)) then
915	if (ilemx(i,j)) then ! ile
916	tab(i,j)=2
917	else
918	tab(i,j)=1 ! grounded zone
919	endif
920	else if (flotmx(i,j)) then ! flottant
921	if (hmx(i,j).gt.1.) then
922	tab(i,j)=3
923	else
924	tab(i,j)=4
925	endif
926	else ! pose
927	tab(i,j)=0
928	endif
929	end do
930	end do
931	end if
932	if (itab.eq.71) then ! posy : grounded -> 0, , grzone ->1 ilemx->2 flot->3
933	do j=1,ny
934	do i=1,nx
935	if (gzmy(i,j)) then
936	if (ilemy(i,j)) then
937	tab(i,j)=2
938	else
939	tab(i,j)=1
940	endif
941	else if (flotmy(i,j)) then
942	if (hmy(i,j).gt.1.) then
943	tab(i,j)=3
944	else
945	tab(i,j)=4
946	endif
947	else
948	tab(i,j)=0
949	endif
950	end do
951	end do
952	end if
953	if (itab.eq.72) then
954	tab(:,:) = frontfacex(:,:)
955	end if
956	if (itab.eq.73) then
957	tab(:,:) = frontfacey(:,:)
958	end if
959
960	!SORTIE 3D
961
962	if (itab.eq.74) then
963	!tab1(:,:,:)=CP(:,:,:) A voir declarer dans ice temp declar
964	end if
965
966	if (itab.eq.75) then
967	!tab1(:,:,:)=CT(:,:,:) A voir declarer dans ice temp declar
968	end if
969
970	if (itab.eq.76) then
971	tab1(:,:,:)=SUX(:,:,:)
972	end if
973
974	if (itab.eq.77) then
975	tab1(:,:,:)=SUY(:,:,:)
976	end if
977
978	if (itab.eq.78) then
979	tab1(:,:,:)=TPMP(:,:,:)
980	end if
981
982	if (itab.eq.79) then
983	tab1(:,:,:)=UX(:,:,:)
984	end if
985
986	if (itab.eq.80) then
987	tab1(:,:,:)=UY(:,:,:)
988	end if
989
990	if (itab.eq.81) then
991	tab1(:,:,:)=UZR(:,:,:)
992	end if
993
994	if (itab.eq.82) then
995	!tab1(:,:,:)=Chaldef_maj(:,:,:) A voir declarer dans ice temp declar
996	end if
997
998	if (itab.eq.83) then
999	tab1T(:,:,:)= t(:,:,:)
1000	end if
1001
1002	if (itab.eq.84) then
1003	tab1(:,:,:)= xdep_out(:,:,:) ! aurel neem
1004	end if
1005	if (itab.eq.85) then
1006	tab1(:,:,:)= ydep_out(:,:,:) ! aurel neem
1007	end if
1008	if (itab.eq.86) then
1009	tab1(:,:,:)= tdep_out(:,:,:) ! aurel neem
1010	end if
1011
1012	! if (itab.eq.100) then ! vitesse de surface amplitude
1013	! tab(:,:)= sqrt(ux(:,:,1)ux(:,:,1)+uy(:,:,1)uy(:,:,1)) ! aurel neem
1014	! end if
1015
1016	! sorties pour debug
1017	! if (itab.eq.101) tab(:,:) = debug_3d(:,:,1)
1018
1019	debug_loop : do i_debug=101,nnc-1
1020	if (itab.eq.i_debug) then
1021	tab(:,:)=debug_3d(:,:,itab-100)
1022	exit debug_loop
1023	endif
1024	end do debug_loop
1025
1026	name =trim(namevar(l))
1027
1028	if (isort_time_ncdf(itab).eq.1) then
1029
1030	! pour les classe 3, sortir les champs 2D necessaires
1031
1032	if (cvar_nc(l) .eq. 3 .and. fait .eqv. .FALSE.) then
1033
1034	boucle_var2: do p=1,ntab
1035	! if (itracebug.eq.1) write(num_tracebug,*)' var :',p,' dans netcdf_cat boucle_var2 '
1036
1037	if (ivar_nc(p) .eq. 1) then
1038	tab(:,:) = s(:,:)
1039
1040	call write_ncdf_var('S',dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,p),'double')
1041	endif
1042
1043	if (ivar_nc(p) .eq. 2) then
1044	tab(:,:) = h(:,:)
1045	call write_ncdf_var('H',dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,p),'double')
1046	endif
1047
1048	if (ivar_nc(p) .eq. 3) then
1049	tab(:,:) = bsoc(:,:)
1050	call write_ncdf_var('Bsoc',dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,p),'double')
1051	endif
1052
1053	if (ivar_nc(p) .eq. 7) then
1054	tab(:,:) = b(:,:)
1055	call write_ncdf_var('B',dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,p),'double')
1056	exit boucle_var2
1057	endif
1058	end do boucle_var2
1059
1060	fait = .TRUE.
1061
1062	end if
1063
1064	if (ntype_nc(l) .eq. 'o' ) then
1065	if (cvar_nc(l) .eq. 3) then
1066	if (name .eq. 'T') then
1067	CALL Write_Ncdf_var(name,dimnames3dbis,TRIM(fil_sortie(k)),tab1T,nrecs(k),idef(k,l),'double')
1068	else
1069	CALL Write_Ncdf_var(name,dimnames3dxymaj,TRIM(fil_sortie(k)),tab1,nrecs(k),idef(k,l),'double')
1070	end if
1071	else
1072	call write_ncdf_var(name,dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,l),'double')
1073	end if
1074	long_name=longnamevar(l)
1075	standard_name=standardnamevar(l)
1076	unit=unitsvar(l)
1077	descriptions=descripvar(l)
1078	status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf
1079	if (status(k)/=nf90_noerr) then
1080	write(,)"unable to open netcdf file : ",fil_sortie(k)
1081	stop
1082	endif
1083	call ncdf_var_info (status(k),ncid(k),name, long_name, standard_name, unit, descriptions)
1084	status(k) = nf90_close(ncid(k))
1085	else
1086	if (ntype_nc(l) .eq. '>') then
1087	if (cvar_nc(l) .eq. 3) then
1088	CALL Write_Ncdf_var(name,dimnames3dxmin,TRIM(fil_sortie(k)),tab1,nrecs(k),idef(k,l),'double')
1089	else
1090	call write_ncdf_var(name,dimnames2dxmin,trim(fil_sortie(k)),tab,nrecs(k),idef(k,l),'double')
1091	end if
1092	long_name=longnamevar(l)
1093	standard_name=standardnamevar(l)
1094	unit=unitsvar(l)
1095	descriptions=descripvar(l)
1096	status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf
1097	if (status(k)/=nf90_noerr) then
1098	write(,)"unable to open netcdf file : ",fil_sortie(k)
1099	stop
1100	endif
1101	call ncdf_var_info (status(k),ncid(k),name, long_name, standard_name, unit, descriptions)
1102	status(k) = nf90_close(ncid(k))
1103	else
1104	if (ntype_nc(l) .eq. '^') then
1105	if (cvar_nc(l) .eq. 3) then
1106	CALL Write_Ncdf_var(name,dimnames3dymin,TRIM(fil_sortie(k)),tab1,nrecs(k),idef(k,l),'double')
1107	else
1108	call write_ncdf_var(name,dimnames2dymin,trim(fil_sortie(k)),tab,nrecs(k),idef(k,l),'double')
1109	end if
1110	long_name=longnamevar(l)
1111	standard_name=standardnamevar(l)
1112	unit=unitsvar(l)
1113	descriptions=descripvar(l)
1114	status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf
1115	if (status(k)/=nf90_noerr) then
1116	write(,)"unable to open netcdf file : ",fil_sortie(k)
1117	stop
1118	endif
1119	call ncdf_var_info (status(k),ncid(k),name, long_name, standard_name, unit, descriptions)
1120	status(k) = nf90_close(ncid(k))
1121	else
1122	if (ntype_nc(l) .eq. 'x') then
1123	if (cvar_nc(l) .eq. 3) then
1124	CALL Write_Ncdf_var(name,dimnames3dxymin,TRIM(fil_sortie(k)),tab1,nrecs(k),idef(k,l),'double')
1125	else
1126	call write_ncdf_var(name,dimnames2dxymin,trim(fil_sortie(k)),tab,nrecs(k),idef(k,l),'double')
1127	end if
1128	long_name=longnamevar(l)
1129	standard_name=standardnamevar(l)
1130	unit=unitsvar(l)
1131	descriptions=descripvar(l)
1132	status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf
1133	if (status(k)/=nf90_noerr) then
1134	write(,)"unable to open netcdf file : ",fil_sortie(k)
1135	stop
1136	endif
1137	call ncdf_var_info (status(k),ncid(k),name, long_name, standard_name, unit, descriptions)
1138	status(k) = nf90_close(ncid(k))
1139	end if
1140	end if
1141	end if
1142	end if
1143	end if
1144	end if
1145	! if (itracebug.eq.1) write(num_tracebug,*)' classe',k,' dans netcdf_cat boucle_var '
1146
1147	end do boucle_var
1148
1149	! if (itracebug.eq.1) write(num_tracebug,*)'apres boucle var',l,'classe',k
1150
1151	ksnap: if ( nbsnap(k) .eq. 0) then ! pour le faire 1 fois
1152	! if (itracebug.eq.1) write(num_tracebug,*)'avant allocate nbsnap'
1153	allocate(x(nx),y(ny),x1(nx),y1(ny),z(nz),nzzm(nz+nzm),lat(nx,ny),lon(nx,ny))
1154
1155	! attention le xmin est en km, le remettre en m
1156	! write(6,*) 'bornes domaine dans netcdf',xmin,xmax,ymin,ymax
1157	do i=1,nx
1158	x(i)=xmin1000.+(i-1)dx
1159	x1(i)=(xmin1000.+dx/2)+(i-1)dx
1160	end do
1161
1162	do i=1,ny
1163	y(i)=ymin1000.+(i-1)dy
1164	y1(i)=(ymin1000.+dy/2)+(i-1)dy
1165	end do
1166
1167	z(1)=0.
1168	z(nz)=1.
1169	nzzm(1)=0.
1170	nzzm(nz)=1.
1171	do i=1,nz
1172	if ((i.ne.1).and.(i.ne.nz))then
1173	z(i)=(i-1.)/(nz-1.)
1174	nzzm(i)=(i-1.)/(nz-1.)
1175	end if
1176	end do
1177
1178	do i= nz+1 ,nz+nzm
1179	nzzm(i)=i-nz+1
1180	end do
1181
1182	lat(:,:)=ylat(:,:)
1183	lon(:,:)=xlong(:,:)
1184
1185	! open(72,file='../'//trim(dirsource)//'/Netcdf-routines/Description_Variables.dat')
1186	open(72,file=trim(dirsource)//'/Netcdf-routines/Description_Variables.dat')
1187
1188	do
1189	read(72,'(a10)') comment
1190	if (comment.eq.'~~~~~~~~~~') exit
1191	end do
1192	! if (itracebug.eq.1) write(num_tracebug,*)'avant sortie x,y,lon,lat',k
1193
1194	call write_ncdf_var('x','x',trim(fil_sortie(k)),x,'double')
1195	call write_ncdf_var('y','y',trim(fil_sortie(k)),y,'double')
1196
1197	call write_ncdf_var('x1','x1',trim(fil_sortie(k)),x1,'double')
1198	call write_ncdf_var('y1','y1',trim(fil_sortie(k)),y1,'double')
1199
1200	call write_ncdf_var('z','z',trim(fil_sortie(k)),z,'double')
1201	call write_ncdf_var('nzzm','nzzm',trim(fil_sortie(k)),nzzm,'double')
1202
1203	call write_ncdf_var('lat',dimnames2dxymaj ,trim(fil_sortie(k)),lat,'double')
1204	call write_ncdf_var('lon',dimnames2dxymaj ,trim(fil_sortie(k)),lon,'double')
1205
1206	status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf
1207	if (status(k)/=nf90_noerr) then
1208	write(,)"unable to open netcdf file : ",fil_sortie(k)
1209	stop
1210	endif
1211
1212	! lecture des dimensions dans le fichier Description
1213	! time
1214	read(72,*)
1215	read(72,*)
1216	read(72,*)
1217	read(72,*)
1218	read(72,*) long_name
1219	read(72,*) standard_name
1220	read(72,*) unit
1221	read(72,*) descriptions
1222	read(72,*)
1223
1224	call ncdf_var_info (status(k),ncid(k),trim('time'), long_name, standard_name, unit, descriptions)
1225
1226	! x
1227	read(72,*)
1228	read(72,*)
1229	read(72,*)
1230	read(72,*) long_name
1231	read(72,*) standard_name
1232	read(72,*) unit
1233	read(72,*) descriptions
1234	read(72,*)
1235
1236	call ncdf_var_info (status(k),ncid(k),trim('x'), long_name, standard_name, unit, descriptions)
1237
1238	! x1
1239	read(72,*)
1240	read(72,*)
1241	read(72,*)
1242	read(72,*) long_name
1243	read(72,*) standard_name
1244	read(72,*) unit
1245	read(72,*) descriptions
1246	read(72,*)
1247
1248	call ncdf_var_info (status(k),ncid(k),trim('x1'), long_name, standard_name, unit, descriptions)
1249	! y
1250	read(72,*)
1251	read(72,*)
1252	read(72,*)
1253	read(72,*) long_name
1254	read(72,*) standard_name
1255	read(72,*) unit
1256	read(72,*) descriptions
1257	read(72,*)
1258
1259	call ncdf_var_info (status(k),ncid(k),trim('y'), long_name, standard_name, unit, descriptions)
1260	! y1
1261
1262	read(72,*)
1263	read(72,*)
1264	read(72,*)
1265	read(72,*) long_name
1266	read(72,*) standard_name
1267	read(72,*) unit
1268	read(72,*) descriptions
1269	read(72,*)
1270
1271	call ncdf_var_info (status(k),ncid(k),trim('y1'), long_name, standard_name, unit, descriptions)
1272
1273	! sigma coordinate
1274
1275	read(72,*)
1276	read(72,*)
1277	read(72,*)
1278	read(72,*) long_name
1279	read(72,*) standard_name
1280	read(72,*) unit
1281	read(72,*) descriptions
1282	read(72,*)
1283
1284	call ncdf_var_info (status(k),ncid(k),trim('z'), long_name, standard_name, unit, descriptions)
1285
1286	! coordinate in the bedrock
1287
1288	read(72,*)
1289	read(72,*)
1290	read(72,*)
1291	read(72,*) long_name
1292	read(72,*) standard_name
1293	read(72,*) unit
1294	read(72,*) descriptions
1295	read(72,*)
1296
1297	call ncdf_var_info (status(k),ncid(k),trim('nzzm'), long_name, standard_name, unit, descriptions)
1298
1299
1300	read(72,*)
1301	read(72,*)
1302	read(72,*)
1303	read(72,*) long_name
1304	read(72,*) standard_name
1305	read(72,*) unit
1306	read(72,*) descriptions
1307	read(72,*)
1308
1309	call ncdf_var_info (status(k),ncid(k),trim('lat'), long_name, standard_name, unit, descriptions)
1310
1311	read(72,*)
1312	read(72,*)
1313	read(72,*)
1314	read(72,*) long_name
1315	read(72,*) standard_name
1316	read(72,*) unit
1317	read(72,*) descriptions
1318	read(72,*)
1319
1320	call ncdf_var_info (status(k),ncid(k),trim('lon'), long_name, standard_name, unit, descriptions)
1321	!global attributes
1322	call ncdf_global_attributes (status(k),ncid(k))
1323
1324	status(k) = nf90_close(ncid(k))
1325	!free memory
1326	deallocate(x,y,x1,y1,z,nzzm,lat,lon)
1327	! closing files
1328	close(72)
1329	end if ksnap
1330	! if (itracebug.eq.1) write(num_tracebug,*)'apres ksnap, classe', k
1331	nrecs(k)=nrecs(k)+1
1332	nbsnap(k)=nbsnap(k)+1
1333	end do classes_files
1334	end if liste_times
1335	! if (itracebug.eq.1) write(num_tracebug,*)'avant deallocate'
1336	deallocate(tab,tab1,tab1T)
1337	! if (itracebug.eq.1) write(num_tracebug,*)'apres deallocate'
1338	if (itracebug.eq.1) call tracebug(' sortie de routine sortie_ncdf_cat ')
1339	return
1340
1341	end subroutine sortie_ncdf_cat
1342
1343
1344	!> Subroutine write global attribute in the netcdf file
1345	!!@param stats = status of the given netcdf file
1346	!!@param ncdf_id = identificator of the given netcdf file
1347	!>
1348
1349	subroutine ncdf_global_attributes (stats,ncdf_id)
1350	!< arguments
1351	integer :: ncdf_id,stats
1352	!< local variables
1353	character (len = 20), parameter :: conventions="Conventions"
1354	character (len = 20), parameter :: title="Title"
1355	character (len = 20), parameter :: creator="Creator"
1356	character (len = 20), parameter :: history="History"
1357	character (len = 20), parameter :: references="References"
1358	character (len = 20), parameter :: comments="Comments"
1359	! instruction
1360	stats = nf90_put_att(ncdf_id,nf90_global,conventions,' ********TO DO***** ')
1361	stats = nf90_put_att(ncdf_id,nf90_global,title,' ********TO DO***** ')
1362	stats = nf90_put_att(ncdf_id,nf90_global,creator,' ********TO DO***** ')
1363	stats = nf90_put_att(ncdf_id,nf90_global,history,' ********TO DO***** ')
1364	stats = nf90_put_att(ncdf_id,nf90_global,references,' ********TO DO***** ')
1365	stats = nf90_put_att(ncdf_id,nf90_global,comments,' ********TO DO***** ')
1366	end subroutine ncdf_global_attributes
1367
1368
1369	!> Subroutine write informations related to data in the netcdf file
1370	!!@param stats = status of the given netcdf file
1371	!!@param ncdf_id = identificator of the given netcdf file
1372	!!@param name_var = name of the given variable
1373	!!@param long_name = long name for the given variable
1374	!!@param standard_name = standard name for the given variable
1375	!!@param unit = unit for the given variable
1376	!!@param descriptions = descriptions of the give varaible
1377	!>
1378
1379	subroutine ncdf_var_info (stats,ncdf_id,name_var, long_name, standard_name, unit, descriptions)
1380
1381	character(len=*) :: name_var ! nom de variable
1382	! liste des infos correspondant au variable d'interret
1383	character (len = 100), parameter :: longname = "long_name"
1384	character (len = 100) :: long_name
1385
1386	character (len = 100), parameter :: standardname = "standard_name"
1387	character (len = 100):: standard_name
1388
1389	character (len = 20), parameter :: units = "units"
1390	character (len = 20) :: unit
1391
1392	character (len = 200), parameter :: description = "descriptions"
1393	character (len = 200) :: descriptions
1394
1395	integer :: stats,ncdf_id,varid ! variables netcdf
1396	stats = nf90_inq_varid(ncdf_id,name_var,varid)
1397	stats = nf90_redef(ncdf_id)
1398	stats = nf90_put_att(ncdf_id,varid,longname,long_name)
1399	stats = nf90_put_att(ncdf_id,varid,standardname,standard_name)
1400	stats = nf90_put_att(ncdf_id,varid,units,unit)
1401	stats = nf90_put_att(ncdf_id,varid,description,descriptions)
1402
1403	end subroutine ncdf_var_info
1404
1405	end module sorties_ncdf_grisli

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

Download in other formats: