

subroutine diagnose
 !=======================================================================
 ! Diagnostic routines
 !=======================================================================
 use pyOM_module   
 use fcontrol_module
 implicit none
 if ( mod(itt,int(snapint/dt))  == 0)  then
  if (my_pe==0) print'(a,i10.10,a,e8.2,a,i5,i5,a)', &
               ' diagnosing at itt=',itt,', ',itt*dt,'s, SOR itts = (',sor2D_itts,sor3D_itts,')'
  call diag_snap
 endif
end subroutine diagnose


subroutine init_snap_cdf
 !-----------------------------------------------------------------------
 !     initialize NetCDF snapshot file
 !-----------------------------------------------------------------------
 use pyOM_module   
 use fcontrol_module   
 implicit none
 include "netcdf.inc"
 integer :: ncid,iret
 integer :: lon_tdim,lon_udim,z_tdim,z_udim,itimedim
 integer :: lat_tdim,lat_udim,id
 integer :: dims(4)
 character :: name*24, unit*16
 real*8, parameter :: spval = -1.0d33

      call def_grid_cdf(snap_file)
      iret=nf_open(snap_file,NF_WRITE,ncid)
      iret=nf_set_fill(ncid, NF_NOFILL, iret)
      call ncredf(ncid, iret)
      iret=nf_inq_dimid(ncid,'xt',lon_tdim)
      iret=nf_inq_dimid(ncid,'xu',lon_udim)
      iret=nf_inq_dimid(ncid,'yt',lat_tdim)
      iret=nf_inq_dimid(ncid,'yu',lat_udim)
      iret=nf_inq_dimid(ncid,'zt',z_tdim)
      iret=nf_inq_dimid(ncid,'zu',z_udim)
      iret=nf_inq_dimid(ncid,'Time',itimedim)

!     2 dim variables on t grid
      dims = (/Lon_udim,lat_tdim, z_tdim, iTimedim/)
      id  = ncvdef (ncid,'u', NCFLOAT,4,dims,iret)
      name = 'Zonal velocity         '; unit = 'm/s'
      call dvcdf(ncid,id,name,24,unit,16,spval)

      dims = (/Lon_tdim,lat_udim, z_tdim, iTimedim/)
      id  = ncvdef (ncid,'v', NCFLOAT,4,dims,iret)
      name = 'Meridional velocity  '; unit = 'm/s'
      call dvcdf(ncid,id,name,24,unit,16,spval)

      dims = (/Lon_tdim,lat_tdim, z_udim, iTimedim/)
      id  = ncvdef (ncid,'w', NCFLOAT,4,dims,iret)
      name = 'Vertical velocity  '; unit = 'm/s'
      call dvcdf(ncid,id,name,24,unit,16,spval)

      dims = (/Lon_tdim,lat_tdim, z_tdim, iTimedim/)
      id  = ncvdef (ncid,'b', NCFLOAT,4,dims,iret)
      name = 'Buoyancy      '; unit = 'm/s^2'
      call dvcdf(ncid,id,name,24,unit,16,spval)

      id  = ncvdef (ncid,'p', NCFLOAT,4,dims,iret)
      name = 'Pressure      '; unit = 'm^2/s^2'
      call dvcdf(ncid,id,name,24,unit,16,spval)

      dims = (/Lon_tdim,lat_tdim, iTimedim,1/)
      id = ncvdef (ncid,'ps', NCFLOAT,3,dims,iret)
      if (enable_free_surface.or.enable_expl_free_surf) then
       name = 'Surface height'; unit = 'm'
      else
       name = 'Surface pressure'; unit = 'm^2/s^2'
      endif
      call dvcdf(ncid,id,name,24,unit,16,spval)

      dims = (/Lon_tdim,lat_tdim, z_udim, iTimedim/)
      if (enable_hydrostatic) then
       id  = ncvdef (ncid,'K_b', NCFLOAT,4,dims,iret)
       name = 'Vertical diffusivity'; unit = 'm^2/s'
       call dvcdf(ncid,id,name,24,unit,16,spval)
      else
       id  = ncvdef (ncid,'psi', NCFLOAT,4,dims,iret)
       name = 'Non-hydrostatic pressure'; unit = 'm^2/s^2'
       call dvcdf(ncid,id,name,24,unit,16,spval)
      endif

      dims = (/Lon_tdim,lat_tdim, iTimedim,1/)
      id = ncvdef (ncid,'surf_flux', NCFLOAT,3,dims,iret)
      name = 'Surface buoyancy flux'; unit = 'm^2/s^3'
      call dvcdf(ncid,id,name,24,unit,16,spval)

      dims = (/Lon_tdim,lat_tdim, iTimedim,1/)
      id = ncvdef (ncid,'taux', NCFLOAT,3,dims,iret)
      name = 'Zonal wind stress'; unit = 'm^2/s^2'
      call dvcdf(ncid,id,name,24,unit,16,spval)

      dims = (/Lon_tdim,lat_tdim, iTimedim,1/)
      id = ncvdef (ncid,'tauy', NCFLOAT,3,dims,iret)
      name = 'Meridional wind stress'; unit = 'm^2/s^2'
      call dvcdf(ncid,id,name,24,unit,16,spval)


if (enable_back_state) then
      dims = (/Lon_tdim,lat_tdim, z_tdim, 0/)
      id  = ncvdef (ncid,'back', NCFLOAT,3,dims,iret)
      name = 'Background buoyancy '; unit = 'm/s^2'
      call dvcdf(ncid,id,name,24,unit,16,spval)
endif
if (enable_back_state.and. enable_back_zonal_flow) then
      dims = (/Lon_udim,lat_tdim, z_tdim, 0/)
      id  = ncvdef (ncid,'u0', NCFLOAT,3,dims,iret)
      name = 'Background zonal velocity'; unit = 'm/s'
      call dvcdf(ncid,id,name,24,unit,16,spval)
endif
if (enable_back_state.and. enable_back_meridional_flow) then
      dims = (/Lon_tdim,lat_udim, z_tdim, 0/)
      id  = ncvdef (ncid,'v0', NCFLOAT,3,dims,iret)
      name = 'Background meridional velocity'; unit = 'm/s'
      call dvcdf(ncid,id,name,24,unit,16,spval)
endif


      call ncclos (ncid, iret)

if (enable_back_state) then
      iret=nf_open(snap_file,NF_WRITE,ncid)
      iret=nf_inq_varid(ncid,'back',id)
      iret= nf_put_vara_double(ncid,id,(/1,1,1/),(/nx,ny,nz/),back(:,:,:,1))
      call ncclos (ncid, iret)
endif

if (enable_back_state.and. enable_back_zonal_flow) then
      iret=nf_open(snap_file,NF_WRITE,ncid)
      iret=nf_inq_varid(ncid,'u0',id)
      iret= nf_put_vara_double(ncid,id,(/1,1,1/),(/nx,ny,nz/),u0(:,:,:))
      call ncclos (ncid, iret)
endif

if (enable_back_state.and. enable_back_meridional_flow) then
      iret=nf_open(snap_file,NF_WRITE,ncid)
      iret=nf_inq_varid(ncid,'v0',id)
      iret= nf_put_vara_double(ncid,id,(/1,1,1/),(/nx,ny,nz/),u0(:,:,:))
      call ncclos (ncid, iret)
endif
end subroutine init_snap_cdf


subroutine diag_snap
 !-----------------------------------------------------------------------
 !     write to NetCDF snapshot file
 !-----------------------------------------------------------------------
 use pyOM_module   
 use fcontrol_module
 implicit none
 include "netcdf.inc"
 integer :: ncid,iret,corner(4), edges(4)
 real*8 :: a(nx,ny,nz)
 integer :: itdimid,ilen,pid,rid,uid,wid,itimeid
 integer :: js,je,vid,sflid,kbid,id
 real*8 :: fxa,time
 real*8, parameter :: spval = -1.0d33

      js=max(2,js_pe); je = min(je_pe,ny-1)

      call pe0_recv_3D(nx,ny,nz,u(:,:,:,tau) )
      call pe0_recv_3D(nx,ny,nz,v(:,:,:,tau) )
      call pe0_recv_3D(nx,ny,nz,w(:,:,:,tau) )
      call pe0_recv_3D(nx,ny,nz,b(:,:,:,tau) )
      call pe0_recv_3D(nx,ny,nz,p_full(:,:,:,tau) )
      if (enable_hydrostatic) then
        call pe0_recv_3D(nx,ny,nz,K_b)
      else 
        call pe0_recv_3D(nx,ny,nz,psi)
      endif
      if (enable_free_surface.or.enable_expl_free_surf) then
        call pe0_recv_2D(nx,ny,eta(:,:,tau) )
      else 
        call pe0_recv_2D(nx,ny,p_surf )
      endif
      call pe0_recv_2D(nx,ny,surface_flux)
      call pe0_recv_2D(nx,ny,surface_taux)
      call pe0_recv_2D(nx,ny,surface_tauy)

      if (my_pe==0) then
        iret=nf_open(snap_file,NF_WRITE,ncid)
        iret=nf_set_fill(ncid, NF_NOFILL, iret)

        iret=nf_inq_varid(ncid,'b',rid)
        iret=nf_inq_varid(ncid,'p',pid)
        iret=nf_inq_varid(ncid,'u',uid)
        iret=nf_inq_varid(ncid,'v',vid)
        iret=nf_inq_varid(ncid,'w',wid)
        iret=nf_inq_varid(ncid,'ps',sflid)
        if (enable_hydrostatic) then
         iret=nf_inq_varid(ncid,'K_b',kbid)
        else
         iret=nf_inq_varid(ncid,'psi',kbid)
        endif
        iret=nf_inq_dimid(ncid,'Time',itdimid)
        iret=nf_inq_dimlen(ncid, itdimid,ilen)
        iret=nf_inq_varid(ncid,'Time',itimeid)
        ilen=ilen+1
        time = itt*dt
        fxa = time/86400.0
!        print*,' writing snapshot at ',time,' s, time steps in file : ',ilen
        iret= nf_put_vara_double(ncid,itimeid,ilen,1,fxa)

        Corner = (/1,1,1,ilen/); !edges  = (/nx ,j_blk,nz,1/)
        edges  = (/nx,ny,nz,1/)

        a=b(:,:,:,tau)
        where( maskT == 0.) a = spval
        iret= nf_put_vara_double(ncid,rid,corner,edges,a)

        a=p_full(:,:,:,tau)
        where( maskT == 0.) a = spval
        iret= nf_put_vara_double(ncid,pid,corner,edges,a)

        a=u(:,:,:,tau)
        where( maskU == 0.) a = spval
        iret= nf_put_vara_double(ncid,uid,corner,edges,a)

        a=v(:,:,:,tau)
        where( maskV == 0.) a = spval
        iret= nf_put_vara_double(ncid,vid,corner,edges,a)

        a=w(:,:,:,tau)
        where( maskW == 0.) a = spval
        iret= nf_put_vara_double(ncid,wid,corner,edges,a)

        if (enable_hydrostatic) then
         a=K_b(:,:,:)+K_v
         where( maskW == 0.) a = spval
        else
         a=psi(:,:,:)
         where( maskT == 0.) a = spval
        endif
        iret= nf_put_vara_double(ncid,kbid,corner,edges,a)

        Corner = (/1,1,ilen,1/); edges  = (/nx,ny,1,1/)
        if (enable_free_surface.or.enable_expl_free_surf) then
         a(:,:,nz-1)=eta(:,:,tau)
        else
         a(:,:,nz-1)=p_surf
        endif
        where( maskT== 0.) a = spval
        iret= nf_put_vara_double(ncid,sflid,corner,edges,a(:,:,nz-1))

        Corner = (/1,1,ilen,1/); edges  = (/nx ,ny,1,1/)
        iret=nf_inq_varid(ncid,'surf_flux',id)
        a(:,:,nz-1)=surface_flux(:,:)
        where( maskT == 0.) a = spval
        iret= nf_put_vara_double(ncid,id,corner,edges,a(:,:,nz-1))

        iret=nf_inq_varid(ncid,'taux',id)
        a(:,:,nz-1)=surface_taux
        where( maskU == 0.) a = spval
        iret= nf_put_vara_double(ncid,id,corner,edges,a(:,:,nz-1))

        iret=nf_inq_varid(ncid,'tauy',id)
        a(:,:,nz-1)=surface_tauy
        where( maskV == 0.) a = spval
        iret= nf_put_vara_double(ncid,id,corner,edges,a(:,:,nz-1))
        call ncclos (ncid, iret)
       endif
end subroutine diag_snap


subroutine init_tracer_diag
 !-----------------------------------------------------------------------
 !     initialize NetCDF snapshot file
 !-----------------------------------------------------------------------
 use pyOM_module   
 implicit none
      include "netcdf.inc"
      integer :: ncid,iret,n
      integer :: lon_tdim,z_tdim,itimedim
      integer :: lat_tdim,tr_id(nt)
      integer :: dims(4)
      character :: name*24, unit*16
      real*8,parameter :: spval = -1.0d33

      call def_grid_cdf('tracer.cdf')
      iret=nf_open('tracer.cdf',NF_WRITE,ncid)
      iret=nf_set_fill(ncid, NF_NOFILL, iret)
      call ncredf(ncid, iret)
      iret=nf_inq_dimid(ncid,'xt',lon_tdim)
      iret=nf_inq_dimid(ncid,'yt',lat_tdim)
      iret=nf_inq_dimid(ncid,'zt',z_tdim)
      iret=nf_inq_dimid(ncid,'Time',itimedim)
      dims = (/Lon_tdim,lat_tdim, z_tdim, iTimedim/)
      do n=1,nt
       write(name, '("tr",i2)') n
       call replace_space_zero(name)
       tr_id(n) = ncvdef (ncid,name, NCFLOAT,4,dims,iret)
       name = 'passive tracer'; unit = ' '
       call dvcdf(ncid,tr_id(n),name,24,unit,16,spval)
      enddo
      call ncclos (ncid, iret)
end subroutine init_tracer_diag


subroutine diag_tracer
 !-----------------------------------------------------------------------
 !     write to NetCDF snapshot file
 !-----------------------------------------------------------------------
 use pyOM_module   
 use fcontrol_module
 implicit none
      include "netcdf.inc"
      integer :: ncid,iret,n,npe, corner(4), edges(4)
      real*8 :: a(nx,js_pe:je_pe,nz),fxa,time
      integer :: itdimid,ilen,itimeid
      integer :: tr_id(nt)
      integer :: js,je
      character :: name*24
      real*8,parameter :: spval = -1.0d33

   if ( mod(itt,int(snapint/dt))  == 0)  then

      js=max(2,js_pe); je = min(je_pe,ny -1)
      do npe=0,n_pes
       if (my_pe==npe) then
        iret=nf_open('tracer.cdf',NF_WRITE,ncid)
        iret=nf_set_fill(ncid, NF_NOFILL, iret)
        do n=1,nt
         write(name, '("tr",i2)') n
         call replace_space_zero(name)
         iret=nf_inq_varid(ncid,name,tr_id(n))
        enddo
        iret=nf_inq_dimid(ncid,'Time',itdimid)
        iret=nf_inq_dimlen(ncid, itdimid,ilen)
        iret=nf_inq_varid(ncid,'Time',itimeid)
        if (my_pe==0) then
         ilen=ilen+1
         time = itt*dt ! current_time-initial_time
         fxa = time/86400.0 ! time%days + time%seconds/86400.
         iret= nf_put_vara_double(ncid,itimeid,ilen,1,fxa)
        endif
        Corner = (/1,js_pe,1,ilen/); 
        edges  = (/nx,je_pe-js_pe+1,nz,1/)
        do n=1,nt
         a=tr(:,js_pe:je_pe,:,tau,n)
         where( maskT(:,js_pe:je_pe,:) == 0.) a = spval
         iret= nf_put_vara_double(ncid,tr_id(n),corner,edges,a)
        enddo
        call ncclos (ncid, iret)
       endif
       call fortran_barrier
      enddo
   endif
end subroutine diag_tracer



subroutine def_grid_cdf(filename)
 !-----------------------------------------------------------------------
 !      Define standard grid in netcdf file
 !-----------------------------------------------------------------------
 use pyOM_module   
 implicit none
 include "netcdf.inc"
      character*(*) filename
      integer :: ncid,iret
      integer :: lon_tdim,lon_udim,z_tdim,z_udim,itimedim
      integer :: lon_tid,lon_uid,z_tid,z_uid,itimeid
      integer :: lat_tdim,lat_udim,lat_uid,lat_tid
      character :: name*24, unit*16

      ncid = nccre (filename, NCCLOB, iret)
      iret=nf_set_fill(ncid, NF_NOFILL, iret)
!     dimensions
      lon_tdim  = ncddef(ncid, 'xt', nx , iret)
      Lon_udim  = ncddef(ncid, 'xu', nx , iret)
      lat_tdim  = ncddef(ncid, 'yt', ny , iret)
      Lat_udim  = ncddef(ncid, 'yu', ny , iret)
      z_tdim    = ncddef(ncid, 'zt',  nz, iret)
      z_udim    = ncddef(ncid, 'zu',  nz, iret)
      iTimedim  = ncddef(ncid, 'Time', nf_unlimited, iret)
