


module diag_barbi_module
   implicit none
   real*8, allocatable :: phi(:,:),bpt(:,:),wsc(:,:),ptv(:,:)
   real*8, allocatable :: rtr(:,:),psib(:,:),tdt(:,:),S1(:,:),S2(:,:)
   real*8, allocatable :: S3(:,:),S4(:,:),S1gm(:,:),S2gm(:,:),Sr(:,:)
   real*8, parameter :: rho0 = 1024
   real*8, parameter :: grav = 9.81
   real*8,parameter :: spval = -1.0d33
   real*8 :: N_0
   real*8, allocatable ::  b_r(:,:,:,:)
end module diag_barbi_module



subroutine init_diag_barbi
!=======================================================================
!      Initialize diagnostics
!=======================================================================
      use pyOM_module   
      use diag_barbi_module
      use fcontrol_module
      implicit none
      integer :: k
      namelist /diag_barbi/ N_0
      real*8 :: z,L_z

      if (my_pe==0) then
       print*,' Initializing barbi module '
      endif

      allocate(phi(nx,ny) ); phi=0.0
      allocate(psib(nx,ny) ); psib=0.0
      allocate(bpt(nx,ny) ); bpt=0.0
      allocate(wsc(nx,ny) ); wsc=0.0
      allocate(ptv(nx,ny) ); ptv=0.0
      allocate(rtr(nx,ny) ); rtr=0.0
      allocate(tdt(nx,ny) ); tdt=0.0
      allocate(S1(nx,ny) ); S1=0.0
      allocate(S2(nx,ny) ); S2=0.0
      allocate(S3(nx,ny) ); S3=0.0
      allocate(S4(nx,ny) ); S4=0.0
      allocate(S1gm(nx,ny) ); S1gm=0.0
      allocate(S2gm(nx,ny) ); S2gm=0.0
      allocate(Sr(nx,ny) ); Sr=0.0

      allocate(b_r(nx,ny,nz,3)); b_r=0.0

      if (enable_back_state) then
        b_r = 0.0
      else
       open(10,file='namelist',form='formatted',status='old')
       read(10, nml = diag_barbi )
       close(10)
       if (my_pe==0) write(6, nml=diag_barbi)
       L_z = zt(nz )-zt(1)
       do k=1,nz
         z = (zt(k)-zt(1))/L_z
         b_r(:,:,k,:) = -N_0**2*z 
       enddo
      endif

      call diag_barbi_init_cdf

      if (my_pe==0) print*,' Done initializing barbi module'
end subroutine init_diag_barbi


subroutine diag_barbi
   use pyOM_module   
   use diag_barbi_module
   use fcontrol_module
   use bolus_module
   implicit none
   integer :: i,j,k,js,je,n
   real*8 :: fxa,xvec(nx,ny),yvec(nx,ny)
   real*8 :: ubaro(nx,ny),vbaro(nx,ny)
   real*8 :: uu(nx,ny,nz),vv(nx,ny,nz)

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

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

      ! baroclinic streamfunction
      do j=js,je
       phi(:,j)=0.0
       if (enable_back_state) then

        do k=1,nz
         fxa =  sign(1d0,coriolis_t(j) )*max(1d-12,abs(coriolis_t(j)) ) 
         phi(:,j)=phi(:,j)+dz*b(:,j,k,tau)*zt(k)*maskT(:,j,k)/fxa 
        enddo
       else
        do k=1,nz
         fxa =  sign(1d0,coriolis_t(j) )*max(1d-12,abs(coriolis_t(j)) ) 
         phi(:,j)=phi(:,j)+dz*(b(:,j,k,tau)-b_r(:,j,k,tau))*zt(k)*maskT(:,j,k)/fxa 
        enddo
       endif
      enddo

      ! barotropic velocity
      do j=js,je
       ubaro(:,j)=0.0; vbaro(:,j)=0.0
       do k=1,nz
         ubaro(:,j)=ubaro(:,j)+dz*u(:,j,k,tau)*maskU(:,j,k) 
         vbaro(:,j)=vbaro(:,j)+dz*v(:,j,k,tau)*maskV(:,j,k) 
       enddo
       where( hu(:,j) /= 0.0) ubaro(:,j)=ubaro(:,j)/hu(:,j)
       where( hv(:,j) /= 0.0) vbaro(:,j)=vbaro(:,j)/hv(:,j)
      enddo
      call border_exchg2D(nx,ny,ubaro,1); call setcyclic2D(nx,ny,ubaro)
      call border_exchg2D(nx,ny,vbaro,1); call setcyclic2D(nx,ny,vbaro)

      ! advection of backgr. and pertub. density by barotropic flow
      do k=1,nz
         uu(:,:,k)=ubaro
         vv(:,:,k)=vbaro      
      enddo
      if (enable_back_state) then
       call diag_barbi_adv(uu,vv,back,S1,.false.)
       call diag_barbi_adv(uu,vv,b,S2,.false.)
      else
       call diag_barbi_adv(uu,vv,b_r,S1,.false.)
       call diag_barbi_adv(uu,vv,b-b_r,S2,.false.)
      endif

      ! advection of backgr. and pertub. density by baroclinic flow
      do k=1,nz
         uu(:,:,k)=u(:,:,k,tau)-ubaro
         vv(:,:,k)=v(:,:,k,tau)-vbaro      
      enddo
      if (enable_back_state) then
       call diag_barbi_adv(uu,vv,back,S3,.false.)
       call diag_barbi_adv(uu,vv,b,S4,.false.)
      else
       call diag_barbi_adv(uu,vv,b_r,S3,.false.)
       call diag_barbi_adv(uu,vv,b-b_r,S4,.false.)
      endif

      ! advection of backgr. and pertub. density by bolus velocity
      if (enable_bolus_velocity) then
       do k=1,nz
        uu(:,:,k)=ub(:,:,k)
        vv(:,:,k)=vb(:,:,k)      
       enddo
       if (enable_back_state) then
        call diag_barbi_adv(uu,vv,back,S1gm,.true.)
        call diag_barbi_adv(uu,vv,b,S2gm,.true.)
       else
        call diag_barbi_adv(uu,vv,b_r,S1gm,.true.)
        call diag_barbi_adv(uu,vv,b-b_r,S2gm,.true.)
       endif
      endif

      ! residual terms
      do j=js,je
       Sr(:,j)=0.0
       do k=1,nz
         Sr(:,j)=Sr(:,j)+dz*(b(:,j,k,taup1)-b(:,j,k,taum1))/c2dt*zt(k)*maskT(:,j,k) 
       enddo
       Sr(:,j) = Sr(:,j)-S1(:,j)-S2(:,j)-S3(:,j)-S4(:,j)-S1gm(:,j)-S2gm(:,j)
      enddo
      call setcyclic2D(nx,ny,Sr)

      ! barotropic streamfunction
      psib(:,js-1)=0.
      do j=js,je_pe
        psib(:,j)=psib(:,j-1)-ubaro(:,j)*dx*hu(:,j)
      enddo
      do n=1,n_pes
       call border_exchg2D(nx,ny,psib,1) 
       if (my_pe == n) then
        do j=js,je_pe
         psib(:,j)=psib(:,j)+psib(:,js-1)
        enddo
       endif
      enddo

      ! bottom pressure torque
      do j=js,je
       xvec(:,j)=0.0
       yvec(:,j)=0.0
       do k=1,nz
        do i=2,nx-1
         xvec(i,j)=xvec(i,j)-(p_full(i+1,j,k,tau)-p_full(i,j,k,tau) )/dx*dz*maskU(i,j,k)
         yvec(i,j)=yvec(i,j)-(p_full(i,j+1,k,tau)-p_full(i,j,k,tau) )/dx*dz*maskV(i,j,k)
        enddo
       enddo
      enddo
      call border_exchg2D(nx,ny,xvec,1); call setcyclic2D(nx,ny,xvec)
      call border_exchg2D(nx,ny,yvec,1); call setcyclic2D(nx,ny,yvec)
      call diag_barbi_curl(xvec,yvec,bpt)

      ! planetary vorticity
      do j=js,je
       xvec(:,j)=0.0
       yvec(:,j)=0.0
       do k=1,nz
        do i=2,nx-1
         xvec(i,j)=xvec(i,j)+dz*maskU(i,j,k)*coriolis_t(j)*(v(i,j  ,k,tau)+v(i+1,j  ,k,tau)+ &
                                                            v(i,j-1,k,tau)+v(i+1,j-1,k,tau))/4.0
         yvec(i,j)=yvec(i,j)-dz*maskV(i,j,k)*(coriolis_t(j  )*(u(i-1,j  ,k,tau)+u(i,j  ,k,tau))  &
                                             +coriolis_t(j+1)*(u(i-1,j+1,k,tau)+u(i,j+1,k,tau)))/4.0
        enddo
       enddo
      enddo
      call border_exchg2D(nx,ny,xvec,1); call setcyclic2D(nx,ny,xvec)
      call border_exchg2D(nx,ny,yvec,1); call setcyclic2D(nx,ny,yvec)
      call diag_barbi_curl(xvec,yvec,ptv)

      ! wind stress curl
      call diag_barbi_curl(surface_taux,surface_tauy,wsc)

      ! residual torques
      do j=js,je
       xvec(:,j)=0.0
       yvec(:,j)=0.0
       do k=1,nz
        do i=2,nx-1
         xvec(i,j)=xvec(i,j)+maskU(i,j,k)*fu(i,j,k)*dz
         yvec(i,j)=yvec(i,j)+maskV(i,j,k)*fv(i,j,k)*dz
        enddo
       enddo
      enddo
      call border_exchg2D(nx,ny,xvec,1); call setcyclic2D(nx,ny,xvec)
      call border_exchg2D(nx,ny,yvec,1); call setcyclic2D(nx,ny,yvec)
      call diag_barbi_curl(xvec,yvec,rtr)
      rtr = rtr - wsc  - ptv

      ! time tendendy torque
      do j=js,je
       xvec(:,j)=0.0
       yvec(:,j)=0.0
       do k=1,nz
        do i=2,nx-1
         xvec(i,j)=xvec(i,j)+maskU(i,j,k)*(u(i,j,k,taup1)-u(i,j,k,taum1))/c2dt*dz
         yvec(i,j)=yvec(i,j)+maskV(i,j,k)*(v(i,j,k,taup1)-v(i,j,k,taum1))/c2dt*dz
        enddo
       enddo
      enddo
      call border_exchg2D(nx,ny,xvec,1); call setcyclic2D(nx,ny,xvec)
      call border_exchg2D(nx,ny,yvec,1); call setcyclic2D(nx,ny,yvec)
      call diag_barbi_curl(xvec,yvec,tdt)


      call write_diag_barbi
  endif
end subroutine diag_barbi


subroutine diag_barbi_adv(uu,vv,bb,tend,leapfrog)
   use pyOM_module   
   use diag_barbi_module
   implicit none
   integer :: i,j,k,js,je,ierr
   logical :: leapfrog
   real*8 :: uu(nx,ny,nz),vv(nx,ny,nz),bb(nx,ny,nz,3),tend(nx,ny)
   real*8 :: adv_fe(nx,ny,nz), adv_ft(nx,ny,nz), adv_fn(nx,ny,nz)
   real*8 :: uback(nx,ny,nz),vback(nx,ny,nz),wback(nx,ny,nz)

      js=max(2,js_pe); je = min(je_pe,ny -1)
      do j=max(1,js_pe-1),min(ny,je_pe+1)
       uback(:,j,:)=u(:,j,:,tau); vback(:,j,:)=v(:,j,:,tau); wback(:,j,:)=w(:,j,:,tau);
       u(:,j,:,tau)=uu(:,j,:); v(:,j,:,tau)=vv(:,j,:)
      enddo
      call vertical_velocity(ierr)
      adv_fe(:,js_pe:je_pe,:)=0; adv_fn(:,js_pe:je_pe,:)=0; adv_ft(:,js_pe:je_pe,:)=0
      if (leapfrog) then
        call adv_flux_2th(nx,ny,nz,adv_fe,adv_fn,adv_ft,bb)
      else
        call adv_flux(nx,ny,nz,adv_fe,adv_fn,adv_ft,bb)
      endif
      do j=max(1,js_pe-1),min(ny,je_pe+1)
       u(:,j,:,tau)=uback(:,j,:)
       v(:,j,:,tau)=vback(:,j,:)
       w(:,j,:,tau)=wback(:,j,:)
      enddo
      call border_exchg3D(nx,ny,nz,adv_fn,1)
      call setcyclic3D(nx,ny,nz,adv_fe); 
      call setcyclic3D(nx,ny,nz,adv_fn)
      tend(:,js_pe:je_pe)=0.0
      do k=2,nz-1
       do j=js,je
        do i=2,nx-1
         tend(i,j)=tend(i,j)+dz*zt(k)*maskT(i,j,k)*(  &
        -(adv_fe(i,j,k)-adv_fe(i-1,j,k))/dx &
        -(adv_fn(i,j,k)-adv_fn(i,j-1,k))/dx &
        -(adv_ft(i,j,k)-adv_ft(i,j,k-1))/dz )
        enddo
       enddo
      enddo
      call setcyclic2D(nx,ny,tend)
end subroutine diag_barbi_adv


