      program create_netcdf

      IMPLICIT NONE

                 
      INTEGER llm,nbt
      INTEGER llmf,nbtf
      INTEGER nbts
      INTEGER llmq,nbtq
      INTEGER llmw,nbtw
      INTEGER lm,nbstep
! llm, nbt: nb de niveaux et de pdt des champs moyens
! llmf, nbtf: nb de niveaux et de pdt des tendances
! nbts: nb de pdt des flux
! llmq, nbtq: nb de niveaux et de pdt de q1 et q2
! lm,nbstep: dimensions du format netcdf
! llmw, nbtw: nb de niveaux et de pdt de uw et vw


      print*, 'Nombre de niveaux des champs moyens'
      read(5,*) llm
      print*, llm
      print*, 'nombre de pas de temps des champs moyens'
      read(5,*) nbt
      print*, nbt
      print*, 'Nombre de niveaux des advections'
      read(5,*) llmf
      print*, llmf
      print*, 'nombre de pas de temps des advections'
      read(5,*) nbtf
      print*, nbtf
      print*, 'nombre de pas de temps des flux'
      read(5,*) nbts
      print*, nbts
      print*, 'Nombre de niveaux des q1 q2'
      read(5,*) llmq
      print*, llmq
      print*, 'nombre de pas de temps des q1 q2'
      read(5,*) nbtq
      print*, nbtq
      print*, 'Nombre de niveaux des uw vw'
      read(5,*) llmw
      print*, llmw
      print*, 'nombre de pas de temps des uw vw'
      read(5,*) nbtw
      print*, nbtw

       lm=max(llm,llmf)
       print*,lm
       nbstep=max(nbt,nbtf,nbts)
       print*,nbstep
       CALL create_netcdf_sub(llm,nbt,llmf,nbtf,nbts,llmq,nbtq,llmw,nbtw,lm,nbstep)

END 


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      SUBROUTINE create_netcdf_sub(llm,nbt,llmf,nbtf,nbts,llmq,nbtq,llmw,nbtw,lm,nbstep)
    

      IMPLICIT NONE

include "netcdf.inc"
include "YOMCST.h"
include "YOETHF.h"
      EXTERNAL suphel    ! initialiser certaines constantes

!Dimensions
!Fichiers etats moyens: llm, nbt
!Fichiers forçages: llmf, nbtf
!Fichiers flux de surface: nbts
!Fichiers de sortie: lm,nbstep

      INTEGER llm, nbt
      INTEGER llmf, nbtf
      INTEGER nbts
      INTEGER llmq, nbtq
      INTEGER llmw, nbtw
      INTEGER lm,nbstep
      INTEGER l,k

      INTEGER xm,ym
      PARAMETER(xm=1,ym=1)
!Variables lues
!Dates
      REAL*8 year(nbt),month(nbt),day(nbt)
      REAL*8 hour(nbt),time(nbt)
      REAL*8 yearf(nbtf),monthf(nbtf),dayf(nbtf)
      REAL*8 hourf(nbtf),timef(nbtf)
      REAL*8 years(nbts),months(nbts),days(nbts)
      REAL*8 hours(nbts),times(nbts)
      REAL*8 yearq(nbtq),monthq(nbtq),dayq(nbtq)
      REAL*8 hourq(nbtq),timeq(nbtq)
      REAL*8 yearw(nbtq),monthw(nbtq),dayw(nbtq)
      REAL*8 hourw(nbtq),timew(nbtq)
      REAL*8 time_out(nbstep)
      REAL*8 time_out_min,time_out_max
      
!Définition lon, lat
      REAL*8 lon(xm),lat(ym)

!niveaux verticaux
      REAL*8 zz(llm,nbt),zzf(llmf,nbtf),zlev(lm,nbstep)

!profils moyens lus
      REAL*8 th(llm,nbt),mwr(llm,nbt),u(llm,nbt),v(llm,nbt)
      REAL*8 pp(llm,nbt),qv(llm,nbt),T(llm,nbt),rh(llm,nbt)
      
!flux de surface lus
      REAL*8 flxs(nbts),flxl(nbts),ts(nbts),ust(nbts)

!forcages grande echelle lus
      REAL*8 ppf(llmf,nbtf),rho(llmf,nbtf)
      REAL*8 ug(llmf,nbtf),vg(llmf,nbtf),w(llmf,nbtf)
      REAL*8 du(llmf,nbtf),hu(llmf,nbtf),vu(llmf,nbtf)
      REAL*8 dv(llmf,nbtf),hv(llmf,nbtf),vv(llmf,nbtf)
      REAL*8 dT(llmf,nbtf),hT(llmf,nbtf),vT(llmf,nbtf),dtrad(llmf,nbtf)
      REAL*8 dq(llmf,nbtf),hq(llmf,nbtf),vq(llmf,nbtf)
      REAL*8 dth(llmf,nbtf),hth(llmf,nbtf),vth(llmf,nbtf)
      REAL*8 dr(llmf,nbtf),hr(llmf,nbtf),vr(llmf,nbtf)

!q1 q2 lus
      REAL*8 ppq(llmq,nbtq)
      REAL*8 qq1(llmq,nbtq),qq2(llmq,nbtq)

!uw vw lus
      REAL*8 ppw(llmw,nbtw)
      REAL*8 uuw(llmw,nbtw),vvw(llmw,nbtw)

!Paramètres de forçages
      INTEGER tend_u,tend_v,tend_w,tend_t,tend_q
      INTEGER nudg_u,nudg_v,nudg_w,nudg_t,nudg_q
      
      REAL*8 XLVTT
      PARAMETER(XLVTT=2.5008E+6)

!Variables intermédaires
      REAL*8 ppf_tmpv(lm,nbtf)
      REAL*8 ug_tmpv(lm,nbtf),vg_tmpv(lm,nbtf),w_tmpv(lm,nbtf)
      REAL*8 du_tmpv(lm,nbtf),hu_tmpv(lm,nbtf),vu_tmpv(lm,nbtf)
      REAL*8 dv_tmpv(lm,nbtf),hv_tmpv(lm,nbtf),vv_tmpv(lm,nbtf)
      REAL*8 dT_tmpv(lm,nbtf),hT_tmpv(lm,nbtf),vT_tmpv(lm,nbtf)
      REAL*8 dtrad_tmpv(lm,nbtf)
      REAL*8 dq_tmpv(lm,nbtf),hq_tmpv(lm,nbtf),vq_tmpv(lm,nbtf)
      REAL*8 dth_tmpv(lm,nbtf),hth_tmpv(lm,nbtf),vth_tmpv(lm,nbtf)
      REAL*8 dr_tmpv(lm,nbtf),hr_tmpv(lm,nbtf),vr_tmpv(lm,nbtf)      

      REAL*8 th_tmpv(lm,nbt),mwr_tmpv(lm,nbt),u_tmpv(lm,nbt),v_tmpv(lm,nbt)
      REAL*8 pp_tmpv(lm,nbt),qv_tmpv(lm,nbt),T_tmpv(lm,nbt),rh_tmpv(lm,nbt)

      REAL*8 ppq_tmpv(lm,nbtq),q1_tmpv(lm,nbtq),q2_tmpv(lm,nbtq)
      REAL*8 ppw_tmpv(lm,nbtw),uw_tmpv(lm,nbtw),vw_tmpv(lm,nbtw)

      REAL*8 zz_tmpv(lm,nbt),zzf_tmpv(lm,nbtf)

