Context Navigation

source: branches/GRISLIv3/SOURCES/Netcdf-routines/sortie_netcdf_GRISLI_mod.0.2-hassine.f90 @ 467

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

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

Download in other formats: