subroutine wstats(ngrid,nom,titre,unite,dim,px)

implicit none

#include "dimensions.h"
#include "dimphys.h"
#include "statto.h"
#include "netcdf.inc"

integer,intent(in) :: ngrid
character (len=*) :: nom,titre,unite
integer,intent(in) :: dim
integer,parameter :: iip1=iim+1
integer,parameter :: jjp1=jjm+1
real, dimension(ngrid,llm) :: px
real, dimension(iip1,jjp1,llm) :: mean3d,sd3d,dx3
real, dimension(iip1,jjp1) :: mean2d,sd2d,dx2
character (len=50) :: namebis
character (len=50), save :: firstvar
integer :: ierr,varid,nbdim,nid
integer :: meanid,sdid
integer, dimension(4)  :: id,start,size
logical, save :: firstcall=.TRUE.
integer :: l,i,j,ig0
integer,save :: index

integer, save :: step=0


if (firstcall) then
   firstcall=.false.
   firstvar=trim((nom))
   call inistats(ierr)
endif

if (firstvar==nom) then ! If we're back to the first variable
      step = step + 1
endif

if (mod(step,istats).ne.0) then
   RETURN
endif

ierr = NF_OPEN("stats.nc",NF_WRITE,nid)

namebis=trim(nom)
ierr= NF_INQ_VARID(nid,namebis,meanid)

if (ierr.ne.NF_NOERR) then

   if (firstvar==nom) then 
      index=1
      count=0
   endif


!declaration de la variable

! choix du nom des coordonnees
   ierr= NF_INQ_DIMID(nid,"longitude",id(1))
   ierr= NF_INQ_DIMID(nid,"latitude",id(2))
   if (dim.eq.3) then
      ierr= NF_INQ_DIMID(nid,"altitude",id(3))
      ierr= NF_INQ_DIMID(nid,"Time",id(4))
      nbdim=4
   else if (dim==2) then
      ierr= NF_INQ_DIMID(nid,"Time",id(3))
      nbdim=3
   endif

   write (*,*) "====================="
   write (*,*) "STATS: creation de ",nom
   namebis=trim(nom)
   call def_var(nid,namebis,titre,unite,nbdim,id,meanid,ierr)
   call inivar(nid,meanid,ngrid,dim,index,px,ierr)
   namebis=trim(nom)//"_sd"
   call def_var(nid,namebis,trim(titre)//" total standard deviation over the season",unite,nbdim,id,sdid,ierr)
   call inivar(nid,sdid,ngrid,dim,index,px,ierr)

   ierr= NF_CLOSE(nid)
   return

else
   namebis=trim(nom)//"_sd"
   ierr= NF_INQ_VARID(nid,namebis,sdid)

endif

if (firstvar==nom) then 
   count(index)=count(int(index))+1
   index=index+1
   if (index>istime) then
      index=1
   endif
endif

if (count(index)==0) then
   if (dim.eq.3) then
      start=(/1,1,1,index/)
      size=(/iip1,jjp1,llm,1/)
      mean3d=0
      sd3d=0
   else if (dim.eq.2) then
      start=(/1,1,index,0/)
      size=(/iip1,jjp1,1,0/)
      mean2d=0
      sd2d=0
   endif
else
   if (dim.eq.3) then
      start=(/1,1,1,index/)
      size=(/iip1,jjp1,llm,1/)
#ifdef NC_DOUBLE
      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean3d)
      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd3d)
#else
      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean3d)
      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd3d)
#endif
      if (ierr.ne.NF_NOERR) then
         write (*,*) NF_STRERROR(ierr)
         stop ""
      endif

   else if (dim.eq.2) then
      start=(/1,1,index,0/)
      size=(/iip1,jjp1,1,0/)
#ifdef NC_DOUBLE
      ierr = NF_GET_VARA_DOUBLE(nid,meanid,start,size,mean2d)
      ierr = NF_GET_VARA_DOUBLE(nid,sdid,start,size,sd2d)
#else
      ierr = NF_GET_VARA_REAL(nid,meanid,start,size,mean2d)
      ierr = NF_GET_VARA_REAL(nid,sdid,start,size,sd2d)