!Variables ecrites dans fichier netcdf aux dimensions lm,nbstep
!profils moyen
      REAL*8 vitu(lm,nbstep),vitv(lm,nbstep)
      REAL*8 pres(lm,nbstep),ovap(lm,nbstep),temp(lm,nbstep),rhum(lm,nbstep)
      REAL*8 theta(lm,nbstep),rvv(lm,nbstep)     

!flux de surface
      REAL*8 flat(nbstep),sens(nbstep),tsurf(nbstep),ustar(nbstep)

!forcages grande echelle
      REAL*8 vitug(lm,nbstep),vitvg(lm,nbstep),vitw(lm,nbstep)
      REAL*8 advT(lm,nbstep),T_advh(lm,nbstep),T_advv(lm,nbstep)
      REAL*8 radT(lm,nbstep)
      REAL*8 advq(lm,nbstep),q_advh(lm,nbstep),q_advv(lm,nbstep)   
      REAL*8 advth(lm,nbstep),th_advh(lm,nbstep),th_advv(lm,nbstep)
      REAL*8 advr(lm,nbstep),r_advh(lm,nbstep),r_advv(lm,nbstep)   
      REAL*8 advu(lm,nbstep),u_advh(lm,nbstep),u_advv(lm,nbstep)
      REAL*8 advv(lm,nbstep),v_advh(lm,nbstep),v_advv(lm,nbstep)  

      REAL*8 q1(lm,nbstep),q2(lm,nbstep)  
      REAL*8 uw(lm,nbstep),vw(lm,nbstep)  

      REAL*8 timestep,dtm,dtf,dts
      REAL*8 day_init,month_init
      REAL*8 dayf_init,monthf_init
      REAL*8 days_init,months_init
      REAL*8 dayq_init,monthq_init
      REAL*8 dayw_init,monthw_init
      INTEGER nday,ndayf,ndays,ndayq,ndayw

!Définition des sorties
      integer nbvar3d_out
      parameter (nbvar3d_out=39)
      character (len=50), dimension(nbvar3d_out) :: varname3d_out

      integer ierr
      
      integer :: londimout,latdimout
      integer :: altdimout,timedimout
!,timevarout
      integer :: nout

      integer var3didout(39),toto(lm)

      character*4 poub
      real*8 ppp(lm)

      CALL suphel
      print *,'Apres CALL suphel'

!     Read in data
!     read initial profiles

      open(10,file='profil_moy_fleur.txt')
! Combien de profils d environnement ?
      read(10,*),nbt
! Combien de niveaux ?
      read(10,*),llm
      do l=1,nbt
          read (10,*) year(l),month(l),day(l),hour(l)
          do k=1,llm
             read(10,*) pp(k,l),zz(k,l),u(k,l),v(k,l),T(k,l),th(k,l),qv(k,l),mwr(k,l),rh(k,l)
             write(*,*) pp(k,l),zz(k,l),u(k,l),v(k,l),T(k,l),th(k,l),qv(k,l),mwr(k,l),rh(k,l) 
             pp(k,l)=pp(k,l)*100.
          enddo
      enddo
      close(10)

!read tendencies
!-------------------------------
! TEND A B C D E
! A=1 on utilise tendances sur U
! B=1 on utilise tendances sur V
! C=1 on utilise tendances sur W
! D=1 on utilise tendances sur theta
! E=1 on utilise tendances sur vapeur eau
!-------------------------------
! NUDG A B C D E
! A= U est nudge avec un temps de relaxation de A
! B= V est nudge avec un temps de relaxation de B
! C= W est nudge avec un temps de relaxation de C
! D= theta est nudge avec un temps de relaxation de D
! E= vapeur d'eau est nudgee avec un temps de relaxation de E
! si A,B,C,D,E=0 => pas de nudging
! si A,B=-1 => nudging avec vent geostrophique fourni
!-------------------------------
      open(11,file='profil_adv_fleur.txt')
! Lecture des flags de tendances
      read(11,*),poub,tend_u,tend_v,tend_w,tend_t,tend_q
      IF (poub.NE.'TEND') stop 'Erreur fichier profil_tend_fleur.txt ! manque TEND'
! Lecture des flags de nudging
      read(11,*),poub,nudg_u,nudg_v,nudg_w,nudg_t,nudg_q
      IF (poub.NE.'NUDG') stop 'Erreur fichier profil_tend_fleur.txt ! manque NUDG'
! Combien de profils de forcing ?
      read(11,*),nbtf
! Combien de niveaux ?
      read(11,*),llmf
! Lecture des profils
      do l=1,nbtf
          read (11,*) yearf(l),monthf(l),dayf(l),hourf(l)
          do k=1,llmf
             read(11,*) ppf(k,l),zzf(k,l),ug(k,l),vg(k,l),w(k,l),du(k,l),hu(k,l),vu(k,l) &
     &                 ,dv(k,l),hv(k,l),vv(k,l),dT(k,l),hT(k,l),vT(k,l),dtrad(k,l),dq(k,l) &
     &                 ,hq(k,l),vq(k,l),dth(k,l),hth(k,l),vth(k,l),dr(k,l),hr(k,l),vr(k,l) 
! Fleur parle en hPa
             ppf(k,l)=ppf(k,l)*100.  
! conversion m/s en Pa/s
             rho(k,l)=ppf(k,l)/T(k,1)/RD 
! chgt signe car subsidence
             w(k,l)=-1.*w(k,l)*rho(k,l)*RG 
!            write(*,*) ppf(k,l),zzf(k,l),ug(k,l),vg(k,l),w(k,l),du(k,l),hu(k,l),vu(k,l),dv(k,l),hv(k,l),vv(k,l), &
!    &                  dT(k,l),hT(k,l),vT(k,l),dq(k,l),hq(k,l),vq(k,l),dth(k,l),hth(k,l),vth(k,l),dr(k,l),hr(k,l),vr(k,l) 
          enddo
      enddo
      close(11)

!Lecture des flux
      open(12,file='time_flux_fleur.txt')
! Combien de flux?
      read(12,*),nbts
      do l=1,nbts
         read(12,*) years(l),months(l),days(l),hours(l),flxs(l),flxl(l),ts(l)
         ts(l)=300.375
         ust(l)=0.28
!        write(*,*) years(l),months(l),days(l),hours(l),flxs(l),flxl(l)
      enddo
      close(12)

!     read Q1, Q2

      open(13,file='q1_q2_fleur.txt')
! Combien de profils de q1 q2 ?
      read(13,*),nbtq
! Combien de niveaux ?
      read(13,*),llmq
      do l=1,nbtq
          read (13,*) yearq(l),monthq(l),dayq(l),hourq(l)
          do k=1,llmq
             read(13,*) ppq(k,l),qq1(k,l),qq2(k,l)
          enddo
      enddo
      close(13)

!     read uw, vw

      open(14,file='uw_vw_fleur.txt')
! Combien de profils de uw vw ?
      read(14,*),nbtw
! Combien de niveaux ?
      read(14,*),llmw
      do l=1,nbtw
          read (14,*) yearw(l),monthw(l),dayw(l),hourw(l)
          do k=1,llmw
             read(14,*) ppw(k,l),uuw(k,l),vvw(k,l)
          enddo
      enddo
      close(14)


!définition lon,lat: Bomex
      lon(1)=-56.5
      lat(1)=15.0
!définition lon,lat: Cindy
!     lon(1)=73.15
!     lat(1)=-0.69
!AMMA
!      lon(1)=2.18
!      lat(1)=13.47
!IHOP
!      lon(1)=-100.61
!      lat(1)=36.56


!definition des axes des temps en secondes a partir du debut du cas
      time(1)=hour(1)
      print *,'time(1)=',time(1)
      day_init=day(1)
      month_init=month(1)
      nday=1
      if (nbt.gt.1) then
      do l=2,nbt
         if (day(l).ne.day(l-1)) then
             nday=nday+1
         endif
         time(l)=hour(l)+(nday-1)*24.*3600.
         print *,'1 l time=',l,month(l),day(l),hour(l),time(l)
      enddo
      dtm=time(2)-time(1)
      else
      dtm=0.
      endif
      print*,"dtm=",dtm      

      timef(1)=hourf(1)
      print *,'timef(1)=',timef(1)
      dayf_init=dayf(1)
      monthf_init=monthf(1)
      ndayf=1
      do l=2,nbtf
         if (dayf(l).ne.dayf(l-1)) then
             ndayf=ndayf+1
         endif
         timef(l)=hourf(l)+(ndayf-1)*24.*3600.
         print *,'1 l timef=',l,monthf(l),dayf(l),hourf(l),timef(l)
      enddo
      dtf=timef(2)-timef(1)
      print*,"dtf=",dtf         

      times(1)=hours(1)
      print *,'times(1)=',times(1)
      days_init=days(1)
      months_init=months(1)
      ndays=1
      do l=2,nbts
         if (days(l).ne.days(l-1)) then
             ndays=ndays+1
         endif
         times(l)=hours(l)+(ndays-1)*24.*3600.
         print *,'1 l time=',l,months(l),days(l),hours(l),times(l)
      enddo
      dts=times(2)-times(1)
      print*,"dts=",dts   

      timeq(1)=hourq(1)
      print *,'timeq(1)=',timeq(1)
      dayq_init=dayq(1)
      monthq_init=monthq(1)
      ndayq=1
      do l=2,nbtq
         if (dayq(l).ne.dayq(l-1)) then
             ndayq=ndayq+1
         endif
         timeq(l)=hourq(l)+(ndayq-1)*24.*3600.
         print *,'1 l time=',l,monthq(l),dayq(l),hourq(l),timeq(l)
      enddo

      timew(1)=hourw(1)
      print *,'timew(1)=',timew(1)
      dayw_init=dayw(1)
      monthw_init=monthw(1)
      ndayw=1
      do l=2,nbtw
         if (dayw(l).ne.dayw(l-1)) then
             ndayw=ndayw+1
         endif
         timew(l)=hourw(l)+(ndayw-1)*24.*3600.
         print *,'1 l time=',l,monthw(l),dayw(l),hourw(l),timew(l)
      enddo


!Choix d'une grille verticale et temporelle unique
!On prend la resolution la plus fine

!Interpolation sur la meme grille verticale si necessaire
      
      if (llm.ne.llmf) then
         if (llm.gt.llmf) then
            print *,'llm > llmf'
            call interp_vertical(llmf,nbtf,lm,pp,ppf,zzf,zzf_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,ppf,ppf_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,ug,ug_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,vg,vg_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,w,w_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,du,du_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,hu,hu_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,vu,vu_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,dv,dv_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,hv,hv_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,vv,vv_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,dT,dT_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,hT,hT_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,vT,vT_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,dtrad,dtrad_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,dq,dq_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,hq,hq_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,vq,vq_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,dth,dth_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,hth,hth_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,vth,vth_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,dr,dr_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,hr,hr_tmpv)
            call interp_vertical(llmf,nbtf,lm,pp,ppf,vr,vr_tmpv)

            do l=1,nbt
                do k=1,lm
                    zz_tmpv(k,l)=zz(k,l)
                    u_tmpv(k,l)=u(k,l)
                    v_tmpv(k,l)=v(k,l)
                    T_tmpv(k,l)=T(k,l)
                    th_tmpv(k,l)=th(k,l)
                    mwr_tmpv(k,l)=mwr(k,l)
                    qv_tmpv(k,l)=qv(k,l)
                    rh_tmpv(k,l)=rh(k,l)
                enddo
             enddo

         else if (llmf.gt.llm) then
 
            print *,'llmf > llm'
            call interp_vertical(llm,nbt,lm,ppf,pp,zz,zz_tmpv)
            call interp_vertical(llm,nbt,lm,ppf,pp,u,u_tmpv)
            call interp_vertical(llm,nbt,lm,ppf,pp,v,v_tmpv)
            call interp_vertical(llm,nbt,lm,ppf,pp,T,T_tmpv)
            call interp_vertical(llm,nbt,lm,ppf,pp,th,th_tmpv)
            call interp_vertical(llm,nbt,lm,ppf,pp,mwr,mwr_tmpv)
            call interp_vertical(llm,nbt,lm,ppf,pp,qv,qv_tmpv)
            call interp_vertical(llm,nbt,lm,ppf,pp,rh,rh_tmpv)

            do l=1,nbtf
                do k=1,lm
                    zzf_tmpv(k,l)=zzf(k,l)
                    ppf_tmpv(k,l)=ppf(k,l)
                    ug_tmpv(k,l)=ug(k,l)
                    vg_tmpv(k,l)=vg(k,l)
                    w_tmpv(k,l)=w(k,l)
                    du_tmpv(k,l)=du(k,l)
                    hu_tmpv(k,l)=hu(k,l)
                    vu_tmpv(k,l)=vu(k,l)
                    dv_tmpv(k,l)=dv(k,l)
                    hv_tmpv(k,l)=hv(k,l)
                    vv_tmpv(k,l)=vv(k,l)
                    dT_tmpv(k,l)=dT(k,l)
                    hT_tmpv(k,l)=hT(k,l)
                    vT_tmpv(k,l)=vT(k,l)
                    dtrad_tmpv(k,l)=dtrad(k,l)
                    dq_tmpv(k,l)=dq(k,l)
                    hq_tmpv(k,l)=hq(k,l)
                    vq_tmpv(k,l)=vq(k,l)
                    dth_tmpv(k,l)=dth(k,l)
                    hth_tmpv(k,l)=hth(k,l)
                    vth_tmpv(k,l)=vth(k,l)
                    dr_tmpv(k,l)=dr(k,l)
                    hr_tmpv(k,l)=hr(k,l)
                    vr_tmpv(k,l)=vr(k,l)
                enddo
             enddo

         endif

        else
            print *,'llm = llmf'
!  rappel: lm= max (llm,llmf)
             do l=1,nbt
                do k=1,lm
                    zz_tmpv(k,l)=zz(k,l)
                    pp_tmpv(k,l)=pp(k,l) 
                    u_tmpv(k,l)=u(k,l)
                    v_tmpv(k,l)=v(k,l)
                    T_tmpv(k,l)=T(k,l)
                    th_tmpv(k,l)=th(k,l)
                    mwr_tmpv(k,l)=mwr(k,l)
                    qv_tmpv(k,l)=qv(k,l)
                    rh_tmpv(k,l)=rh(k,l)
                 enddo
              enddo
              do l=1,nbtf
                do k=1,lm
                    zzf_tmpv(k,l)=zzf(k,l)
                    ppf_tmpv(k,l)=ppf(k,l)
                    ug_tmpv(k,l)=ug(k,l)
                    vg_tmpv(k,l)=vg(k,l)
                    w_tmpv(k,l)=w(k,l)
                    du_tmpv(k,l)=du(k,l)
                    hu_tmpv(k,l)=hu(k,l)
                    vu_tmpv(k,l)=vu(k,l)
                    dv_tmpv(k,l)=dv(k,l)
                    hv_tmpv(k,l)=hv(k,l)
                    vv_tmpv(k,l)=vv(k,l)
                    dT_tmpv(k,l)=dT(k,l)
                    hT_tmpv(k,l)=hT(k,l)
                    vT_tmpv(k,l)=vT(k,l)
                    dtrad_tmpv(k,l)=dtrad(k,l)
                    dq_tmpv(k,l)=dq(k,l)
                    hq_tmpv(k,l)=hq(k,l)
                    vq_tmpv(k,l)=vq(k,l)
                    dth_tmpv(k,l)=dth(k,l)
                    hth_tmpv(k,l)=hth(k,l)
                    vth_tmpv(k,l)=vth(k,l)
                    dr_tmpv(k,l)=dr(k,l)
                    hr_tmpv(k,l)=hr(k,l)
                    vr_tmpv(k,l)=vr(k,l)
                enddo
             enddo
             print*,'pas d interpolation verticale'
       endif

       if (llm.ne.llmq) then
            call interp_vertical(llmq,nbtq,lm,pp,ppq,ppq,ppq_tmpv)
            call interp_vertical(llmq,nbtq,lm,pp,ppq,qq1,q1_tmpv)
            call interp_vertical(llmq,nbtq,lm,pp,ppq,qq2,q2_tmpv)

       else

            do l=1,nbtq
                do k=1,lm
                    ppq_tmpv(k,l)=ppq(k,l)
                    q1_tmpv(k,l)=qq1(k,l)
                    q2_tmpv(k,l)=qq2(k,l)
                enddo
            enddo
       endif

       if (llm.ne.llmw) then
            call interp_vertical(llmw,nbtw,lm,pp,ppw,ppw,ppw_tmpv)
            call interp_vertical(llmw,nbtw,lm,pp,ppw,uuw,uw_tmpv)
            call interp_vertical(llmw,nbtw,lm,pp,ppw,vvw,vw_tmpv)

       else

            do l=1,nbtw
                do k=1,lm
                    ppw_tmpv(k,l)=ppw(k,l)
                    uw_tmpv(k,l)=uuw(k,l)
                    vw_tmpv(k,l)=vvw(k,l)
                enddo
            enddo
       endif

       print*, 'apres interpolation verticale'

!Interpolation en temps si necessaire

      time_out_min=min(time(1),timef(1),times(1))
      print*, time_out_min
      time_out_max=max(time(nbt),timef(nbtf),times(nbts))
      print*, time_out_max
      if (dtm.eq.0.) then
          timestep=min(dtf,dts)
      else
          timestep=min(dtm,dtf,dts)
      endif
      print*, 'timestep=',timestep

!      nbstep=int((time_out_max-time_out_min)/timestep)
!      print*, nbstep

!      time_out(1)=time(1)
      time_out(1)=time_out_min
      print*, time_out(1)
!      time_out(nbstep)=timef(nbtf)
      time_out(nbstep)=time_out_max
      print*, time_out(nbstep)
      do l=2,nbstep-1
         time_out(l)=time_out(1)+(l-1)*timestep
         print*, time_out(l)
      enddo
      do l=1,nbstep
      print*,'time_out',time_out(l)
      enddo

      print*, 'apres calcul time'

      if (nbstep.ne.nbt) then
         call interp_time(lm,nbt,nbstep,dtm,time,time_out,pp_tmpv,pres)
         call interp_time(lm,nbt,nbstep,dtm,time,time_out,zz_tmpv,zlev)
         call interp_time(lm,nbt,nbstep,dtm,time,time_out,u_tmpv,vitu)
         call interp_time(lm,nbt,nbstep,dtm,time,time_out,v_tmpv,vitv)
         call interp_time(lm,nbt,nbstep,dtm,time,time_out,T_tmpv,temp)
         call interp_time(lm,nbt,nbstep,dtm,time,time_out,th_tmpv,theta)
         call interp_time(lm,nbt,nbstep,dtm,time,time_out,mwr_tmpv,rvv)
         call interp_time(lm,nbt,nbstep,dtm,time,time_out,qv_tmpv,ovap)
         call interp_time(lm,nbt,nbstep,dtm,time,time_out,rh_tmpv,rhum)

!          do l=1,nbt
!             do k=1,lm
!                print*,'T avant',l,k,T_tmpv(k,l)
!             enddo
!          enddo
       
!          do l=1,nbstep
!             do k=1,lm
!                print*,'T apres',l,k,temp(k,l)
!             enddo
!          enddo

      else
         
         do l=1,nbstep
            do k=1,lm
               pres(k,l)=pp_tmpv(k,l)
               zlev(k,l)=zz_tmpv(k,l)
               vitu(k,l)=u_tmpv(k,l)
               vitv(k,l)=v_tmpv(k,l)
               temp(k,l)=T_tmpv(k,l)
               theta(k,l)=th_tmpv(k,l)
               rvv(k,l)=mwr_tmpv(k,l)
               ovap(k,l)=qv_tmpv(k,l)
               rhum(k,l)=rh_tmpv(k,l)
            enddo
         enddo

      endif

      print*, 'apres interpolation champs moyens'

      if (nbstep.ne.nbtf) then