!     grid variables
      Lon_tid  = ncvdef (ncid,'xt',NCFLOAT,1,lon_tdim,iret)
      Lon_uid  = ncvdef (ncid,'xu',NCFLOAT,1,lon_udim,iret)
      Lat_tid  = ncvdef (ncid,'yt',NCFLOAT,1,lat_tdim,iret)
      Lat_uid  = ncvdef (ncid,'yu',NCFLOAT,1,lat_udim,iret)
      z_tid  = ncvdef (ncid,'zt', NCFLOAT,1,z_tdim,iret)
      z_uid  = ncvdef (ncid,'zu', NCFLOAT,1,z_udim,iret)
      itimeid  = ncvdef (ncid,'Time', NCFLOAT,1,itimedim,iret)
!     attributes of the grid
      name = 'Longitude on T grid     '; unit = 'm'
      call ncaptc(ncid, Lon_tid, 'long_name', NCCHAR, 24, name, iret) 
      call ncaptc(ncid, Lon_tid, 'units',     NCCHAR, 16, unit, iret) 
      name = 'Longitude on U grid     '; unit = 'm'
      call ncaptc(ncid, Lon_uid, 'long_name', NCCHAR, 24, name, iret) 
      call ncaptc(ncid, Lon_uid, 'units',     NCCHAR, 16, unit, iret) 
      name = 'Latitude on T grid     '; unit = 'm'
      call ncaptc(ncid, Lat_tid, 'long_name', NCCHAR, 24, name, iret) 
      call ncaptc(ncid, Lat_tid, 'units',     NCCHAR, 16, unit, iret) 
      name = 'Latitude on U grid     '; unit = 'm'
      call ncaptc(ncid, Lat_uid, 'long_name', NCCHAR, 24, name, iret) 
      call ncaptc(ncid, Lat_uid, 'units',     NCCHAR, 16, unit, iret) 
!      name = 'Depth on T grid      '; unit = 'm'
      name = 'Height on T grid      '; unit = 'm'
      call ncaptc(ncid, z_tid, 'long_name', NCCHAR, 24, name, iret) 
      call ncaptc(ncid, z_tid, 'units',     NCCHAR, 16, unit, iret) 
!      name = 'Depth on U grid      '; unit = 'm'
      name = 'Height on U grid      '; unit = 'm'
      call ncaptc(ncid, z_uid, 'long_name', NCCHAR, 24, name, iret) 
      call ncaptc(ncid, z_uid, 'units',     NCCHAR, 16, unit, iret) 
      name = 'Time '; unit = 'days'
      call ncaptc(ncid, itimeid, 'long_name', NCCHAR, 24, name, iret) 
      call ncaptc(ncid, itimeid, 'units',     NCCHAR, 16, unit, iret) 
      call ncaptc(ncid, iTimeid,'time_origin',NCCHAR, 20,'01-JAN-1900 00:00:00', iret)

      call ncendf(ncid, iret)
      iret= nf_put_vara_double(ncid,lon_Tid,1,nx ,xt)
      iret= nf_put_vara_double(ncid,lon_uid,1,nx ,xu)
      iret= nf_put_vara_double(ncid,lat_Tid,1,ny ,yt)
      iret= nf_put_vara_double(ncid,lat_uid,1,ny ,yu)
      iret= nf_put_vara_double(ncid,z_tid,1,nz,zt)
      iret= nf_put_vara_double(ncid,z_uid,1,nz,zw)
      call ncclos (ncid, iret)
end subroutine def_grid_cdf




subroutine dvcdf(ncid,ivarid,name,iname,unit,iunit,spval)
 !-----------------------------------------------------------------------
 !     define some standard attributes of variable ivarid in NetCDF file ncid 
 !-----------------------------------------------------------------------
 implicit none
 integer ncid,ivarid,iname,iunit,iret
 character (len=*) :: name, unit
 real*8 :: spval, vv
 include "netcdf.inc"
 vv=spval
 call ncaptc(ncid,ivarid, 'long_name', NCCHAR,iname , name, iret) 
 if (iret.ne.0) print*,nf_strerror(iret)
 call ncaptc(ncid,ivarid, 'units',     NCCHAR,iunit, unit, iret) 
 if (iret.ne.0) print*,nf_strerror(iret)
 call ncapt (ncid,ivarid, 'missing_value',NCDOUBLE,1,vv,iret)
 if (iret.ne.0) print*,nf_strerror(iret)
 call ncapt (ncid,ivarid, '_FillValue', NCDOUBLE, 1,vv, iret)
 if (iret.ne.0) print*,nf_strerror(iret)
end subroutine dvcdf