subroutine diag_barbi_curl(xvec,yvec,cvec)
      use pyOM_module   
      use diag_barbi_module
      implicit none
      integer :: i,j,k,js,je
      real*8 :: xvec(nx,ny),yvec(nx,ny),cvec(nx,ny)!,cc(nx,ny)
      js=max(2,js_pe); je = min(je_pe,ny -1)
      do j=js,je
        do i=2,nx-1
         cvec(i,j) = (yvec(i+1,j)-yvec(i,j))/dx-(xvec(i,j+1)-xvec(i,j))/dx
         cvec(i,j) = cvec(i,j) * min( maskU(i,j,nz-1) , maskV(i,j,nz-1) )
        enddo
      enddo
      !call border_exchg2D(nx,ny,cc,1); call setcyclic2D(nx,ny,cc)
      !do j=js,je
      !  do i=2,nx-1
      !   cvec(i,j)=0.25*(cc(i,j)+cc(i-1,j)+cc(i,j-1)+cc(i-1,j-1))
      !  enddo
      !enddo

      call setcyclic2D(nx,ny,cvec)
end subroutine diag_barbi_curl



subroutine diag_barbi_init_cdf
      use pyOM_module   
      use diag_barbi_module
      implicit none
      include "netcdf.inc"
      integer :: iret,ncid,vid,npe,timeid,ilen
      integer :: xtdim,xudim,ytdim,yudim,ztdim,zudim,tdim
      character :: name*64, unit*32
      real*8 :: beta(ny)

      call boundary_conditions

      if (my_pe==0) then 
       print*,' writing to file barbi.cdf'
       call def_grid_cdf('barbi.cdf')
       iret=nf_open('barbi.cdf',NF_WRITE,ncid)
       iret=nf_set_fill(ncid, NF_NOFILL, iret)
       call ncredf(ncid, iret)
       iret=nf_inq_dimid(ncid,'xt',xtdim)
       iret=nf_inq_dimid(ncid,'xu',xudim)
       iret=nf_inq_dimid(ncid,'yt',ytdim)
       iret=nf_inq_dimid(ncid,'yu',yudim)
       iret=nf_inq_dimid(ncid,'zt',ztdim)
       iret=nf_inq_dimid(ncid,'zu',zudim)
       iret=nf_inq_dimid(ncid,'Time',tdim)

       vid = ncvdef (ncid,'phi', NCFLOAT,3,(/xtdim,ytdim,tdim/),iret)
       name='Baroclinic streamfunction'; unit = 'm^3/s'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'S1', NCFLOAT,3,(/xtdim,ytdim,tdim/),iret)
       name='Barotr. adv. backgr. density'; unit = 'm^3/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'S2', NCFLOAT,3,(/xtdim,ytdim,tdim/),iret)
       name='Barotr. adv. pert. density'; unit = 'm^3/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'S3', NCFLOAT,3,(/xtdim,ytdim,tdim/),iret)
       name='Barocl. adv. backgr. density'; unit = 'm^3/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'S4', NCFLOAT,3,(/xtdim,ytdim,tdim/),iret)
       name='Barocl. adv. pert. density'; unit = 'm^3/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'S1gm', NCFLOAT,3,(/xtdim,ytdim,tdim/),iret)
       name='Bolus. adv. backgr. density'; unit = 'm^3/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'S2gm', NCFLOAT,3,(/xtdim,ytdim,tdim/),iret)
       name='Bolus. adv. pert. density'; unit = 'm^3/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'Sr', NCFLOAT,3,(/xtdim,ytdim,tdim/),iret)
       name='Residual forcing'; unit = 'm^3/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'psi', NCFLOAT,3,(/xudim,yudim,tdim/),iret)
       name='Barotropic streamfunction'; unit = 'm^3/s'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'bpt', NCFLOAT,3,(/xudim,yudim,tdim/),iret)
       name='Bottom pressure torque'; unit = 'm/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'wsc', NCFLOAT,3,(/xudim,yudim,tdim/),iret)
       name='Wind stress curl'; unit = 'm/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'ptv', NCFLOAT,3,(/xudim,yudim,tdim/),iret)
       name='Planetary vorticity'; unit = 'm/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'rtr', NCFLOAT,3,(/xudim,yudim,tdim/),iret)
       name='Residual torque'; unit = 'm/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'tdt', NCFLOAT,3,(/xudim,yudim,tdim/),iret)
       name='time tendency torque'; unit = 'm/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'h', NCFLOAT,2,(/xtdim,ytdim/),iret)
       name='water depth'; unit = 'm'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'taux', NCFLOAT,2,(/xudim,ytdim/),iret)
       name='zonal wind stress'; unit = 'm^2/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'tauy', NCFLOAT,2,(/xtdim,yudim/),iret)
       name='meridional wind stress'; unit = 'm^2/s^2'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'f', NCFLOAT,1,ytdim,iret)
       name='Coriolis frequency'; unit = '1/s'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'N', NCFLOAT,1,ytdim,iret)
       name='Stability frequency'; unit = '1/s'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       vid = ncvdef (ncid,'beta', NCFLOAT,1,ytdim,iret)
       name='beta              '; unit = '1/ms'
       call dvcdf(ncid,vid,name,64,unit,32,spval)

       call ncendf(ncid, iret)

       iret=nf_inq_varid(ncid,'f',vid)
       iret= nf_put_vara_double(ncid,vid,1,ny,coriolis_t)

       beta(:) = (coriolis_t(2)-coriolis_t(1))/dx
       iret=nf_inq_varid(ncid,'beta',vid)
       iret= nf_put_vara_double(ncid,vid,1,ny,beta)

       if (enable_back_state) then
        beta(:) = sqrt( -(back(nx/2,ny/2,nz-1,1)-back(nx/2,ny/2,nz-2,1))/dz )
       else
        beta(:) =  N_0 
       endif
       iret=nf_inq_varid(ncid,'N',vid)
       iret= nf_put_vara_double(ncid,vid,1,ny,beta)

       iret=nf_inq_varid(ncid,'h',vid)
       iret= nf_put_vara_double(ncid,vid,(/1,1/),(/nx,ny/),ht)

       iret=nf_inq_varid(ncid,'taux',vid)
       iret= nf_put_vara_double(ncid,vid,(/1,1/),(/nx,ny/),surface_taux)

       iret=nf_inq_varid(ncid,'tauy',vid)
       iret= nf_put_vara_double(ncid,vid,(/1,1/),(/nx,ny/),surface_tauy)

       call ncclos(ncid, iret)
      endif
end subroutine diag_barbi_init_cdf




subroutine write_diag_barbi
   use pyOM_module   
   use diag_barbi_module
   use fcontrol_module
   implicit none
   include "netcdf.inc"
   integer :: iret,ncid,vid,npe,timeid,ilen
   integer :: xtdim,xudim,ytdim,yudim,ztdim,zudim,tdim
   real*8 :: fxa,time

     do npe=0,n_pes
       if (my_pe==npe) then

         iret=nf_open('barbi.cdf',NF_WRITE,ncid)
         iret=nf_set_fill(ncid, NF_NOFILL, iret)

         iret=nf_inq_dimid(ncid,'Time',tdim)
         iret=nf_inq_dimlen(ncid,tdim,ilen)
         iret=nf_inq_varid(ncid,'Time',timeid)
         if (my_pe==0) then
          ilen=ilen+1
          time = itt*dt !current_time-initial_time
          fxa = time/86400. ! time%days + time%seconds/86400.
          iret= nf_put_vara_double(ncid,timeid,ilen,1,fxa)
         endif

         iret=nf_inq_varid(ncid,'phi',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),phi(:,js_pe:je_pe))

         iret=nf_inq_varid(ncid,'S1',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),S1(:,js_pe:je_pe))

         iret=nf_inq_varid(ncid,'S2',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),S2(:,js_pe:je_pe))

         iret=nf_inq_varid(ncid,'S3',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),S3(:,js_pe:je_pe))

         iret=nf_inq_varid(ncid,'S4',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),S4(:,js_pe:je_pe))

         iret=nf_inq_varid(ncid,'S1gm',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),S1gm(:,js_pe:je_pe))

         iret=nf_inq_varid(ncid,'S2gm',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),S2gm(:,js_pe:je_pe))

         iret=nf_inq_varid(ncid,'Sr',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),Sr(:,js_pe:je_pe))

         iret=nf_inq_varid(ncid,'psi',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),psib(:,js_pe:je_pe))

         iret=nf_inq_varid(ncid,'bpt',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),bpt(:,js_pe:je_pe))

         iret=nf_inq_varid(ncid,'wsc',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),wsc(:,js_pe:je_pe))

         iret=nf_inq_varid(ncid,'ptv',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),ptv(:,js_pe:je_pe))

         iret=nf_inq_varid(ncid,'rtr',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),rtr(:,js_pe:je_pe))

         iret=nf_inq_varid(ncid,'tdt',vid)
         iret= nf_put_vara_double(ncid,vid,(/1,js_pe,ilen/),(/nx,je_pe-js_pe+1,1/),tdt(:,js_pe:je_pe))

         call ncclos (ncid, iret)
       endif
       call fortran_barrier
      enddo
end subroutine write_diag_barbi