!         do l=1,nbtf
!            do k=1,lm
!               print*,'avant interpolation ppf_tmpv',l,k,ppf_tmpv(k,l)
!            enddo
!         enddo
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,ppf_tmpv,pres)
!         do l=1,nbstep
!            do k=1,lm
!               print*,'apres interpolation pres',l,k,pres(k,l)
!            enddo
!         enddo
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,zzf_tmpv,zlev)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,ug_tmpv,vitug)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vg_tmpv,vitvg)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,w_tmpv,vitw)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,du_tmpv,advu)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,hu_tmpv,u_advh)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vu_tmpv,u_advv)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,dv_tmpv,advv)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,hv_tmpv,v_advh)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vv_tmpv,v_advv)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,dT_tmpv,advT)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,hT_tmpv,T_advh)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vT_tmpv,T_advv)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,dtrad_tmpv,radT)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,dq_tmpv,advq)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,hq_tmpv,q_advh)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vq_tmpv,q_advv)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,dth_tmpv,advth)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,hth_tmpv,th_advh)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vth_tmpv,th_advv)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,dr_tmpv,advr)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,hr_tmpv,r_advh)
         call interp_time(lm,nbtf,nbstep,dtf,timef,time_out,vr_tmpv,r_advv)
       else

         do l=1,nbstep
            do k=1,lm
               pres(k,l)=ppf_tmpv(k,l)
               zlev(k,l)=zzf_tmpv(k,l)
               vitug(k,l)=ug_tmpv(k,l)
               vitvg(k,l)=vg_tmpv(k,l)
               vitw(k,l)=w_tmpv(k,l)
               advu(k,l)=du_tmpv(k,l)
               u_advh(k,l)=hu_tmpv(k,l)
               u_advv(k,l)=vu_tmpv(k,l)
               advv(k,l)=dv_tmpv(k,l)
               v_advh(k,l)=hv_tmpv(k,l)
               v_advv(k,l)=vv_tmpv(k,l)
               advT(k,l)=dT_tmpv(k,l)
               T_advh(k,l)=hT_tmpv(k,l)
               T_advv(k,l)=vT_tmpv(k,l)
               radT(k,l)=dtrad_tmpv(k,l)
               advq(k,l)=dq_tmpv(k,l)
               q_advh(k,l)=hq_tmpv(k,l)
               q_advv(k,l)=vq_tmpv(k,l)
               advth(k,l)=dth_tmpv(k,l)
               th_advh(k,l)=hth_tmpv(k,l)
               th_advv(k,l)=vth_tmpv(k,l)
               advr(k,l)=dr_tmpv(k,l)
               r_advh(k,l)=hr_tmpv(k,l)
               r_advv(k,l)=vr_tmpv(k,l)
            enddo
         enddo

       endif

       print*, 'apres interpolation forcages'

       if (nbstep.ne.nbts) then
         call interp_time(1,nbts,nbstep,timestep,times,time_out,flxs,sens)
         call interp_time(1,nbts,nbstep,timestep,times,time_out,flxl,flat)
         call interp_time(1,nbts,nbstep,timestep,times,time_out,ts,tsurf)
         call interp_time(1,nbts,nbstep,timestep,times,time_out,ust,ustar)
       else
          do l=1,nbstep
             sens(l)=flxs(l)
             flat(l)=flxl(l)
             tsurf(l)=ts(l)
             ustar(l)=ust(l)
          enddo         

       endif

       print*, 'apres interpolation flux'

       if (nbstep.ne.nbtq) then
         call interp_time(lm,nbtq,nbstep,dtm,timeq,time_out,ppq_tmpv,pres)
         call interp_time(lm,nbtq,nbstep,dtm,timeq,time_out,q1_tmpv,q1)
         call interp_time(lm,nbtq,nbstep,dtm,timeq,time_out,q2_tmpv,q2)

       else
          do l=1,nbstep
            do k=1,lm
               pres(k,l)=ppq_tmpv(k,l)
               q1(k,l)=q1_tmpv(k,l)
               q2(k,l)=q2_tmpv(k,l)
            enddo
         enddo        

       endif

       print*, 'apres interpolation q1,q2'

       if (nbstep.ne.nbtw) then
         call interp_time(lm,nbtw,nbstep,dtm,timew,time_out,ppw_tmpv,pres)
         call interp_time(lm,nbtw,nbstep,dtm,timew,time_out,uw_tmpv,uw)
         call interp_time(lm,nbtw,nbstep,dtm,timew,time_out,vw_tmpv,vw)

       else
          do l=1,nbstep
            do k=1,lm
               pres(k,l)=ppw_tmpv(k,l)
               uw(k,l)=uw_tmpv(k,l)
               vw(k,l)=vw_tmpv(k,l)
            enddo
         enddo        

       endif
       print*, 'apres interpolation uw,vw'

!ecriture des resultats dans un fichier nc

         print*,'avant ecriture ok',nbstep,lm
 
         do k=1,lm
            ppp(k)=pres(k,1)
         enddo
         call initiate ("caf.nc",lon,lat,ppp,time_out,&
                        londimout,latdimout,altdimout,timedimout,nbstep,lm,ym,xm)

         print*,'apres initiate: lon,lat=',lon,lat
