!> \file sortie_netcdf_GRISLI_mod.0.2-hassine.f90 !! Sorties_ncdf_grisli for netcdf output !< !>\namespace sorties_ncdf_grisli !!\author CatRitz !!\author Hassine !!\date 2010 !!@note netcdf output with the same variables number as the horizontal output !!@note used modules: !!@note - netcdf !!@note - runparam !!@note - io_netcdf_grisli !!@note - module3D_phy !< module sorties_ncdf_grisli use netcdf use geography ! permet d'avoir nx et ny et geoplace use runparam ! permet d'avoir tbegin,tend,runname,dirout use io_netcdf_grisli use module3d_phy use tracer_vars ! aurel neem use bilan_eau_mod implicit none !variables netcdf character(len=100), dimension(:),allocatable :: fil_sortie !< nom du fichier sortie integer, dimension(:),allocatable :: status !< erreur operations io netcdf integer, dimension(:),allocatable :: ncid !< numero unite, ident variable character(len=80), dimension(:), allocatable :: basename !< basename des fichier ncdf de sortie real :: dtncdf !< pas de temps des sorties integer :: i_debug !< pour les variables debug integer :: num_init_nc=0 !< numero de l'initialisation init_sortie ! Pour chaque variable : !____________________________________ integer,parameter :: nnc=300 !< nombre max de variables ! numero, classe, type de noeud, nom integer,dimension(nnc) :: ivar_nc !< tableau qui contient les itab des var choisies integer,dimension(nnc) :: cvar_nc !< tableau qui contient les class des var choisies character(len=1),dimension(nnc) :: ntype_nc !< tableau qui contient les type des noeuds des var choisies character(len=20),dimension(nnc) :: namevar !< nom de la variable ! caracteristiques definies dans Description_Variables.dat integer :: ilin !< numero d'apparition dans Description_Variables.dat character(len=100),dimension(nnc) :: longnamevar !< nom long de la variable character(len=100),dimension(nnc) :: standardnamevar !< nom standard de la variable character(len=20), dimension(nnc) :: unitsvar !< unite de la variable character(len=200),dimension(nnc) :: descripvar !< descrition de la variable ! aspects sorties temporelle integer,dimension(nnc) :: interv !< entier qui code quel dtsortie utiliser integer,dimension(nnc) :: isort_time_ncdf !< 1 si sortie au temps time integer,dimension(nnc) :: isortie=0 !< si isortie=0, pas de sortie du tout. real, dimension(nnc) :: dtsortvar_ncdf !< pas de temps de sortie de chaque variable corres character(len=20),dimension(nnc) :: varname !< le nom de la variable (lu dans LISTE-VAR-NETCDF.dat) ! dimensions des differents tableaux selon majeur,mineur ... dimensions pour routines netcdf character(len=20),dimension(3) :: dimnames2dxymaj !< pour tableau 2d pour les noeud majeur character(len=20),dimension(3) :: dimnames2dxmin !< pour tableau 2d pour les noeud x mineur character(len=20),dimension(3) :: dimnames2dymin !< pour tableau 2d pour les noeud y mineur character(len=20),dimension(3) :: dimnames2dxymin !< pour tableau 2d pour les noeud mineur ! pour les variables 3 d character(len=20),dimension(4) :: dimnames3dxymaj !< pour 3d troisieme dim est nz character(len=20),dimension(4) :: dimnames3dxmin !< pour 3d troisieme dim est nz character(len=20),dimension(4) :: dimnames3dymin !< pour 3d troisieme dim est nz character(len=20),dimension(4) :: dimnames3dxymin !< pour 3d troisieme dim est nz character(len=20),dimension(4) :: dimnames3dbis !< pour 3d troisieme dim est nz+nzm ! definition des pas de temps de sortie integer :: ndtsortie_ncdf !< nombre de dtsortie ncdf integer :: npredeft !< nombre de temps de sortie ncdf predefinis integer :: iglob_ncdf=0 integer :: tsortie !< indice dans le tableau dtsortie_ncdf real,dimension(:),allocatable :: predef_tsort !< tableau des temps predefinis pour sorties double precision, dimension(:),allocatable :: dtsortie_ncdf!< tableau des dtsortie : dimension (ndtsortie_ncdf) ! caracteristiques allocatables integer:: nptypenode !< nombre de type de node a  sortir character (len=1),dimension(:,:),allocatable ::type_node !< tableau des type des noeuds integer :: class_var !< class de variable qu'on veut sortir integer :: nclassout !< nombre de class a  sortir integer,dimension(:),allocatable :: class_var_out !< tableau des class a  sortir !character(len=5) ::node_var !< type de noeud sur lequel on sort nos variables integer,dimension(:),allocatable :: nbsnap !< numero du snapshot dans le fichier integer,dimension(:),allocatable :: logic_snap integer,dimension(:),allocatable :: nbsnap_max !< nb max de snapshots par fichier !< dans les sortie netcdf !< pour limiter le nombre de snapshots par fichier a nsnap_max, !< on numerote les archives netcdf !< au fur et a mesure des besoins integer,dimension(:),allocatable:: nrecs !< compteur pour les enregistrements temps !< des variables dans chaque fichier integer,dimension(:),allocatable:: idef_time !< 1 ou 0 si le temp est defini ou non integer,dimension(:),allocatable:: idef_sealevel !< 1 ou 0 si sealevel est defini ou non integer,dimension(:,:),allocatable:: idef !< 1 ou 0 si la varaible est defini ou non integer,dimension(:),allocatable :: num_ncdf_file !< compteur des fichiers netcdf par class real*8, dimension(:,:), pointer :: tab => null() !< tableau 2d real ecrit dans le fichier real*8, dimension(:,:,:), pointer :: tab1 => null() !< tableau 3d real real*8, dimension(:,:,:), pointer :: tab1T => null() !< tableau 3d real pour la temperature ! variables de travail (lectures, ...) !______________________________________ ! pour les lectures de variables (valeurs mises ensuite dans des tableaux) character (len = 100) :: long_name !< long name of the given variable character (len = 100) :: standard_name !< standard name of the given variable character (len = 20) :: unit !< unit of the given variable character (len = 200) :: descriptions !< description of the given variable character(len=20) ::charint !< character de la tranche de temps dans le netcdf integer :: itab !< numero de tableau integer :: ntab !< nombre de tableaux integer :: cdftest !< pour declancher une sortie netcdf integer :: posis=0 character(len=20),dimension(nnc) :: name_file_var !< nom du fichier ! A enlever ?? character(len=20) :: name !< nom de variable character (len=10) :: comment !< variable de travail integer,parameter :: nvar = nnc !< nombre maxi de variables dans liste-var-netcdf.dat character (len=20) :: varchar integer :: varnum contains !> Subroutine initialise the list of variables to write in the netcdf file !< subroutine init_out_ncdf implicit none integer :: err integer :: num_file=22 integer :: i1,i2,i3 integer :: i,j,k character(len=20) :: name1 character(len=20) :: name2 character (len=5) :: nodetype ! centered or staggered integer :: nsnap ! maximum number of snapshots per nc file character (len=100) :: long character (len=100) :: standard character (len=20) :: units character (len=200) :: descrip if (ncdf_type.eq.0) call lect_netcdf_type !< pour lire la valeur de nccdf_type (machine dependant) ! initialise les tableaux !---------------------------- ! dtsortie_ncdf, predef_tsort ! isortie,interv,dtsortvar_ncdf,varname ! lecture des pas de temps de sortie !------------------------------------ ! open(num_file,file='../'//trim(dirsource)//'/Fichiers-parametres/TEMPS-NETCDF.dat') open(num_file,file=trim(dirsource)//'/Fichiers-parametres/TEMPS-NETCDF.dat',status='old') ! passe les commentaires qui se terminent par une ligne de ~~~ comment1: do k=1,500 read(num_file,'(a10)') comment if (comment.eq.'~~~~~~~~~~') exit comment1 end do comment1 ! lecture de la class des variables a sortir read(num_file,*) nclassout if (.not.allocated(class_var_out) .and. .not.allocated(nbsnap_max) .and. .not.allocated(logic_snap)) then allocate(class_var_out(nclassout), nbsnap_max(nclassout), logic_snap(nclassout)) logic_snap=0 end if read(num_file,*) class_var_out read(num_file,*) ! saute une ligne ! lecture frequences de sortie read(num_file,*) ndtsortie_ncdf if (.not.allocated(dtsortie_ncdf)) then allocate(dtsortie_ncdf(ndtsortie_ncdf)) end if do k=1,ndtsortie_ncdf read(num_file,*) dtsortie_ncdf(k) end do read(num_file,*) ! saute une ligne ! lecture pas de temps predefinis read(num_file,*) npredeft if (.not.allocated(predef_tsort)) then allocate(predef_tsort(npredeft),stat=err) if (err/=0) then print *,"erreur a  l'allocation du tableau dt-out_netcdf ",err stop 4 end if end if do k=1,npredeft read(num_file,*) predef_tsort(k) end do comment3: do k=1,500 read(num_file,'(a10)') comment if (comment.eq.'----------') exit comment3 end do comment3 close(num_file) ! lecture des variables et de leur frequence de sortie !----------------------------------------------------------- ! open(num_file,file='../'//trim(dirsource)//'/Fichiers-parametres/LISTE-VAR-NETCDF.dat') open(num_file,file=trim(dirsource)//'/Fichiers-parametres/LISTE-VAR-NETCDF.dat') !saute les commentaires comment2: do k=1,500 read(num_file,'(a10)') comment if (comment.eq.'~~~~~~~~~~') exit comment2 end do comment2 ! allocate the array of node types if (.not.allocated(type_node)) then allocate(type_node(nclassout,4)) end if read(num_file,*) !Saut du premier ======== do read(num_file,*,end=530,err=510) class_var,nsnap,nptypenode classout:do j=1,nclassout if (class_var_out(j) .eq. class_var) then nbsnap_max(j)= nsnap read(num_file,*,end=530,err=510) type_node(j,1:nptypenode) read(num_file,*,end=530,err=510) !pour le saut de ligne do k=1,200 read(num_file,*,end=530,err=510) varchar if (varchar .eq. "====================") then go to 520 end if read(num_file,*,end=530,err=510) varnum read(num_file,*,end=530,err=510) i1,i2,i3 varname(varnum)=varchar isortie(varnum)=i1 tsortie=i2 interv(varnum)=i3 if ((tsortie.gt.0).and.(tsortie.le.ndtsortie_ncdf)) then dtsortvar_ncdf(varnum)=dtsortie_ncdf(tsortie) else dtsortvar_ncdf(varnum)=-1.e10 endif do read(num_file,'(a10)',end=530,err=510) comment if (comment.eq.'----------') exit !pour le saut des commentaires end do !read(num_file,*) !pour saut de ligne end do end if end do classout 510 continue comment4: do k=1,500 read(num_file,'(a10)',end=530,err=510) comment if (comment.eq.'==========') exit comment4 end do comment4 520 continue end do 530 continue close (num_file) ! lecture des nom des tableaux a sortir en netcdf !open(num_file,file='../'//trim(dirsource)//'/Netcdf-routines/Description_Variables.dat') open(num_file,file=trim(dirsource)//'/Netcdf-routines/Description_Variables.dat') do !saut des commentaires et des variables 1D read(num_file,'(a10)') comment if (comment.eq.'==========') exit end do ilin=0 do read(num_file,*,end=230,err=210) name2 if (name2 .eq. '--------------------') then go to 220 end if read(num_file,*) i2, name1,i2 classoutt: do j=1,nclassout if (i2.eq.class_var_out(j)) then read(num_file,*,end=230,err=210) nodetype read(num_file,*,end=230,err=210) long read(num_file,*,end=230,err=210) standard read(num_file,*,end=230,err=210) units read(num_file,*,end=230,err=210) descrip ! boucle sur les numeros de variables. C'est le nom name1 qui va retrouver le numero boucle_var: do i=1,nvar if (varname(i).eq.name1)then i3=isortie(i) i1=i go to 200 else i3=0 end if end do boucle_var 200 continue if (i3 .eq. 1) then do k=1,nptypenode ! recherche le type de noeud k, dans ceux ouverts pour la classe j if ( type_node(j,k) .eq. nodetype ) then ilin=ilin+1 ivar_nc(ilin)=i1 cvar_nc(ilin)=i2 ntype_nc(ilin)=nodetype namevar(ilin)=name1 name_file_var(ilin)=name2 longnamevar(ilin)=long standardnamevar(ilin)=standard unitsvar(ilin)=units descripvar(ilin)=descrip ! if (itracebug.eq.1) write(num_tracebug,*) ilin,namevar(ilin) end if end do end if if (ilin.eq.nnc) exit ! nnc parameter nombre max de variables go to 220 end if end do classoutt 210 continue do read(num_file,'(a10)',end=230,err=210) comment if (comment.eq.'----------') exit end do 220 continue end do 230 ntab=ilin close(num_file) return end subroutine init_out_ncdf !> Subroutine test for all variables if the netcdf output is done at a given time !! @param tsortie = time of output !< subroutine testsort_time_ncdf(tsortie) implicit none !< local variables double precision :: tsortie real :: difftime !< difference tsortie-predef_tsort(npr) real :: debtime !< difference abs(tsortie-tbegin) real :: fintime !< difference abs(tsortie-tend) integer :: ipredef integer :: ideb integer :: ifin integer :: npr integer :: i !< indices de travail if (itracebug.eq.1) call tracebug(' Entree dans routine testsort_time_ncdf') isort_time_ncdf(:)=0 ! recherche si ce pas de temps est un pas de temps predefini ipredef=0 ideb=0 ifin=0 predef: do npr=1,npredeft difftime=abs(tsortie-predef_tsort(npr)) if (difftime.lt.dtmin) then ipredef=1 exit predef end if debtime=abs(tsortie-tbegin) fintime=abs(tsortie-tend) if ((debtime.lt.dtmin).or.(nt.eq.1)) ideb=1 if (fintime.lt.dtmin) ifin=1 end do predef ! boucle sur les numeros de variables boucle_var: do i=1,ntab ! if (itracebug.eq.1) write(num_tracebug,*)' var :',i,' boucle sur ',ntab if (isortie(ivar_nc(i)).eq.0) then ! variables non attribuees et ! variables ou isortie est explicitement 0 isort_time_ncdf(ivar_nc(i))=0 else ! variables dont on veut la sortie if (dtsortvar_ncdf(ivar_nc(i)).eq. -1.e10) then if ((interv(ivar_nc(i)).eq.-1)) then ! premier+dernier if ((ideb .eq.1).or.(ifin.eq.1)) then isort_time_ncdf(ivar_nc(i))=1 end if end if if (interv(ivar_nc(i)).eq.0) then ! ne sort que le premier pas de temps if (ideb .eq.1) then isort_time_ncdf(ivar_nc(i))=1 end if end if if ((interv(ivar_nc(i)).eq.1)) then ! premier + dernier + predefinis if ((ipredef.eq.1)) then isort_time_ncdf(ivar_nc(i))=1 else if (ideb .eq.1) then isort_time_ncdf(ivar_nc(i))=1 else if (ifin.eq.1) then isort_time_ncdf(ivar_nc(i))=1 end if end if else if ((interv(ivar_nc(i)).eq.-1)) then ! premier+dernier if ((ideb .eq.1).or.(ifin.eq.1)) then isort_time_ncdf(ivar_nc(i))=1 end if end if if (interv(ivar_nc(i)).eq.0) then ! ne sort que le premier pas de temps if (ideb .eq.1) then isort_time_ncdf(ivar_nc(i))=1 end if end if if ((interv(ivar_nc(i)).eq.1)) then ! premier + dernier + predefinis if ((ipredef.eq.1)) then isort_time_ncdf(ivar_nc(i))=1 else if (ideb .eq.1) then isort_time_ncdf(ivar_nc(i))=1 else if (ifin.eq.1) then isort_time_ncdf(ivar_nc(i))=1 end if end if if (mod(abs(tsortie),dtsortvar_ncdf(ivar_nc(i))).lt.dble(dtmin)) then isort_time_ncdf(ivar_nc(i))=1 end if end if endif end do boucle_var iglob_ncdf=maxval(isort_time_ncdf) return end subroutine testsort_time_ncdf !> subroutine initialise netcdf file !< subroutine init_sortie_ncdf implicit none integer :: j character(len=2) :: class,numero if (itracebug.eq.1) call tracebug(' Entree dans routine init_sortie_ncdf') if (.not.allocated(basename) .and. .not.allocated(fil_sortie) .and. .not.allocated(ncid) & .and. .not.allocated(status) ) then allocate(basename(nclassout),fil_sortie(nclassout) & ,ncid(nclassout), status(nclassout)) end if if (.not.allocated(nrecs) .and. .not.allocated(nbsnap) .and. .not.allocated(num_ncdf_file) & .and. .not. allocated(idef) .and. .not. allocated(idef_time)) then allocate(nrecs(nclassout),nbsnap(nclassout),num_ncdf_file(nclassout),idef(nclassout,ntab),idef_time(nclassout),idef_sealevel(nclassout)) nrecs=1 idef=0 idef_time=0 idef_sealevel=0 num_ncdf_file=0 end if if (maxval(logic_snap) .eq. 0) then do j=1,nclassout nrecs(j)=1 idef(j,:)=0 idef_time(j)=0 idef_sealevel(j)=0 nbsnap(j)=0 ! numerote le fichier sortie num_ncdf_file(j)=num_ncdf_file(j)+1 ! numerotation pour le nom de fichier write(numero,'(i2.2)') num_ncdf_file(j) write (class,'(i2.2)') class_var_out(j) !basename(j)=trim(dirnameout)//'Netcdf-Resu/'//runname//'_class'//class//'_'//numero basename(j)=trim(dirnameout)//runname//'_class'//class//'_'//numero fil_sortie(j)=trim(basename(j))//'.nc' ! 4 go a revoir !status = nf90_create(trim(fil_sortie),and(nf90_write,nf90_64bit_offset,nf90_hdf5),ncid) if (ncdf_type.eq.32) then status(j) = nf90_create(trim(fil_sortie(j)),nf90_write,ncid(j)) ! creation du fichier else if (ncdf_type.eq.64) then status(j) = nf90_create(trim(fil_sortie(j)),and(nf90_write,nf90_64bit_offset),ncid(j)) ! r2d2 else write(6,*)'pb de valeur de netcdf_type dans sortie_netcdf :',ncdf_type endif status(j) = nf90_close(ncid(j)) ! fermeture call write_ncdf_dim('x',trim(fil_sortie(j)),nx) ! dimensions des variables/tableaux noeud majeur en x call write_ncdf_dim('y',trim(fil_sortie(j)),ny) ! dimensions des variables/tableaux noeud majeur en y call write_ncdf_dim('x1',trim(fil_sortie(j)),nx) ! dimensions des variables/tableaux noeud mineur en x call write_ncdf_dim('y1',trim(fil_sortie(j)),ny) ! dimensions des variables/tableaux noeud mineur en y ! pour les variables 3d call write_ncdf_dim('z',trim(fil_sortie(j)),nz) call write_ncdf_dim('nzzm',trim(fil_sortie(j)),nz+nzm) !---------------------------------------------------- call write_ncdf_dim('time',trim(fil_sortie(j)),0) end do else nrecs(posis)=1 idef(posis,:)=0 idef_time(posis)=0 idef_sealevel(posis)=0 nbsnap(posis)=0 ! numerote le fichier sortie num_ncdf_file(posis)=num_ncdf_file(posis)+1 ! numerotation pour le nom de fichier write(numero,'(i2.2)') num_ncdf_file(posis) write (class,'(i2.2)') class_var_out(posis) !basename(posis)=trim(dirnameout)//'Netcdf-Resu/'//runname//'_class'//class//'_'//numero basename(posis)=trim(dirnameout)//runname//'_class'//class//'_'//numero fil_sortie(posis)=trim(basename(posis))//'.nc' ! 4 go a  revoir !status = nf90_create(trim(fil_sortie),and(nf90_write,nf90_64bit_offset,nf90_hdf5),ncid) if (ncdf_type.eq.32) then status(posis) = nf90_create(trim(fil_sortie(posis)),nf90_write,ncid(posis)) ! creation du fichier else if (ncdf_type.eq.64) then status(posis) = nf90_create(trim(fil_sortie(posis)),and(nf90_write,nf90_64bit_offset),ncid(posis)) !r2d2 else write(6,*)'pb de valeur de netcdf_type dans sortie_netcdf :', ncdf_type endif status(posis) = nf90_close(ncid(posis)) ! fermeture call write_ncdf_dim('x',trim(fil_sortie(posis)),nx) ! dimensions des variables/tableaux noeud majeur en x call write_ncdf_dim('y',trim(fil_sortie(posis)),ny) ! dimensions des variables/tableaux noeud majeur en y call write_ncdf_dim('x1',trim(fil_sortie(posis)),nx) ! dimensions des variables/tableaux noeud mineur en x call write_ncdf_dim('y1',trim(fil_sortie(posis)),ny) ! dimensions des variables/tableaux noeud mineur en y call write_ncdf_dim('z',trim(fil_sortie(posis)),nz) call write_ncdf_dim('nzzm',trim(fil_sortie(posis)),nz+nzm) call write_ncdf_dim('time',trim(fil_sortie(posis)),0) logic_snap(posis)=0 end if ! ecriture d'un tableau tab 2d dimnames2dxymaj(1)='x' dimnames2dxymaj(2)='y' dimnames2dxymaj(3)='time' dimnames2dxmin(1)='x1' dimnames2dxmin(2)='y' dimnames2dxmin(3)='time' dimnames2dymin(1)='x' dimnames2dymin(2)='y1' dimnames2dymin(3)='time' dimnames2dxymin(1)='x1' dimnames2dxymin(2)='y1' dimnames2dxymin(3)='time' ! pour les variables 3d a  voir apres dimnames3dxymaj(1)='x' dimnames3dxymaj(2)='y' dimnames3dxymaj(3)='z' dimnames3dxymaj(4)='time' dimnames3dxmin(1)='x1' dimnames3dxmin(2)='y' dimnames3dxmin(3)='z' dimnames3dxmin(4)='time' dimnames3dymin(1)='x' dimnames3dymin(2)='y1' dimnames3dymin(3)='z' dimnames3dymin(4)='time' dimnames3dxymin(1)='x1' dimnames3dxymin(2)='y1' dimnames3dxymin(3)='z' dimnames3dxymin(4)='time' dimnames3dbis(1)='x' dimnames3dbis(2)='y' dimnames3dbis(3)='nzzm' dimnames3dbis(4)='time' end subroutine init_sortie_ncdf !>subroutine write the netcdf results !< subroutine sortie_ncdf_cat implicit none real (kind=kind(0.d0)) :: timetmp !< variable intermediaire character(len=20) :: nametmp !< nom intermediaire real*8,pointer,dimension(:) :: liste_time => null() !< liste des snapshot des variables ecrites en netcdf real*8,pointer,dimension(:) :: sealevel_p => null() !< pointeur vers sealevel pour ecriture netcdf real*8,pointer,dimension(:) :: x,y,x1,y1,z,nzzm real*8,pointer,dimension(:,:):: lat,lon => null() integer :: i,j,l,k,p logical :: fait ! instructions if (itracebug.eq.1) call tracebug(' Entree dans routine sortie_netcdf_cat') ! new version of netcdf output in order to be compatible with ! ferret conventions ! if ( time .le. 0. ) then ! timetmp = -time ! nametmp = 'p_' ! else timetmp = time nametmp = 'f_' ! endif if (.not.associated(tab)) allocate(tab(nx,ny)) if (.not.associated(tab1)) allocate(tab1(nx,ny,nz)) if (.not.associated(tab1T)) allocate(tab1T(nx,ny,nz+nzm)) if (.not.associated(liste_time)) then allocate(liste_time(1)) liste_time(1)=-1 end if if (.not.associated(sealevel_p)) then allocate(sealevel_p(1)) sealevel_p(1)=-1 end if liste_times: if ((liste_time(1) .ne.timetmp) .or.(liste_time(1) .eq. -1) ) then liste_time(1)= timetmp sealevel_p(1)= sealevel ! print*,"time outncdf=",liste_time(1) write(charint,'(i0)') floor(timetmp) nametmp = trim(nametmp)//trim(charint)//'_' timetmp = 100.*(timetmp - floor(timetmp)) write(charint,'(i0)') floor(timetmp) nametmp = trim(nametmp)//trim(charint) !commentaire cytise write(charint,'(f0.3)') time classes_files: do k=1,nclassout ! Rajoute par Micha if (.not.allocated(nbsnap) ) then call init_sortie_ncdf end if ! fin de la modif Micha if (nbsnap(k).ge.nbsnap_max(k)) then ! test si on a depasse le nombre de snapshots logic_snap(k)=1 posis=k call init_sortie_ncdf end if ! Write_Ncdf_var is the generic name for the ncdf subroutines that write variables. ! write_ncdf_var(varname,dimname,file,tabvar,typevar) ! ecrit le temps call write_ncdf_var('time','time',trim(fil_sortie(k)),liste_time,nbsnap(k)+1,idef_time(k),'double') sealevel_p=sealevel call write_ncdf_var('sealevel','time',trim(fil_sortie(k)),sealevel_p,nrecs(k),idef_sealevel(k),'double') fait = .FALSE. boucle_var: do l=1,ntab ! if (itracebug.eq.1) write(num_tracebug,*)' var :',l,' dans netcdf_cat boucle_var ',ntab if (cvar_nc(l) .eq. class_var_out(k)) then itab=ivar_nc(l) ! les numeros dans ces tests doivent correspondre ! au premier numero de chaque ligne de liste_tab_ncdf.dat if (itab.eq.1) then tab(:,:) = s(:,:) end if if (itab.eq.2) then tab(:,:) = h(:,:) end if if (itab.eq.3) then tab(:,:) = bsoc(:,:) end if if (itab.eq.4) then tab(:,:) = mk(:,:) end if if (itab.eq.5) then tab(:,:) = hdot(:,:) end if if (itab.eq.6) then tab(:,:) = s(:,:)-s0(:,:) end if if (itab.eq.7) then tab(:,:) = b(:,:) end if if (itab.eq.8) then tab(:,:) = socle_cry(:,:) end if if (itab.eq.9) then tab(:,:) = mk_init(:,:) end if if (itab.eq.10) then tab(:,:) = bm(:,:) end if if (itab.eq.11) then tab(:,:) = acc(:,:) end if if (itab.eq.12) then tab(:,:) = bm(:,:)-acc(:,:) end if if (itab.eq.13) then tab(:,:) = calv_dtt(:,:)/dtt end if if (itab.eq.14) then tab(:,:) = dhdt(:,:) end if if (itab.eq.15) then tab(:,:) = bm(:,:)-bmelt(:,:) end if if (itab.eq.16) then where (mk.gt.0) tab(:,:) = bm(:,:)-bmelt(:,:) elsewhere tab(:,:)=-9999 end where end if if (itab.eq.18) then tab(:,:) = tann(:,:) end if if (itab.eq.19) then tab(:,:) = tjuly(:,:) end if if (itab.eq.20) then tab(:,:) = t(:,:,nz)-tpmp(:,:,nz) end if if (itab.eq.23) then tab(:,:) = -3.17098e-05*ghf(:,:) end if if (itab.eq.24) then tab(:,:) = phid(:,:)*3.17098e-05 end if if (itab.eq.25) then tab(:,:) = bmelt(:,:) end if if (itab.eq.30) then tab(:,:) = ((uxbar(:,:)+eoshift(uxbar(:,:),shift=1,boundary=0.,dim=1))*0.5) end if if (itab.eq.31) then tab(:,:) = ((uybar(:,:)+eoshift(uybar(:,:),shift=1,boundary=0.,dim=2))*0.5) end if if (itab.eq.32) then tab(:,:) = uxbar(:,:) end if if (itab.eq.33) then tab(:,:) = uybar(:,:) end if if (itab.eq.34) then tab(:,:) = ux(:,:,nz) end if if (itab.eq.35) then tab(:,:) = uy(:,:,nz) end if if (itab.eq.36) then tab(:,:) = (((uxbar(:,:)+eoshift(uxbar(:,:),shift=1,boundary=0.,dim=1))**2+ & (uybar(:,:)+eoshift(uybar(:,:),shift=1,boundary=0.,dim=2))**2)**0.5)*0.5 end if if (itab.eq.37) then tab(:,:) = (((ux(:,:,nz)+eoshift(ux(:,:,nz),shift=1,boundary=0.,dim=1))**2+ & (uy(:,:,nz)+eoshift(uy(:,:,nz),shift=1,boundary=0.,dim=2))**2)**0.5)*0.5 end if if (itab.eq.38) then tab(:,:) = ux(:,:,1)-ux(:,:,nz) end if if (itab.eq.39) then tab(:,:) = uy(:,:,1)-uy(:,:,nz) end if if (itab.eq.40) then tab(:,:) = frotmx(:,:) end if if (itab.eq.41) then tab(:,:) = frotmy(:,:) end if if (itab.eq.42) then tab(:,:) = tobmx(:,:) end if if (itab.eq.43) then tab(:,:) = tobmy(:,:) end if if (itab.eq.44) then tab(:,:) = taushelf(:,:) end if if (itab.eq.45) then tab(:,:) = epsxx(:,:) end if if (itab.eq.46) then tab(:,:) = epsyy(:,:) end if if (itab.eq.47) then tab(:,:) = epsxy(:,:) end if if (itab.eq.48) then tab(:,:) = eps(:,:) end if if (itab.eq.49) then tab(:,:) = Abar(:,:) end if if (itab.eq.50) then tab(:,:) = pvi(:,:) end if if (itab.eq.51) then tab(:,:) = pvm(:,:) end if if (itab.eq.52) then tab(:,:) = betamx(:,:) end if if (itab.eq.53) then tab(:,:) = betamy(:,:) endif if (itracebug.eq.1) call tracebug(' avant appel beta_centre') if (itab.eq.54) then tab(:,:) = beta_centre(:,:) endif if (itab.eq.55) then tab(:,:) = ablbord_dtt(:,:)/dtt endif if (itab.eq.56) then tab(:,:) = ice(:,:) endif if (itab.eq.57) then tab(:,:) = front(:,:) endif if (itab.eq.58) then tab(:,:) = tot_water(:,:) endif if (itab.eq.59) then tab(:,:) = gr_line_schoof(:,:) endif if (itab.eq.60) then tab(:,:) = hwater(:,:) end if if (itab.eq.61) then tab(:,:) = hdotwater(:,:) end if if (itab.eq.62) then tab(:,:) = pgx(:,:) end if if (itab.eq.63) then tab(:,:) = pgy(:,:) end if if (itab.eq.64) then tab(:,:) = kond(:,:) end if if (itab.eq.65) then tab(:,:) = phiwx(:,:) end if if (itab.eq.66) then tab(:,:) = phiwy(:,:) end if if (itab.eq.67) then where (flot_marais(:,:)) tab(:,:)=1 elsewhere tab(:,:)=0 end where end if if (itab.eq.68) then tab(:,:) = neffmx(:,:) end if if (itab.eq.69) then tab(:,:) = neffmy(:,:) end if if (itab.eq.70) then ! posx : grounded -> 0, , grzone ->1 ilemx->2 flot->3 do j=1,ny do i=1,nx if (gzmx(i,j)) then if (ilemx(i,j)) then ! ile tab(i,j)=2 else if (fleuvemx(i,j)) then tab(i,j)=5 ! actual grounded streams else tab(i,j)=1 ! grounded zone endif else if (flotmx(i,j)) then ! flottant if (hmx(i,j).gt.1.) then tab(i,j)=3 else tab(i,j)=4 endif else ! pose tab(i,j)=0 endif end do end do end if if (itab.eq.71) then ! posy : grounded -> 0, , grzone ->1 ilemx->2 flot->3 do j=1,ny do i=1,nx if (gzmy(i,j)) then if (ilemy(i,j)) then tab(i,j)=2 else if (fleuvemy(i,j)) then tab(i,j)=5 ! actual grounded streams else tab(i,j)=1 endif else if (flotmy(i,j)) then if (hmy(i,j).gt.1.) then tab(i,j)=3 else tab(i,j)=4 endif else tab(i,j)=0 endif end do end do end if if (itab.eq.72) then tab(:,:) = frontfacex(:,:) end if if (itab.eq.73) then tab(:,:) = frontfacey(:,:) end if !SORTIE 3D if (itab.eq.74) then !tab1(:,:,:)=CP(:,:,:) A voir declarer dans ice temp declar end if if (itab.eq.75) then !tab1(:,:,:)=CT(:,:,:) A voir declarer dans ice temp declar end if if (itab.eq.76) then tab1(:,:,:)=SUX(:,:,:) end if if (itab.eq.77) then tab1(:,:,:)=SUY(:,:,:) end if if (itab.eq.78) then tab1(:,:,:)=TPMP(:,:,:) end if if (itab.eq.79) then tab1(:,:,:)=UX(:,:,:) end if if (itab.eq.80) then tab1(:,:,:)=UY(:,:,:) end if if (itab.eq.81) then tab1(:,:,:)=UZR(:,:,:) end if if (itab.eq.82) then !tab1(:,:,:)=Chaldef_maj(:,:,:) A voir declarer dans ice temp declar end if if (itab.eq.83) then tab1T(:,:,:)= t(:,:,:) end if if (itab.eq.84) then tab1(:,:,:)= xdep_out(:,:,:) ! aurel neem end if if (itab.eq.85) then tab1(:,:,:)= ydep_out(:,:,:) ! aurel neem end if if (itab.eq.86) then tab1(:,:,:)= tdep_out(:,:,:) ! aurel neem end if ! if (itab.eq.100) then ! vitesse de surface amplitude ! tab(:,:)= sqrt(ux(:,:,1)*ux(:,:,1)+uy(:,:,1)*uy(:,:,1)) ! aurel neem ! end if ! sorties pour debug ! if (itab.eq.101) tab(:,:) = debug_3d(:,:,1) debug_loop : do i_debug=101,nnc-1 if (itab.eq.i_debug) then tab(:,:)=debug_3d(:,:,itab-100) exit debug_loop endif end do debug_loop name =trim(namevar(l)) if (isort_time_ncdf(itab).eq.1) then ! pour les classe 3, sortir les champs 2D necessaires if ((cvar_nc(l) .eq. 3 ).and.( fait .eqv. .FALSE.)) then boucle_var2: do p=1,ntab ! if (itracebug.eq.1) write(num_tracebug,*)' var :',p,' dans netcdf_cat boucle_var2 ' if (ivar_nc(p) .eq. 1) then tab(:,:) = s(:,:) call write_ncdf_var('S',dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,p),'double') endif if (ivar_nc(p) .eq. 2) then tab(:,:) = h(:,:) call write_ncdf_var('H',dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,p),'double') endif if (ivar_nc(p) .eq. 3) then tab(:,:) = bsoc(:,:) call write_ncdf_var('Bsoc',dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,p),'double') endif if (ivar_nc(p) .eq. 7) then tab(:,:) = b(:,:) call write_ncdf_var('B',dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,p),'double') exit boucle_var2 endif end do boucle_var2 fait = .TRUE. end if if (ntype_nc(l) .eq. 'o' ) then if (cvar_nc(l) .eq. 3) then if (name .eq. 'T') then CALL Write_Ncdf_var(name,dimnames3dbis,TRIM(fil_sortie(k)),tab1T,nrecs(k),idef(k,l),'double') else CALL Write_Ncdf_var(name,dimnames3dxymaj,TRIM(fil_sortie(k)),tab1,nrecs(k),idef(k,l),'double') end if else call write_ncdf_var(name,dimnames2dxymaj,trim(fil_sortie(k)),tab,nrecs(k),idef(k,l),'double') end if long_name=longnamevar(l) standard_name=standardnamevar(l) unit=unitsvar(l) descriptions=descripvar(l) status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf if (status(k)/=nf90_noerr) then write(*,*)"unable to open netcdf file : ",fil_sortie(k) stop endif call ncdf_var_info (status(k),ncid(k),name, long_name, standard_name, unit, descriptions) status(k) = nf90_close(ncid(k)) else if (ntype_nc(l) .eq. '>') then if (cvar_nc(l) .eq. 3) then CALL Write_Ncdf_var(name,dimnames3dxmin,TRIM(fil_sortie(k)),tab1,nrecs(k),idef(k,l),'double') else call write_ncdf_var(name,dimnames2dxmin,trim(fil_sortie(k)),tab,nrecs(k),idef(k,l),'double') end if long_name=longnamevar(l) standard_name=standardnamevar(l) unit=unitsvar(l) descriptions=descripvar(l) status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf if (status(k)/=nf90_noerr) then write(*,*)"unable to open netcdf file : ",fil_sortie(k) stop endif call ncdf_var_info (status(k),ncid(k),name, long_name, standard_name, unit, descriptions) status(k) = nf90_close(ncid(k)) else if (ntype_nc(l) .eq. '^') then if (cvar_nc(l) .eq. 3) then CALL Write_Ncdf_var(name,dimnames3dymin,TRIM(fil_sortie(k)),tab1,nrecs(k),idef(k,l),'double') else call write_ncdf_var(name,dimnames2dymin,trim(fil_sortie(k)),tab,nrecs(k),idef(k,l),'double') end if long_name=longnamevar(l) standard_name=standardnamevar(l) unit=unitsvar(l) descriptions=descripvar(l) status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf if (status(k)/=nf90_noerr) then write(*,*)"unable to open netcdf file : ",fil_sortie(k) stop endif call ncdf_var_info (status(k),ncid(k),name, long_name, standard_name, unit, descriptions) status(k) = nf90_close(ncid(k)) else if (ntype_nc(l) .eq. 'x') then if (cvar_nc(l) .eq. 3) then CALL Write_Ncdf_var(name,dimnames3dxymin,TRIM(fil_sortie(k)),tab1,nrecs(k),idef(k,l),'double') else call write_ncdf_var(name,dimnames2dxymin,trim(fil_sortie(k)),tab,nrecs(k),idef(k,l),'double') end if long_name=longnamevar(l) standard_name=standardnamevar(l) unit=unitsvar(l) descriptions=descripvar(l) status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf if (status(k)/=nf90_noerr) then write(*,*)"unable to open netcdf file : ",fil_sortie(k) stop endif call ncdf_var_info (status(k),ncid(k),name, long_name, standard_name, unit, descriptions) status(k) = nf90_close(ncid(k)) end if end if end if end if end if end if ! if (itracebug.eq.1) write(num_tracebug,*)' classe',k,' dans netcdf_cat boucle_var ' end do boucle_var ! if (itracebug.eq.1) write(num_tracebug,*)'apres boucle var',l,'classe',k ksnap: if ( nbsnap(k) .eq. 0) then ! pour le faire 1 fois ! if (itracebug.eq.1) write(num_tracebug,*)'avant allocate nbsnap' allocate(x(nx),y(ny),x1(nx),y1(ny),z(nz),nzzm(nz+nzm),lat(nx,ny),lon(nx,ny)) ! attention le xmin est en km, le remettre en m ! write(6,*) 'bornes domaine dans netcdf',xmin,xmax,ymin,ymax do i=1,nx x(i)=xmin*1000.+(i-1)*dx x1(i)=(xmin*1000.+dx/2)+(i-1)*dx end do do i=1,ny y(i)=ymin*1000.+(i-1)*dy y1(i)=(ymin*1000.+dy/2)+(i-1)*dy end do z(1)=0. z(nz)=1. nzzm(1)=0. nzzm(nz)=1. do i=1,nz if ((i.ne.1).and.(i.ne.nz))then z(i)=(i-1.)/(nz-1.) nzzm(i)=(i-1.)/(nz-1.) end if end do do i= nz+1 ,nz+nzm nzzm(i)=i-nz+1 end do lat(:,:)=ylat(:,:) lon(:,:)=xlong(:,:) ! open(72,file='../'//trim(dirsource)//'/Netcdf-routines/Description_Variables.dat') open(72,file=trim(dirsource)//'/Netcdf-routines/Description_Variables.dat') do read(72,'(a10)') comment if (comment.eq.'~~~~~~~~~~') exit end do ! if (itracebug.eq.1) write(num_tracebug,*)'avant sortie x,y,lon,lat',k call write_ncdf_var('x','x',trim(fil_sortie(k)),x,'double') call write_ncdf_var('y','y',trim(fil_sortie(k)),y,'double') call write_ncdf_var('x1','x1',trim(fil_sortie(k)),x1,'double') call write_ncdf_var('y1','y1',trim(fil_sortie(k)),y1,'double') call write_ncdf_var('z','z',trim(fil_sortie(k)),z,'double') call write_ncdf_var('nzzm','nzzm',trim(fil_sortie(k)),nzzm,'double') call write_ncdf_var('lat',dimnames2dxymaj ,trim(fil_sortie(k)),lat,'double') call write_ncdf_var('lon',dimnames2dxymaj ,trim(fil_sortie(k)),lon,'double') status(k) = nf90_open(trim(fil_sortie(k)),nf90_write,ncid(k)) !ouverture du fichier netcdf if (status(k)/=nf90_noerr) then write(*,*)"unable to open netcdf file : ",fil_sortie(k) stop endif ! lecture des dimensions dans le fichier Description ! time read(72,*) read(72,*) read(72,*) read(72,*) read(72,*) long_name read(72,*) standard_name read(72,*) unit read(72,*) descriptions read(72,*) call ncdf_var_info (status(k),ncid(k),trim('time'), long_name, standard_name, unit, descriptions) ! x read(72,*) read(72,*) read(72,*) read(72,*) long_name read(72,*) standard_name read(72,*) unit read(72,*) descriptions read(72,*) call ncdf_var_info (status(k),ncid(k),trim('x'), long_name, standard_name, unit, descriptions) ! x1 read(72,*) read(72,*) read(72,*) read(72,*) long_name read(72,*) standard_name read(72,*) unit read(72,*) descriptions read(72,*) call ncdf_var_info (status(k),ncid(k),trim('x1'), long_name, standard_name, unit, descriptions) ! y read(72,*) read(72,*) read(72,*) read(72,*) long_name read(72,*) standard_name read(72,*) unit read(72,*) descriptions read(72,*) call ncdf_var_info (status(k),ncid(k),trim('y'), long_name, standard_name, unit, descriptions) ! y1 read(72,*) read(72,*) read(72,*) read(72,*) long_name read(72,*) standard_name read(72,*) unit read(72,*) descriptions read(72,*) call ncdf_var_info (status(k),ncid(k),trim('y1'), long_name, standard_name, unit, descriptions) ! sigma coordinate read(72,*) read(72,*) read(72,*) read(72,*) long_name read(72,*) standard_name read(72,*) unit read(72,*) descriptions read(72,*) call ncdf_var_info (status(k),ncid(k),trim('z'), long_name, standard_name, unit, descriptions) ! coordinate in the bedrock read(72,*) read(72,*) read(72,*) read(72,*) long_name read(72,*) standard_name read(72,*) unit read(72,*) descriptions read(72,*) call ncdf_var_info (status(k),ncid(k),trim('nzzm'), long_name, standard_name, unit, descriptions) read(72,*) read(72,*) read(72,*) read(72,*) long_name read(72,*) standard_name read(72,*) unit read(72,*) descriptions read(72,*) call ncdf_var_info (status(k),ncid(k),trim('lat'), long_name, standard_name, unit, descriptions) read(72,*) read(72,*) read(72,*) read(72,*) long_name read(72,*) standard_name read(72,*) unit read(72,*) descriptions read(72,*) call ncdf_var_info (status(k),ncid(k),trim('lon'), long_name, standard_name, unit, descriptions) !global attributes call ncdf_global_attributes (status(k),ncid(k)) status(k) = nf90_close(ncid(k)) !free memory deallocate(x,y,x1,y1,z,nzzm,lat,lon) ! closing files close(72) end if ksnap ! if (itracebug.eq.1) write(num_tracebug,*)'apres ksnap, classe', k nrecs(k)=nrecs(k)+1 nbsnap(k)=nbsnap(k)+1 end do classes_files end if liste_times ! if (itracebug.eq.1) write(num_tracebug,*)'avant deallocate' deallocate(tab,tab1,tab1T) ! if (itracebug.eq.1) write(num_tracebug,*)'apres deallocate' if (itracebug.eq.1) call tracebug(' sortie de routine sortie_ncdf_cat ') return end subroutine sortie_ncdf_cat !> Subroutine write global attribute in the netcdf file !!@param stats = status of the given netcdf file !!@param ncdf_id = identificator of the given netcdf file !> subroutine ncdf_global_attributes (stats,ncdf_id) !< arguments integer :: ncdf_id,stats !< local variables character (len = 20), parameter :: conventions="Conventions" character (len = 20), parameter :: title="Title" character (len = 20), parameter :: creator="Creator" character (len = 20), parameter :: history="History" character (len = 20), parameter :: references="References" character (len = 20), parameter :: comments="Comments" ! instruction stats = nf90_put_att(ncdf_id,nf90_global,conventions,' **********TO DO******* ') stats = nf90_put_att(ncdf_id,nf90_global,title,' **********TO DO******* ') stats = nf90_put_att(ncdf_id,nf90_global,creator,' **********TO DO******* ') stats = nf90_put_att(ncdf_id,nf90_global,history,' **********TO DO******* ') stats = nf90_put_att(ncdf_id,nf90_global,references,' **********TO DO******* ') stats = nf90_put_att(ncdf_id,nf90_global,comments,' **********TO DO******* ') end subroutine ncdf_global_attributes !> Subroutine write informations related to data in the netcdf file !!@param stats = status of the given netcdf file !!@param ncdf_id = identificator of the given netcdf file !!@param name_var = name of the given variable !!@param long_name = long name for the given variable !!@param standard_name = standard name for the given variable !!@param unit = unit for the given variable !!@param descriptions = descriptions of the give varaible !> subroutine ncdf_var_info (stats,ncdf_id,name_var, long_name, standard_name, unit, descriptions) character(len=*) :: name_var ! nom de variable ! liste des infos correspondant au variable d'interret character (len = 100), parameter :: longname = "long_name" character (len = 100) :: long_name character (len = 100), parameter :: standardname = "standard_name" character (len = 100):: standard_name character (len = 20), parameter :: units = "units" character (len = 20) :: unit character (len = 200), parameter :: description = "descriptions" character (len = 200) :: descriptions integer :: stats,ncdf_id,varid ! variables netcdf stats = nf90_inq_varid(ncdf_id,name_var,varid) stats = nf90_redef(ncdf_id) stats = nf90_put_att(ncdf_id,varid,longname,long_name) stats = nf90_put_att(ncdf_id,varid,standardname,standard_name) stats = nf90_put_att(ncdf_id,varid,units,unit) stats = nf90_put_att(ncdf_id,varid,description,descriptions) end subroutine ncdf_var_info end module sorties_ncdf_grisli