#endif
      if (ierr.ne.NF_NOERR) then
         write (*,*) NF_STRERROR(ierr)
         stop ""
      endif
   endif
endif

if (dim.eq.3) then

!  Passage variable physique -->  variable dynamique

   DO l=1,llm
      DO i=1,iip1
         dx3(i,1,l)=px(1,l)
         dx3(i,jjp1,l)=px(ngrid,l)
      ENDDO
      DO j=2,jjm
         ig0= 1+(j-2)*iim
         DO i=1,iim
            dx3(i,j,l)=px(ig0+i,l)
         ENDDO
         dx3(iip1,j,l)=dx3(1,j,l)
      ENDDO
   ENDDO

   mean3d= mean3d+dx3
   sd3d= sd3d+dx3**2

#ifdef NC_DOUBLE
   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean3d)
   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd3d)
#else
   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean3d)
   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd3d)
#endif

else if (dim.eq.2) then

!    Passage variable physique -->  physique dynamique

  DO i=1,iip1
     dx2(i,1)=px(1,1)
     dx2(i,jjp1)=px(ngrid,1)
  ENDDO
  DO j=2,jjm
     ig0= 1+(j-2)*iim
     DO i=1,iim
        dx2(i,j)=px(ig0+i,1)
     ENDDO
     dx2(iip1,j)=dx2(1,j)
  ENDDO

   mean2d= mean2d+dx2
   sd2d= sd2d+dx2**2

#ifdef NC_DOUBLE
   ierr = NF_PUT_VARA_DOUBLE(nid,meanid,start,size,mean2d)
   ierr = NF_PUT_VARA_DOUBLE(nid,sdid,start,size,sd2d)
#else
   ierr = NF_PUT_VARA_REAL(nid,meanid,start,size,mean2d)
   ierr = NF_PUT_VARA_REAL(nid,sdid,start,size,sd2d)
#endif

endif

ierr= NF_CLOSE(nid)

end

!======================================================
subroutine inivar(nid,varid,ngrid,dim,index,px,ierr)

implicit none

include "dimensions.h"
include "dimphys.h"
include "netcdf.inc"

integer, intent(in) :: nid,varid,dim,index,ngrid
real, dimension(ngrid,llm), intent(in) :: px
integer, intent(out) :: ierr

integer,parameter :: iip1=iim+1
integer,parameter :: jjp1=jjm+1

integer :: l,i,j,ig0
integer, dimension(4) :: start,size
real, dimension(iip1,jjp1,llm) :: dx3
real, dimension(iip1,jjp1) :: dx2

if (dim.eq.3) then

   start=(/1,1,1,index/)
   size=(/iip1,jjp1,llm,1/)

!  Passage variable physique -->  variable dynamique

   DO l=1,llm
      DO i=1,iip1
         dx3(i,1,l)=px(1,l)
         dx3(i,jjp1,l)=px(ngrid,l)
      ENDDO
      DO j=2,jjm
         ig0= 1+(j-2)*iim
         DO i=1,iim
            dx3(i,j,l)=px(ig0+i,l)
         ENDDO
         dx3(iip1,j,l)=dx3(1,j,l)
      ENDDO
   ENDDO

#ifdef NC_DOUBLE
   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx3)
#else
   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx3)
#endif

else if (dim.eq.2) then

      start=(/1,1,index,0/)
      size=(/iip1,jjp1,1,0/)

!    Passage variable physique -->  physique dynamique

  DO i=1,iip1
     dx2(i,1)=px(1,1)
     dx2(i,jjp1)=px(ngrid,1)
  ENDDO
  DO j=2,jjm
     ig0= 1+(j-2)*iim
     DO i=1,iim
        dx2(i,j)=px(ig0+i,1)
     ENDDO
     dx2(iip1,j)=dx2(1,j)
  ENDDO

#ifdef NC_DOUBLE
   ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,size,dx2)
#else
   ierr = NF_PUT_VARA_REAL(nid,varid,start,size,dx2)
#endif

endif

end