!        print*,'=============='
         call def_var(nout,"zz","z","m","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(1),ierr)
         call def_var(nout,"pp","pp","hPa","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(2),ierr)
         call def_var(nout,"temp","temp","K","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(3),ierr)
         call def_var(nout,"qv","qv","kg/kg","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(4),ierr)
         call def_var(nout,"rh","rh","","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(5),ierr)
         call def_var(nout,"theta","theta","K","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(6),ierr)
         call def_var(nout,"rv","rv","kg/kg","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(7),ierr)
         call def_var(nout,"u","u","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(8),ierr)
         call def_var(nout,"v","v","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(9),ierr)
         call def_var(nout,"ug","ug","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(10),ierr)
         call def_var(nout,"vg","vg","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(11),ierr)
         call def_var(nout,"w","w","Pa/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(12),ierr)
         call def_var(nout,"advu","advu","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(13),ierr)
         call def_var(nout,"hu","hu","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(14),ierr)
         call def_var(nout,"vu","vu","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(15),ierr)
         call def_var(nout,"advv","advv","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(16),ierr)
         call def_var(nout,"hv","hv","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(17),ierr)
         call def_var(nout,"vv","vv","m/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(18),ierr)
         call def_var(nout,"advT","advT","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(19),ierr)
         call def_var(nout,"hT","hT","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(20),ierr)
         call def_var(nout,"vT","vT","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(21),ierr)
         call def_var(nout,"advq","advq","kg/kg/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(22),ierr)
         call def_var(nout,"hq","hq","kg/kg/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(23),ierr)
         call def_var(nout,"vq","vq","kg/kg/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(24),ierr)
         call def_var(nout,"advth","advth","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(25),ierr)
         call def_var(nout,"hth","hth","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(26),ierr)
         call def_var(nout,"vth","vth","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(27),ierr)
         call def_var(nout,"advr","advr","kg/kg/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(28),ierr)
         call def_var(nout,"hr","hr","kg/kg/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(29),ierr)
         call def_var(nout,"vr","vr","kg/kg/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(30),ierr)
         call def_var(nout,"radT","radT","K/s","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(31),ierr)
         call def_var(nout,"sens","sens","W/m2","",3,(/londimout,latdimout,timedimout/),var3didout(32),ierr)
         call def_var(nout,"flat","flat","W/m2","",3,(/londimout,latdimout,timedimout/),var3didout(33),ierr)
         call def_var(nout,"ts","ts","K","",3,(/londimout,latdimout,timedimout/),var3didout(34),ierr)
         call def_var(nout,"ustar","ustar","m/s","",3,(/londimout,latdimout,timedimout/),var3didout(35),ierr)
         call def_var(nout,"q1","q1","K/day","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(36),ierr)
         call def_var(nout,"q2","q2","K/day","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(37),ierr)
         call def_var(nout,"uw","uw","m2/s2","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(38),ierr)
         call def_var(nout,"vw","vw","m2/s2","",4,(/londimout,latdimout,altdimout,timedimout/),var3didout(39),ierr)
!on écrit plutot ça dans un .def?
!         call def_var(nout,"tend_u","tend_u","-",1,(/altdimout/),var3didout(27),ierr)
!         call def_var(nout,"tend_v","tend_v","-",1,(/altdimout/),var3didout(28),ierr)
!         call def_var(nout,"tend_w","tend_w","-",1,(/altdimout/),var3didout(29),ierr)
!         call def_var(nout,"tend_t","tend_t","-",1,(/altdimout/),var3didout(30),ierr)
!         call def_var(nout,"tend_q","tend_q","-",1,(/altdimout/),var3didout(31),ierr)
!         call def_var(nout,"nudg_u","nudg_u","-",1,(/altdimout/),var3didout(32),ierr)
!         call def_var(nout,"nudg_v","nudg_v","-",1,(/altdimout/),var3didout(33),ierr)
!         call def_var(nout,"nudg_w","nudg_w","-",1,(/altdimout/),var3didout(34),ierr)
!         call def_var(nout,"nudg_t","nudg_t","-",1,(/altdimout/),var3didout(35),ierr)
!         call def_var(nout,"nudg_q","nudg_q","-",1,(/altdimout/),var3didout(36),ierr)

! A FAIRE: ajouter a la suite les scalaires qui sont fournis par profil_init_fleur.txt
    
#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(1),zlev)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(1),zlev)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_1"
         endif
 
#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(2),pres)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(2),pres)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_2"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(3),temp)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(3),temp)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_3"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(4),ovap)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(4),ovap)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_4"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(5),rhum)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(5),rhum)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_5"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(6),theta)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(6),theta)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_6"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(7),rvv)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(7),rvv)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_7"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(8),vitu)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(8),vitu)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_8"
         endif
     
#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(9),vitv)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(9),vitv)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_9"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(10),vitug)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(10),vitug)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_10"
         endif
     
#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(11),vitvg)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(11),vitvg)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_11"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(12),vitw)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(12),vitw)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_12"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(13),advu)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(13),advu)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_13"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(14),u_advh)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(14),u_advh)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_14"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(15),u_advv)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(15),u_advv)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_15"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(16),advv)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(16),advv)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_16"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(17),v_advh)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(17),v_advh)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_17"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(18),v_advv)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(18),v_advv)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_18"
         endif


#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(19),advT)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(19),advT)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_19"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(20),T_advh)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(20),T_advh)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_20"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(21),T_advv)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(21),T_advv)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_21"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(22),advq)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(22),advq)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_22"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(23),q_advh)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(23),q_advh)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_23"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(24),q_advv)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(24),q_advv)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_24"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(25),advth)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(25),advth)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_25"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(26),th_advh)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(26),th_advh)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_26"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(27),th_advv)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(27),th_advv)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_27"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(28),advr)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(28),advr)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_28"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(29),r_advh)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(29),r_advh)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_29"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(30),r_advv)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(30),r_advv)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_30"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(31),radT)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(31),radT)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_31"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(32),sens)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(32),sens)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_32"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(33),flat)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(33),flat)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_33"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(34),tsurf)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(34),tsurf)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_34"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(35),ustar)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(35),ustar)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_35"
         endif


#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(36),q1)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(36),q1)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_36"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(37),q2)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(37),q2)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_37"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(38),uw)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(38),uw)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_38"
         endif

#ifdef NC_DOUBLE
         ierr= NF_PUT_VAR_DOUBLE(nout,var3didout(39),vw)
#else
         ierr= NF_PUT_VAR_REAL(nout,var3didout(39),vw)
#endif     
         if(ierr/=NF_NOERR) then
            write(*,*) NF_STRERROR(ierr)
            stop "putvar3d_39"
         endif

!         toto(:)=tend_u
!         ierr= NF_PUT_VAR_INT(nout,var3didout(18),toto)
!         toto(:)=tend_v
!         ierr= NF_PUT_VAR_INT(nout,var3didout(19),toto)
!         toto(:)=tend_w
!         ierr= NF_PUT_VAR_INT(nout,var3didout(20),toto)
!         toto(:)=tend_t
!         ierr= NF_PUT_VAR_INT(nout,var3didout(21),toto)
!         toto(:)=tend_q
!         ierr= NF_PUT_VAR_INT(nout,var3didout(22),toto)
!         toto(:)=nudg_u
!         ierr= NF_PUT_VAR_INT(nout,var3didout(23),toto)
!         toto(:)=nudg_v
!         ierr= NF_PUT_VAR_INT(nout,var3didout(24),toto)
!         toto(:)=nudg_w
!         ierr= NF_PUT_VAR_INT(nout,var3didout(25),toto)
!         toto(:)=nudg_t
!         ierr= NF_PUT_VAR_INT(nout,var3didout(26),toto)
!         toto(:)=nudg_q
!         ierr= NF_PUT_VAR_INT(nout,var3didout(27),toto)

ierr=NF_CLOSE(nout)       
       
print*, 'fin'
      

       contains
!**********************************************************
Subroutine initiate (filename,x,y,z,time,&
                     londimout,latdimout,altdimout,timedimout,&
                     nj,lm,ym,xm)

implicit none

include "netcdf.inc"

character (len=*), intent(in):: filename
real*8, dimension(:), intent(in):: x,y,z,time
!integer, intent(out):: nout,timevarout
integer, intent(out):: londimout,latdimout,altdimout,timedimout

integer :: altdim,timedim
integer :: newvarid
integer :: nvarid,ierr,i,kloop,nj,lm,ym,xm
!real, dimension(nj), intent(out) :: time

write(*,*) "creating "//trim(adjustl(filename))//'...'
ierr = NF_CREATE(filename,NF_CLOBBER, nout)
if (ierr.NE.NF_NOERR) THEN
   WRITE(*,*)'ERROR: Impossible to create the file.'
   WRITE(*,*) NF_STRERROR(ierr)
   stop ""
endif

!ierr = NF_DEF_DIM (nout, "lat", size(lat), latdimout)
!ierr = NF_DEF_DIM (nout, "lon", size(lon), londimout)
ierr = NF_DEF_DIM (nout, "lat", ym, latdimout)
ierr = NF_DEF_DIM (nout, "lon", xm, londimout)
ierr = NF_DEF_DIM (nout, "lev", lm, altdimout)
ierr = NF_DEF_DIM (nout, "time", nj, timedimout)

ierr = NF_ENDDEF(nout)

 call def_var(nout,"lat","lat","","",1,(/latdimout/),nvarid,ierr)
#ifdef NC_DOUBLE
ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,y(1:ym))
#else
ierr = NF_PUT_VAR_REAL (nout,nvarid,y(1:ym))
#endif

 call def_var(nout,"lon","lon","","",1,(/londimout/),nvarid,ierr)
#ifdef NC_DOUBLE
ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,x(1:xm))
#else
ierr = NF_PUT_VAR_REAL (nout,nvarid,x(1:xm))
#endif

 call def_var(nout,"lev","lev","hPa","down",1,(/altdimout/),nvarid,ierr)
#ifdef NC_DOUBLE
ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,z(1:lm))
#else
ierr = NF_PUT_VAR_REAL (nout,nvarid,z(1:lm))
#endif

! Bomex
 call def_var(nout,"time","time","seconds since 1969-06-24 00:00:00","",1,(/timedimout/),nvarid,ierr)
!Cindy
!call def_var(nout,"time","time","seconds since 2010-10-01 00:00:00","",1,(/timedimout/),nvarid,ierr)
!AMMA
! call def_var(nout,"time","time","seconds since 2006-07-10 00:00:00",1,(/timedimout/),nvarid,ierr)
!IHOP
!  call def_var(nout,"time","time","seconds since 2002-06-14 00:00:00",1,(/timedimout/),nvarid,ierr)
!ierr = NF_PUT_VAR_INT (nout,timevarout,time(1:nj))
#ifdef NC_DOUBLE
!ierr = NF_PUT_VAR_DOUBLE (nout,timevarout,time(1:nj))
ierr = NF_PUT_VAR_DOUBLE (nout,nvarid,time(1:nj))
#else
!ierr = NF_PUT_VAR_REAL (nout,timevarout,time(1:nj))
ierr = NF_PUT_VAR_REAL (nout,nvarid,time(1:nj))
#endif


end subroutine initiate

!*************************************************************
subroutine def_var(nid,name,title,units,positive,nbdim,dim,nvarid,ierr)

implicit none

include "netcdf.inc"

character (len=*) :: title,units,name,positive
integer :: nid,nbdim,nvarid,ierr
integer, dimension(nbdim) :: dim

ierr=NF_REDEF(nid)
#ifdef NC_DOUBLE
ierr = NF_DEF_VAR (nid,adjustl(name),NF_DOUBLE,nbdim,dim,nvarid)
#else
ierr = NF_DEF_VAR (nid,adjustl(name),NF_FLOAT,nbdim,dim,nvarid)
#endif
if(ierr/=NF_NOERR) then
   write(*,*) NF_STRERROR(ierr)
   stop "in def_var"
endif
ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", len_trim(adjustl(title)),adjustl(title))
if(ierr/=NF_NOERR) then
   write(*,*) NF_STRERROR(ierr)
   stop "in def_var"
endif
ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", len_trim(adjustl(units)),adjustl(units))
if(ierr/=NF_NOERR) then
   write(*,*) NF_STRERROR(ierr)
   stop "in def_var"
endif
ierr = NF_PUT_ATT_TEXT (nid, nvarid, "positive", len_trim(adjustl(positive)),adjustl(positive))
if(ierr/=NF_NOERR) then
   write(*,*) NF_STRERROR(ierr)
   stop "in def_var"
endif
ierr = NF_ENDDEF(nid)

end subroutine def_var

!*************************************************************
subroutine catchaxis(nid,iim,jjm,llm,nj,xc,yc,zc,time,ierr)

!include "/home/distrib/local/netcdf-3.6.1/include/netcdf.inc"
include "netcdf.inc"
integer, intent(in) :: nid,iim,jjm,llm,nj
real*8, dimension(iim), intent(out) :: xc
real*8, dimension(jjm), intent(out) :: yc
real*8, dimension(llm), intent(out) :: zc
real*8, dimension(nj), intent(out) :: time
integer, intent(out) :: ierr

integer :: i
integer :: latvar,lonvar,altvar,timevar
integer :: latlen,lonlen,altlen,timelen
integer :: londimin,latdimin,altdimin,timedimin

! Control & lecture on dimensions
! ===============================
   ierr=NF_INQ_DIMID(nid,"yc",latdimin)
   ierr=NF_INQ_VARID(nid,"yc",latvar)
   if (ierr.NE.NF_NOERR) then
      write(*,*) 'ERROR: Field <lat> is missing'
      stop ""  
   endif
   ierr=NF_INQ_DIMLEN(nid,latdimin,latlen)

   ierr=NF_INQ_DIMID(nid,"xc",londimin)
   ierr=NF_INQ_VARID(nid,"xc",lonvar)
   if (ierr.NE.NF_NOERR) then
      write(*,*) 'ERROR: Field <lon> is lacking'
      stop "" 
   endif
  ierr=NF_INQ_DIMLEN(nid,londimin,lonlen)

   ierr=NF_INQ_DIMID(nid,"zc",altdimin)
   ierr=NF_INQ_VARID(nid,"zc",altvar)
   if (ierr.NE.NF_NOERR) then
      write(*,*) 'ERROR: Field <presnivs> is lacking'
      stop ""
   endif
   ierr=NF_INQ_DIMLEN(nid,altdimin,altlen)

!test:on rajoute la dimension temps
   ierr=NF_INQ_DIMID(nid,"time",timedimin)
   ierr=NF_INQ_VARID(nid,"time",timevar)
   if (ierr.NE.NF_NOERR) then
      write(*,*) 'ERROR: Field <time> is lacking'
      stop ""
   endif
   ierr=NF_INQ_DIMLEN(nid,timedimin,timelen)

   if((latlen/=jjm).or.(lonlen/=iim).or.(altlen/=llm)) then
      write(*,*) 'ERROR: Not the good lenght for axis'
      write(*,*) 'longitude: ',lonlen,iim+1
      write(*,*) 'latitude: ',latlen,jjm
      write(*,*) 'presniv: ',altlen,llm
!      stop ""  
   endif

#ifdef NC_DOUBLE
   ierr = NF_GET_VAR_DOUBLE(nid,latvar,yc)
   ierr = NF_GET_VAR_DOUBLE(nid,lonvar,xc)
   ierr = NF_GET_VAR_DOUBLE(nid,altvar,zc)
   ierr = NF_GET_VAR_DOUBLE(nid,timevar,time)
#else
   ierr = NF_GET_VAR_REAL(nid,latvar,yc)
   ierr = NF_GET_VAR_REAL(nid,lonvar,xc)
   ierr = NF_GET_VAR_REAL(nid,altvar,zc)
   ierr = NF_GET_VAR_REAL(nid,timevar,time)
#endif

end subroutine catchaxis


!*************************************************************

!*************************************************************
subroutine giveatt(nid,mean)

Implicit none

!include "/home/distrib/local/netcdf-3.6.1/include/netcdf.inc"
include "netcdf.inc"
integer nid,ierr
character (len=100):: att
logical,intent(in) :: mean

ierr = NF_REDEF (nid)
att="GDT 1.3"
ierr= NF_PUT_ATT_TEXT(nid,NF_GLOBAL,'conventions',len_trim(att),att)
if(ierr/=NF_NOERR) then
   write(*,*) NF_STRERROR(ierr)
   stop "in giveatt"
endif

if (mean) then
   att="Mars Climate Database v4.0 - Mean variables"
else
   att="Mars Climate Database v4.0 - Standard deviations"
endif

ierr= NF_PUT_ATT_TEXT(nid,NF_GLOBAL,'history',len_trim(att),att)
if(ierr/=NF_NOERR) then
   write(*,*) NF_STRERROR(ierr)
   stop "in giveatt"
endif

att="LMD-AOPP-ESA-CNES"
ierr= NF_PUT_ATT_TEXT(nid,NF_GLOBAL,'institution',len_trim(att),att)
if(ierr/=NF_NOERR) then
   write(*,*) NF_STRERROR(ierr)
   stop "in giveatt"
endif
ierr = NF_ENDDEF (nid)

end subroutine giveatt

!*************************************************************
subroutine missing_value(nout,nvarid,missing)
IMPLICIT NONE

! useful to watch results with ferret

!include "/home/distrib/local/netcdf-3.6.1/include/netcdf.inc"    
include "netcdf.inc"
                                                                                   
INTEGER :: nout,nvarid,ierr
REAL :: missing
ierr = NF_REDEF (nout)
#ifdef NC_DOUBLE
ierr= NF_PUT_ATT_DOUBLE(nout,nvarid,'missing_value',NF_DOUBLE,1,missing)
#else
ierr= NF_PUT_ATT_REAL(nout,nvarid,'missing_value',NF_FLOAT,1,missing)
#endif
iF (ierr.NE.NF_NOERR) THEN
     PRINT*, 'anl_NC: missing value attribution failed'
     WRITE(*,*) 'NF_NOERR', NF_NOERR
     CALL abort
ENDIF                                
ierr=NF_ENDDEF(nout)
return
                                                    
end subroutine missing_value

!****************************************************************
subroutine interp_vertical(nlev_init,nbt,nlev,presi,presf,var,varnew)

IMPLICIT NONE 
       INTEGER l, k, nlev,nlev_init,nbt
       INTEGER k1,k2,t

       REAL*8 frac,frac1,frac2
       REAL*8 fact

       REAL*8 presi(nlev_init), presf(nlev)
       REAL*8 var(nlev_init,nbt), varnew(nlev,nbt)
       
       do t=1,nbt

       do l=1,nlev

           if (presf(l).ge.presi(nlev_init)) then
 
           k1=0
           k2=0

           if (presf(l).le.presi(1)) then
           
              do k=1,nlev_init-1
                 if ((presf(l).gt.presi(k+1)).and.(presf(l).lt.presi(k))) then
                    k1=k
                    k2=k+1
                 endif
              enddo

              frac= (presf(l)-presi(k2))/(presi(k1)-presi(k2))
              varnew(l,t)=var(k2,t)-frac*(var(k2,t)-var(k1,t))       
          
           else !presf>presi(1)

               k1=1
               k2=2
               frac1 = (presf(l)-presi(k2))/(presi(k1)-presi(k2))
               frac2 = (presf(l)-presi(k1))/(presi(k1)-presi(k2))
               varnew(l,t)= frac1*var(k1,t) - frac2*var(k2,t)

           endif

           else

               fact=20.*(presi(nlev_init)-presf(l))/presi(nlev_init) 
               fact = max(fact,0.)                                           
               fact = exp(-fact)                                             
               varnew(l,t)= var(nlev_init,t)*fact             

           endif

       enddo

       enddo


                                                    
end subroutine interp_vertical  

!****************************************************************
subroutine interp_time(lm,nbt,nbstep,dt,time,time_out,var,varnew)

IMPLICIT NONE

     INTEGER lm,nbt,nbstep
     INTEGER l,k,it1,it2 

     REAL*8 dt, frac, time1, time2
     REAL*8 time(nbt),time_out(nbstep)
     REAL*8 var(lm,nbt),varnew(lm,nbstep)

     if (nbt.eq.1) then
        do k=1,lm
        varnew(k,1) = var(k,1)        
        enddo
        do l=2,nbstep
           do k=1,lm
              varnew(k,l) = 0.
           enddo
        enddo
     
      else     
      

!      do l=1,nbt
!      print*,'dans interp time=',time(l)
!      enddo
!      do l=1,nbstep
!      print*,'dans interp time_out=',time_out(l)
!      enddo  

      do l=1,nbstep

! Determine the closest times:
!          it1=INT(time_out(l)/dt)+1
          it1=INT((time_out(l)-time(1))/dt)+1
          it2=it1 + 1
          time1=time(it1)
          time2=time(it2)
!          time1=(it1)*dt
!          time2=(it2)*dt
!          time1=(it1-1)*dt
!          time2=(it2-1)*dt
!          print*,'time(nbt)',time2,time(nbt),time2-time(nbt)
!          if (it2.gt.nbt) then
!             print*,'ok'
!             time2=time(nbt)
!             it2=it1
!          endif

!       print*,'time_out=',l,time_out(l),time1,time2

! time interpolation:
       frac=(time2-time_out(l))/(time2-time1)
       frac=max(frac,0.0)

       do k=1,lm
        varnew(k,l) = var(k,it2)-frac*(var(k,it2)-var(k,it1))  
!        print*,'dans interp',k,l,it1,it2,time_out(l),time1,time2,var(k,it2),var(k,it1),frac,varnew(k,l)       
       enddo

     enddo
     
     endif
                                                    
end subroutine interp_time

!****************************************************************************

    end

