Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

sortie_netcdf_GRISLI_mod.0.2-hassine.f90

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

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

Context Navigation

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

Download in other formats: