

!=======================================================================
!       Integrate particles
!       linked in the code in driver.f90 only
!=======================================================================


 module particle_module
      implicit none
      integer :: nptraj 
      real*8, allocatable  :: pxyz(:,:),puvw(:,:),ptr(:,:)
      integer, allocatable :: pijk(:,:)
      real*8, allocatable  :: mu(:),muu(:)
      real*8, allocatable  :: mv(:),mvv(:)
      real*8, allocatable  :: mw(:),mww(:)
      integer :: counter
 
      logical, allocatable :: particle_active(:)
      integer, allocatable :: particle_pe(:)
      integer :: mmax
      real*8, allocatable  :: ulen(:,:),vlen(:,:),wlen(:,:)
      logical ::  particle_buoyancy = .false.
      logical ::  particle_averages = .false.
 end module particle_module


subroutine init_particle
!=======================================================================
!      initialize the particles
!=======================================================================
      use pyOM_module   
      use particle_module
      implicit none 
      integer :: i,j,k,indp,n
      logical :: file_exists = .false.
    
      if (my_pe==0) then
       print*,''
       print*,' Initializing particle module '
       print*,''
       if (n_pes>1) print*,'WARNNING: floats do not work with PE>1'
       print*,''
      endif

      mmax = 20
      if (my_pe==0)  print*,' Euler forward time step for particles ',dt/mmax,' s'

!-----------------------------------------------------------------------
!    read restart file
!-----------------------------------------------------------------------
       if (my_pe==0) then
       inquire( FILE='restart_float.dta', EXIST=file_exists )
       if (file_exists) then 
         call particle_read_restart()
       else
!-----------------------------------------------------------------------
!     initialize new set of particles 
!-----------------------------------------------------------------------
        print*,' cannot read restart file '
        nptraj=100
        allocate( pxyz(3,nptraj), pijk(3,nptraj),puvw(3,nptraj) )
!        call seed_particles_randomly
        call seed_particles_regular
        do n=1,nptraj
          i = indp (pxyz(1,n), xu, nx )
          if (xu(i) > pxyz(1,n)) then
            pijk(1,n) = i
          else
            pijk(1,n) = i+1
          endif
          j = indp (pxyz(2,n), yu, ny )
          if (yu(j) > pxyz(2,n)) then
            pijk(2,n) = j
          else
           pijk(2,n) = j+1
          endif
          k = indp (pxyz(3,n), zw, nz)
          if (zw(k) > pxyz(3,n)) then
           pijk(3,n) = k
          else
           pijk(3,n) = k+1
          endif
        enddo
       endif
      endif
!-----------------------------------------------------------------------
!    communicate particles to other pes
!-----------------------------------------------------------------------
      call fortran_barrier
      call bcast_integer(nptraj,1,0)
      if (my_pe/=0)   allocate( pxyz(3,nptraj), pijk(3,nptraj) ,puvw(3,nptraj))
      allocate(particle_active(nptraj),particle_pe(nptraj) )
      call bcast_real(pxyz,3*nptraj,0)
      call bcast_integer(pijk,3*nptraj,0)
      puvw=0.
 if (particle_buoyancy) then
       allocate( ptr(2,nptraj) ); ptr=0.
 endif

 if  (particle_averages) then
      allocate( mu(nptraj) ); mu=0.
      allocate( muu(nptraj) ); muu=0.
      allocate( mv(nptraj) ); mv=0.
      allocate( mvv(nptraj) ); mvv=0.
      allocate( mw(nptraj) ); mw=0.
      allocate( mww(nptraj) ); mww=0.
      counter=0
 endif
 call particle_init_cdf()
 end subroutine init_particle


 
 subroutine integrate_particle
!=======================================================================
!       integrate particles
!=======================================================================
      use pyOM_module   
      use particle_module
      use fcontrol_module
      implicit none 
      integer :: i,j,k,n,m
      real*8 :: xe,xw,yn,ys,zu,zl,dv,th,tf
      real*8 :: xeyszu,xeyszl,xeynzu,xeynzl
      real*8 :: xwyszu,xwyszl,xwynzu,xwynzl
      real*8 :: uuh,vvh,wwh,xold,yold,zold
      real*8 :: uuf,vvf,wwf,uu,vv,ww
      real*8 :: bbf,bbh
      integer, external :: ilim,jlim,klim

      do m=1,mmax
       call particle_inside_pe_domain()
       do n=1,nptraj
        th= (m-1.)/mmax;  tf = 1.-th;
        if (particle_active(n)) then
 if  (particle_buoyancy) then
 !-----------------------------------------------------------------------
 !        interpolate buoyancy on particle
 !-----------------------------------------------------------------------
           i  = pijk(1,n); j  = pijk(2,n); k  = pijk(3,n)
           if (pxyz(1,n) > xt(i) )  i=i+1
           xe = (xt(i) - pxyz(1,n)); xw = (pxyz(1,n)-xt(i-1))
           if (pxyz(2,n) > yt(j) )  j=j+1
           yn = (yt(j) - pxyz(2,n)); ys = (pxyz(2,n) - yt(j-1))
           if (pxyz(3,n) > zt(k) )  k=k+1
           zu = (zt(k) - pxyz(3,n)); zl = (pxyz(3,n)-zt(k-1))
 
           if (maskT(ilim(i+1),j,k)==0) then; xe=dx;xw=0; endif
           if (maskT(i-1,j,k)==0) then; xe=0;xw=dx; endif
           if (maskT(i,jlim(j+1),k)==0) then; yn=dx;ys=0; endif
           if (maskT(i,j-1,k)==0) then; yn=0;ys=dx; endif
           if (maskT(i,j,klim(k+1))==0) then; zu=dz;zl=0; endif
           if (maskT(i,j,k-1)==0) then; zu=0;zl=dz; endif
 
           dv = 1./(dx*dx*dz)
           xeyszu = xe*ys*zu*dv; xwyszu = xw*ys*zu*dv
           xeyszl = xe*ys*zl*dv; xwyszl = xw*ys*zl*dv
           xeynzu = xe*yn*zu*dv; xwynzu = xw*yn*zu*dv
           xeynzl = xe*yn*zl*dv; xwynzl = xw*yn*zl*dv

           bbh=b(i-1,j  ,k-1,tau  )*xeyszu+b(i,j  ,k-1,tau  )*xwyszu  &
              +b(i-1,j  ,k  ,tau  )*xeyszl+b(i,j  ,k  ,tau  )*xwyszl  &
              +b(i-1,j-1,k-1,tau  )*xeynzu+b(i,j-1,k-1,tau  )*xwynzu  &
              +b(i-1,j-1,k  ,tau  )*xeynzl+b(i,j-1,k  ,tau  )*xwynzl
           bbf=b(i-1,j  ,k-1,taup1)*xeyszu+b(i,j  ,k-1,taup1)*xwyszu  &
              +b(i-1,j  ,k  ,taup1)*xeyszl+b(i,j  ,k  ,taup1)*xwyszl  &
              +b(i-1,j-1,k-1,taup1)*xeynzu+b(i,j-1,k-1,taup1)*xwynzu  &
              +b(i-1,j-1,k  ,taup1)*xeynzl+b(i,j-1,k  ,taup1)*xwynzl
           ptr(1,n)=th*bbh+tf*bbf

           ptr(2,n) =p_full(i-1,j  ,k-1,tau  )*xeyszu+p_full(i,j  ,k-1,tau  )*xwyszu   &
              +p_full(i-1,j  ,k  ,tau  )*xeyszl+p_full(i,j  ,k  ,tau  )*xwyszl   &
              +p_full(i-1,j-1,k-1,tau  )*xeynzu+p_full(i,j-1,k-1,tau  )*xwynzu   &
              +p_full(i-1,j-1,k  ,tau  )*xeynzl+p_full(i,j-1,k  ,tau  )*xwynzl   
 
 endif
!-----------------------------------------------------------------------
!            pijk gives tracer box of the particle, 
!            find u-box and distances to borders, account for free slip
!-----------------------------------------------------------------------
          i  = pijk(1,n); j  = pijk(2,n); k  = pijk(3,n)
          xe = (xu(i) - pxyz(1,n)); xw = (pxyz(1,n)-xu(i-1))
          if (pxyz(2,n) > yt(j) )  j=j+1
          yn = (yt(j) - pxyz(2,n)); ys = (pxyz(2,n) - yt(j-1))
          if (pxyz(3,n) > zt(k) )  k=k+1
          zu = (zt(k) - pxyz(3,n)); zl = (pxyz(3,n)-zt(k-1))

          if (maskT(i,jlim(j+1),k)==0) then; yn=dx;ys=0; endif
          if (maskT(i,j-1,k)==0) then; yn=0;ys=dx; endif
          if (maskT(i,j,klim(k+1))==0) then; zu=dz;zl=0; endif
          if (maskT(i,j,k-1)==0) then; zu=0;zl=dz; endif

          dv = 1./(dx*dx*dz)
          xeyszu = xe*ys*zu*dv; xwyszu = xw*ys*zu*dv
          xeyszl = xe*ys*zl*dv; xwyszl = xw*ys*zl*dv
          xeynzu = xe*yn*zu*dv; xwynzu = xw*yn*zu*dv
          xeynzl = xe*yn*zl*dv; xwynzl = xw*yn*zl*dv
!-----------------------------------------------------------------------
!           interpolate u on particle position
!-----------------------------------------------------------------------
          uuh=u(i-1,j  ,k-1,tau  )*xeyszu+u(i,j  ,k-1,tau  )*xwyszu  &
             +u(i-1,j  ,k  ,tau  )*xeyszl+u(i,j  ,k  ,tau  )*xwyszl  &
             +u(i-1,j-1,k-1,tau  )*xeynzu+u(i,j-1,k-1,tau  )*xwynzu  &
             +u(i-1,j-1,k  ,tau  )*xeynzl+u(i,j-1,k  ,tau  )*xwynzl   
          uuf=u(i-1,j  ,k-1,taup1)*xeyszu+u(i,j  ,k-1,taup1)*xwyszu  &
             +u(i-1,j  ,k  ,taup1)*xeyszl+u(i,j  ,k  ,taup1)*xwyszl  &
             +u(i-1,j-1,k-1,taup1)*xeynzu+u(i,j-1,k-1,taup1)*xwynzu  &
             +u(i-1,j-1,k  ,taup1)*xeynzl+u(i,j-1,k  ,taup1)*xwynzl
      if (enable_back_state .and. enable_back_zonal_flow ) then
          uuh=uuh  &
             +u0(i-1,j  ,k-1  )*xeyszu+u0(i,j  ,k-1  )*xwyszu  &
             +u0(i-1,j  ,k    )*xeyszl+u0(i,j  ,k    )*xwyszl  &
             +u0(i-1,j-1,k-1  )*xeynzu+u0(i,j-1,k-1  )*xwynzu  &
             +u0(i-1,j-1,k    )*xeynzl+u0(i,j-1,k    )*xwynzl   
          uuf=uuf  &
             +u0(i-1,j  ,k-1)*xeyszu+u0(i,j  ,k-1)*xwyszu  &
             +u0(i-1,j  ,k  )*xeyszl+u0(i,j  ,k  )*xwyszl  &
             +u0(i-1,j-1,k-1)*xeynzu+u0(i,j-1,k-1)*xwynzu  &
             +u0(i-1,j-1,k  )*xeynzl+u0(i,j-1,k  )*xwynzl
      endif
          uu=th*uuh+tf*uuf
!-----------------------------------------------------------------------
!           find v-box and distances to borders, account for free slip
!-----------------------------------------------------------------------
          i  = pijk(1,n); j  = pijk(2,n); k  = pijk(3,n)
          if (pxyz(1,n) > xt(i) )  i=i+1
          xe = (xt(i) - pxyz(1,n)); xw = (pxyz(1,n)-xt(i-1))
          yn = (yu(j) - pxyz(2,n)); ys = (pxyz(2,n) - yu(j-1))
          if (pxyz(3,n) > zt(k) )  k=k+1
          zu = (zt(k) - pxyz(3,n)); zl = (pxyz(3,n)-zt(k-1))

          if (maskT(ilim(i+1),j,k)==0) then; xe=dx;xw=0; endif
          if (maskT(i-1,j,k)==0) then; xe=0;xw=dx; endif
          if (maskT(i,j,klim(k+1))==0) then; zu=dz;zl=0; endif
          if (maskT(i,j,k-1)==0) then; zu=0;zl=dz; endif

          dv = 1./(dx*dx*dz)
          xeyszu = xe*ys*zu*dv; xwyszu = xw*ys*zu*dv
          xeyszl = xe*ys*zl*dv; xwyszl = xw*ys*zl*dv
          xeynzu = xe*yn*zu*dv; xwynzu = xw*yn*zu*dv
          xeynzl = xe*yn*zl*dv; xwynzl = xw*yn*zl*dv
!-----------------------------------------------------------------------
!           interpolate v on particle position
!-----------------------------------------------------------------------
          vvh=v(i-1,j  ,k-1,tau  )*xeyszu+v(i,j  ,k-1,tau  )*xwyszu  &
             +v(i-1,j  ,k  ,tau  )*xeyszl+v(i,j  ,k  ,tau  )*xwyszl  &
             +v(i-1,j-1,k-1,tau  )*xeynzu+v(i,j-1,k-1,tau  )*xwynzu  &
             +v(i-1,j-1,k  ,tau  )*xeynzl+v(i,j-1,k  ,tau  )*xwynzl
          vvf=v(i-1,j  ,k-1,taup1)*xeyszu+v(i,j  ,k-1,taup1)*xwyszu  &
             +v(i-1,j  ,k  ,taup1)*xeyszl+v(i,j  ,k  ,taup1)*xwyszl  &
             +v(i-1,j-1,k-1,taup1)*xeynzu+v(i,j-1,k-1,taup1)*xwynzu  &
             +v(i-1,j-1,k  ,taup1)*xeynzl+v(i,j-1,k  ,taup1)*xwynzl
      if (enable_back_state .and. enable_back_meridional_flow ) then
          vvh=vvh  &
             +u0(i-1,j  ,k-1 )*xeyszu+u0(i,j  ,k-1 )*xwyszu  &
             +u0(i-1,j  ,k   )*xeyszl+u0(i,j  ,k   )*xwyszl  &
             +u0(i-1,j-1,k-1 )*xeynzu+u0(i,j-1,k-1 )*xwynzu  &
             +u0(i-1,j-1,k   )*xeynzl+u0(i,j-1,k   )*xwynzl
          vvf=vvf  &
             +u0(i-1,j  ,k-1)*xeyszu+u0(i,j  ,k-1)*xwyszu  &
             +u0(i-1,j  ,k  )*xeyszl+u0(i,j  ,k  )*xwyszl  &
             +u0(i-1,j-1,k-1)*xeynzu+u0(i,j-1,k-1)*xwynzu  &
             +u0(i-1,j-1,k  )*xeynzl+u0(i,j-1,k  )*xwynzl
      endif
          vv=th*vvh+tf*vvf
!-----------------------------------------------------------------------
!           find w-box and distances to borders, account for free slip
!-----------------------------------------------------------------------
          i  = pijk(1,n); j  = pijk(2,n); k  = pijk(3,n)
          if (pxyz(1,n) > xt(i) )  i=i+1
          xe = (xt(i) - pxyz(1,n)); xw = (pxyz(1,n)-xt(i-1))
          if (pxyz(2,n) > yt(j) )  j=j+1
          yn = (yt(j) - pxyz(2,n)); ys = (pxyz(2,n) - yt(j-1))
          zu = (zw(k) - pxyz(3,n)); zl = (pxyz(3,n)-zw(k-1))

          if (maskT(ilim(i+1),j,k)==0) then; xe=dx;xw=0; endif
          if (maskT(i-1,j,k)==0) then; xe=0;xw=dx; endif
          if (maskT(i,jlim(j+1),k)==0) then; yn=dx;ys=0; endif
          if (maskT(i,j-1,k)==0) then; yn=0;ys=dx; endif

          dv = 1./(dx*dx*dz)
          xeyszu = xe*ys*zu*dv; xwyszu = xw*ys*zu*dv
          xeyszl = xe*ys*zl*dv; xwyszl = xw*ys*zl*dv
          xeynzu = xe*yn*zu*dv; xwynzu = xw*yn*zu*dv
          xeynzl = xe*yn*zl*dv; xwynzl = xw*yn*zl*dv
!-----------------------------------------------------------------------
!           interpolate w on particle position
!-----------------------------------------------------------------------
          wwh=w(i-1,j  ,k-1,tau  )*xeyszu+w(i,j  ,k-1,tau  )*xwyszu  &
             +w(i-1,j  ,k  ,tau  )*xeyszl+w(i,j  ,k  ,tau  )*xwyszl  &
             +w(i-1,j-1,k-1,tau  )*xeynzu+w(i,j-1,k-1,tau  )*xwynzu  &
             +w(i-1,j-1,k  ,tau  )*xeynzl+w(i,j-1,k  ,tau  )*xwynzl
         if (.not. enable_hydrostatic ) then
          wwf=w(i-1,j  ,k-1,taup1)*xeyszu+w(i,j  ,k-1,taup1)*xwyszu  &
             +w(i-1,j  ,k  ,taup1)*xeyszl+w(i,j  ,k  ,taup1)*xwyszl  &
             +w(i-1,j-1,k-1,taup1)*xeynzu+w(i,j-1,k-1,taup1)*xwynzu  &
             +w(i-1,j-1,k  ,taup1)*xeynzl+w(i,j-1,k  ,taup1)*xwynzl
          ww=th*wwh+tf*wwf
         else
          ww=wwh
         endif
!-----------------------------------------------------------------------
!         integrate the particle trajectory forward for one time step
!-----------------------------------------------------------------------
          xold=pxyz(1,n); yold=pxyz(2,n); zold=pxyz(3,n)
          pxyz(1,n) = pxyz(1,n) + dt*uu/mmax
          pxyz(2,n) = pxyz(2,n) + dt*vv/mmax
          pxyz(3,n) = pxyz(3,n) + dt*ww/mmax
          puvw(1,n)=uu; puvw(2,n)=vv; puvw(3,n)=ww
!-----------------------------------------------------------------------
!           update index of bounding tracer volume
!-----------------------------------------------------------------------
          i  = pijk(1,n); j  = pijk(2,n); k  = pijk(3,n)
          if (pxyz(1,n) >= xu(i)) then
            pijk(1,n) = i + 1
          else if (pxyz(1,n) < xu(i-1)) then
            pijk(1,n) = i - 1
          endif
          if (enable_cyclic_x .and. pijk(1,n)==nx ) then
             pijk(1,n)=2; pxyz(1,n)=pxyz(1,n)-dx*(nx -2)
          endif
          if (enable_cyclic_x .and. pijk(1,n)==1) then
            pijk(1,n)=nx -1; pxyz(1,n)=pxyz(1,n)+dx*(nx -2)
          endif

          if (pxyz(2,n) >= yu(j)) then
            pijk(2,n) = j + 1
          else if (pxyz(2,n) < yu(j-1)) then
            pijk(2,n) = j - 1
          endif
          if (enable_cyclic_y .and. pijk(2,n)==ny ) then
             pijk(2,n)=2; pxyz(2,n)=pxyz(2,n)-dx*(ny -2)
          endif
          if (enable_cyclic_y .and. pijk(2,n)==1) then
            pijk(2,n)=ny -1; pxyz(2,n)=pxyz(2,n)+dx*(ny -2)
          endif

          if (pxyz(3,n) >= zw(k)) then
            pijk(3,n) = k + 1
          else if (pxyz(3,n) < zw(k-1)) then
            pijk(3,n) = k - 1
          endif
!-----------------------------------------------------------------------
!         constrain particles vertically to lie within ocean
!-----------------------------------------------------------------------
          if (pijk(3,n) /= k) then
            if (pijk(3,n) > k .and. maskT(i,j,k+1) ==0.) then
              pxyz(3,n) = zold
              pijk(3,n) = k
            endif
            if (pijk(3,n) < k .and. maskT(i,j,k-1) ==0.) then
              pxyz(3,n) = zold
              pijk(3,n) = k
            endif
          endif
!-----------------------------------------------------------------------
!         constrain particles longitudinally to stay within ocean 
!-----------------------------------------------------------------------
          if (pijk(1,n) /= i) then
            if (pijk(1,n) > i .and. maskT(i+1,j,k) ==0.) then
              pxyz(1,n) = xold
              pijk(1,n) = i
            else if (pijk(1,n) < i .and. maskT(i-1,j,k) ==0.) then
              pxyz(1,n) = xold
              pijk(1,n) = i
            endif 
          endif 
!-----------------------------------------------------------------------
!         constrain particles latitudinally to stay within ocean 
!-----------------------------------------------------------------------
          if (pijk(2,n) /= j) then
            if (pijk(2,n) > j .and. maskT(i,j+1,k) == 0. ) then
              pxyz(2,n) = yold
              pijk(2,n) = j
            else if (pijk(2,n) < j .and. maskT(i,j-1,k) == 0.) then
              pxyz(2,n) = yold
              pijk(2,n) = j
            endif 
          endif 
        endif ! particle_active
!-----------------------------------------------------------------------
!      average some quantitites
!-----------------------------------------------------------------------

 if  (particle_averages) then
         mu(n)=mu(n)+uu
         muu(n)=muu(n)+uu**2
         mv(n)=mv(n)+vv
         mvv(n)=mvv(n)+vv**2
         mw(n)=mw(n)+ww
         mww(n)=mww(n)+ww**2
 endif
   enddo ! nptraj
 if  (particle_averages) then
        counter=counter+1
 endif
       call particle_distribute
      enddo ! m

!-----------------------------------------------------------------------
!      write particle positions to netcdf file
!-----------------------------------------------------------------------
      if ( mod(itt,int(snapint/dt))  == 0)  then

 if  (particle_averages) then
          mu=mu/counter; muu=muu/counter-mu**2
          mv=mv/counter; mvv=mvv/counter-mv**2
          mw=mw/counter; mww=mww/counter-mw**2
 endif
        call particle_write_cdf()

 if  (particle_averages) then
        counter=0; mu=0;muu=0;mv=0;mvv=0;mw=0;mww=0
 endif
      endif
 end subroutine integrate_particle





 subroutine particle_write_cdf
!=======================================================================
!       integrate particles
!=======================================================================
      use pyOM_module   
      use particle_module
      use fcontrol_module
      implicit none 
      include "netcdf.inc"
      integer :: ncid,iret,xid,yid,zid,timedim,ilen,timeid
      integer :: uid,vid,wid,bid,pid,uuid,vvid,wwid,n
      real*8 :: fxa,time
      real*8, parameter :: spval = -1.0d33
      if (my_pe==0) then
         print*,'writing particles to file float.cdf'
         iret=nf_open('float.cdf',NF_WRITE,ncid)
         iret=nf_set_fill(ncid, NF_NOFILL, iret)
         iret=nf_inq_varid(ncid,'x_pos',xid)
         iret=nf_inq_varid(ncid,'y_pos',yid)
         iret=nf_inq_varid(ncid,'z_pos',zid)
         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,'uu',uuid)
         iret=nf_inq_varid(ncid,'vv',vvid)
         iret=nf_inq_varid(ncid,'ww',wwid)
 if (particle_buoyancy) then
          iret=nf_inq_varid(ncid,'b',bid)
          iret=nf_inq_varid(ncid,'p',pid)
 endif
         iret=nf_inq_dimid(ncid,'Time',timedim)
         iret=nf_inq_dimlen(ncid, timedim,ilen)
         iret=nf_inq_varid(ncid,'Time',timeid)
         ilen=ilen+1
        time = itt*dt
        fxa = time/86400.0
         iret= nf_put_vara_double(ncid,timeid,ilen,1,fxa)
         do n=1,nptraj
        iret= nf_put_vara_double(ncid,xid,(/n,ilen/),(/1,1/),pxyz(1,n))
        iret= nf_put_vara_double(ncid,yid,(/n,ilen/),(/1,1/),pxyz(2,n))
        iret= nf_put_vara_double(ncid,zid,(/n,ilen/),(/1,1/),pxyz(3,n))
 if  (particle_averages) then
         iret= nf_put_vara_double(ncid,uid,(/n,ilen/),(/1,1/),mu(n))
         iret= nf_put_vara_double(ncid,vid,(/n,ilen/),(/1,1/),mv(n))
         iret= nf_put_vara_double(ncid,wid,(/n,ilen/),(/1,1/),mw(n))
         iret= nf_put_vara_double(ncid,uuid,(/n,ilen/),(/1,1/),muu(n))
         iret= nf_put_vara_double(ncid,vvid,(/n,ilen/),(/1,1/),mvv(n))
         iret= nf_put_vara_double(ncid,wwid,(/n,ilen/),(/1,1/),mww(n))
 else
        iret= nf_put_vara_double(ncid,uid,(/n,ilen/),(/1,1/),puvw(1,n))
        iret= nf_put_vara_double(ncid,vid,(/n,ilen/),(/1,1/),puvw(2,n))
        iret= nf_put_vara_double(ncid,wid,(/n,ilen/),(/1,1/),puvw(3,n))
 endif
 if (particle_buoyancy) then
         iret= nf_put_vara_double(ncid,bid,(/n,ilen/),(/1,1/),ptr(1,n))
         iret= nf_put_vara_double(ncid,pid,(/n,ilen/),(/1,1/),ptr(2,n))
 endif
         enddo
         call ncclos (ncid, iret)
       endif
       call fortran_barrier

 end subroutine particle_write_cdf




subroutine particle_init_cdf
      use pyOM_module   
      use particle_module
      use fcontrol_module
      implicit none 
      include "netcdf.inc"
      integer :: iret,dims(2),xid,yid,zid,uid,vid,wid,bid,pid
      integer :: ncid,Timedim,Timeid,pdim,uuid,vvid,wwid
      character :: name*24, unit*16
      real*8, parameter :: spval = -1.0d33

!-----------------------------------------------------------------------
!     define output file
!-----------------------------------------------------------------------
      if (my_pe==0) then
       ncid = nccre ('float.cdf', NCCLOB, iret)
       iret=nf_set_fill(ncid, NF_NOFILL, iret)
       Timedim = ncddef(ncid, 'Time', nf_unlimited, iret)
       pdim    = ncddef(ncid, 'Number', nptraj, iret)
       timeid  = ncvdef (ncid,'Time', NCFLOAT,1,timedim,iret)
       dims = (/pdim,Timedim/)
       xid  = ncvdef (ncid,'x_pos', NCFLOAT,2,dims,iret)
       yid  = ncvdef (ncid,'y_pos', NCFLOAT,2,dims,iret)
       zid  = ncvdef (ncid,'z_pos', NCFLOAT,2,dims,iret)
       uid  = ncvdef (ncid,'u', NCFLOAT,2,dims,iret)
       vid  = ncvdef (ncid,'v', NCFLOAT,2,dims,iret)
       wid  = ncvdef (ncid,'w', NCFLOAT,2,dims,iret)
 if  (particle_averages) then
        uuid  = ncvdef (ncid,'uu', NCFLOAT,2,dims,iret)
        vvid  = ncvdef (ncid,'vv', NCFLOAT,2,dims,iret)
        wwid  = ncvdef (ncid,'ww', NCFLOAT,2,dims,iret)
 endif
 if (particle_buoyancy) then
        pid  = ncvdef (ncid,'p', NCFLOAT,2,dims,iret)
        bid  = ncvdef (ncid,'b', NCFLOAT,2,dims,iret)
 endif
       name = 'Time '; unit = 'days'
       call ncaptc(ncid, timeid, 'long_name', NCCHAR, 24, name, iret) 
       call ncaptc(ncid, timeid, 'units',     NCCHAR, 16, unit, iret) 
       call ncaptc(ncid, Timeid,'time_origin',NCCHAR, 20,'01-JAN-1900 00:00:00', iret)
       name = 'X position'; unit = 'm'
       call dvcdf(ncid,xid,name,24,unit,16,spval)
       name = 'Y position'; unit = 'm'
       call dvcdf(ncid,yid,name,24,unit,16,spval)
       name = 'Z position'; unit = 'm'
       call dvcdf(ncid,zid,name,24,unit,16,spval)
       name = 'zonal velocity'; unit = 'm/s'
       call dvcdf(ncid,uid,name,24,unit,16,spval)
       name = 'meridional velocity'; unit = 'm/s'
       call dvcdf(ncid,vid,name,24,unit,16,spval)
       name = 'vertical velocity'; unit = 'm/s'
       call dvcdf(ncid,wid,name,24,unit,16,spval)
 if (particle_buoyancy) then
        name = 'buoyancy'; unit = 'm/s^2'
        call dvcdf(ncid,bid,name,24,unit,16,spval)
        name = 'pressure'; unit = 'm^2/s'
        call dvcdf(ncid,pid,name,24,unit,16,spval)
 endif
 if  (particle_averages) then
        name = 'zonal velocity variance'; unit = 'm^2/s^2'
        call dvcdf(ncid,uuid,name,24,unit,16,spval)
        name = 'meridional velocity variance'; unit = 'm^2/s^2'
        call dvcdf(ncid,vvid,name,24,unit,16,spval)
        name = 'vertical velocity variance'; unit = 'm^2/s^2'
        call dvcdf(ncid,wwid,name,24,unit,16,spval)
 endif
       call ncclos (ncid, iret)
      endif

      if (my_pe==0)  then
       print*,' Done initializing time averaging module'
      endif
end subroutine particle_init_cdf


subroutine particle_write_restart(ierr)
      use pyOM_module   
      use particle_module
      use fcontrol_module
      implicit none 
      integer :: n,io,ierr
!-----------------------------------------------------------------------
!    write restart file
!-----------------------------------------------------------------------
   ierr=0
   if (my_pe==0) then
      print*,'writing restart file for particles'
      call get_free_iounit(io)
      open(io,file='restart_float.dta',form='unformatted',status='unknown')
      write(io) nptraj
      do n=1,nptraj
       write(io) pijk(1:3,n),pxyz(1:3,n),puvw(1:3,n)
      enddo
      close(io)
      print*,' done writing restart'
  endif
 end subroutine particle_write_restart


subroutine particle_read_restart
      use pyOM_module   
      use particle_module
      use fcontrol_module
      implicit none 
      integer :: n,io
 if (my_pe==0) then
        print*,' reading data from restart file '
        call get_free_iounit(io)
        open(io,file='restart_float.dta',form='unformatted',   status='old')
        read(io) nptraj
        allocate( pxyz(3,nptraj), pijk(3,nptraj),puvw(3,nptraj) )
        print*,' number of particles = ',nptraj
        do n=1,nptraj
         read(io) pijk(1:3,n),pxyz(1:3,n),puvw(1:3,n)
        enddo
        close(io)
        print*,' done reading restart'
 endif
end subroutine particle_read_restart


 subroutine particle_inside_pe_domain()
!=======================================================================
!       is particle inside domain of pe?
!=======================================================================
      use pyOM_module   
      use particle_module
      implicit none 
      integer :: n

      do n=1,nptraj
       if (pijk(2,n)>=js_pe .and. pijk(2,n)<=je_pe) then
        particle_active(n) = .true. 
        particle_pe(n)=my_pe
       else
        particle_active(n) = .false.
        particle_pe(n)=-1
       endif
      enddo
      call global_max_int(particle_pe,nptraj)
 end subroutine particle_inside_pe_domain


 subroutine particle_distribute
!=======================================================================
!     distribute particles to all pes
!=======================================================================
      use pyOM_module   
      use particle_module
      implicit none 
      integer :: n
      call fortran_barrier()
      do n=1,nptraj
       if (particle_pe(n)>=0) then
        call bcast_real(    pxyz(3,n),3,particle_pe(n))
        call bcast_integer(pijk(3,n),3,particle_pe(n))
      elseif (my_pe==0) then
        print*,' WARNING : particle #',n,' is out of domain.', ' pxyz= ',pxyz(:,n),' pijk= ',pijk(:,n), &
                ' particle PE=',particle_pe(n)
      endif
      enddo
 end subroutine particle_distribute


 subroutine seed_particles_randomly
!=======================================================================
!      seed the particles
!=======================================================================
      use pyOM_module   
      use particle_module
      implicit none 
      real:: fxa,xs,xe,ys,ye,zs,ze ! mit absicht nciht real*8
      integer :: n
!#ifdef two_dim
!      xs=xt(2); xe=xt(nx -1)
!      ys=yt(2);
!      zs=zt(2); ze=zt(nz-1)
!      do n=1,nptraj
!        pxyz(2,n) = ys
!        call random_number(fxa)
!        pxyz(1,n) = xs+fxa*(xe-xs)
!        call random_number(fxa)
!        pxyz(3,n) = zs+fxa*(ze-zs)
!!      enddo
!#else
      xs=xt(2); xe=xt(nx-1)
      ys=xt(2); ye=yt(ny-1)
      zs=zt(2); ze=zt(nz-1)
      do n=1,nptraj
       call random_number(fxa)
       pxyz(1,n) = xs+fxa*(xe-xs)
       call random_number(fxa)
       pxyz(2,n) = ys+fxa*(ye-ys)
       call random_number(fxa)
       pxyz(3,n) = zs+fxa*(ze-zs)
      enddo
!#endif
 end subroutine seed_particles_randomly


 subroutine seed_particles_regular
!=======================================================================
!      seed the particles
!=======================================================================
      use pyOM_module   
      use particle_module
      implicit none 
      real*8 :: cubr,distx,disty,distz
      integer :: n
      real*8 :: xs,xe,ys,ye,zs,ze
      logical :: two_dimx = .false.
      logical :: two_dimy = .true.

 if (two_dimx) then
      xs=xt(2); xe=xt(nx -1)
      ys=yt(ny/2);
      zs=zt(2); ze=zt(nz-1)
      cubr       = float(nptraj)**0.5
      distx      = (xe - xs)/cubr
      distz      = (ze - zs)/cubr
      pxyz(1,1) = .5*distx + xs
      pxyz(2,1) =  ys
      pxyz(3,1) = .5*distz + zs
      do n=2,nptraj
        pxyz(1,n) = pxyz(1,n-1)
        pxyz(2,n) = pxyz(2,n-1)
        pxyz(3,n) = pxyz(3,n-1)
        pxyz(1,n)  = pxyz(1,n) + distx
        if (pxyz(1,n) > xe) then
         pxyz(1,n) = xs + (pxyz(1,n)-xe)
         pxyz(2,n) = ys
         pxyz(3,n) = pxyz(3,n) + distz
       endif
      enddo
 elseif (two_dimy) then

      xs=0.5*xt(nx);
      ys=yt(2); ye=yt(ny-1)
      zs=zt(2); ze=zt(nz-1)
      cubr       = float(nptraj)**0.5
      disty      = (ye - ys)/cubr
      distz      = (ze - zs)/cubr
      pxyz(1,1) =  xs
      pxyz(2,1) = .5*disty + ys
      pxyz(3,1) = .5*distz + zs
      do n=2,nptraj
        pxyz(1,n) = pxyz(1,n-1)
        pxyz(2,n) = pxyz(2,n-1)
        pxyz(3,n) = pxyz(3,n-1)
        pxyz(2,n)  = pxyz(2,n) + disty
        if (pxyz(2,n) > ye) then
         pxyz(2,n) = ys + (pxyz(2,n)-ye)
         pxyz(1,n) = xs
         pxyz(3,n) = pxyz(3,n) + distz
       endif
      enddo
 else

      xs=xt(2); xe=xt(nx -1)
      ys=yt(2); ye=yt(ny -1)
      zs=zt(2); ze=zt(nz-1)
      cubr       = float(nptraj)**0.333333
      distx      = (xe - xs)/cubr
      disty      = (ye - ys)/cubr
      distz      = (ze - zs)/cubr
      pxyz(1,1) = .5*distx + xs
      pxyz(2,1) = .5*disty + ys
      pxyz(3,1) = .5*distz + zs
      do n=2,nptraj
        pxyz(1,n) = pxyz(1,n-1)
        pxyz(2,n) = pxyz(2,n-1)
        pxyz(3,n) = pxyz(3,n-1)
        pxyz(1,n)  = pxyz(1,n) + distx
        if (pxyz(1,n) > xe) then
         pxyz(1,n) = xs + (pxyz(1,n)-xe)
         pxyz(2,n) = pxyz(2,n) + disty
         if (pxyz(2,n) > ye) then
          pxyz(2,n) = ys + (pxyz(2,n)-ye)
          pxyz(3,n) = pxyz(3,n) + distz
         endif
        endif
      enddo
 endif
 end subroutine seed_particles_regular


 function ilim(i)
      use pyOM_module   
      implicit none 
      integer :: i ,ilim
      if (enable_cyclic_x) then
        ilim=i
        if (i>nx ) ilim=i-(nx -2)
        if (i<1) ilim=i+(nx -2)
      else
        ilim=max(1,min(nx ,i))
      endif
 end function ilim

 function jlim(j)
      use pyOM_module   
      implicit none 
      integer :: j ,jlim
      if (enable_cyclic_y) then
        jlim=j
        if (j>ny ) jlim=j-(ny -2)
        if (j<1) jlim=j+(ny -2)
      else
        jlim=max(1,min(ny ,j))
      endif
 end function jlim

 function klim(k)
      use pyOM_module   
      implicit none 
      integer :: k ,klim
      klim=max(1,min(nz,k))
 end function klim


 integer function indp (value, array, ia)
!
!=======================================================================
!
!     indp = index of nearest data point within "array" corresponding to
!            "value".
!
!     inputs:
!
!     value  = arbitrary data...same units as elements in "array"
!     array  = array of data points  (must be monotonically increasing)
!     ia     = dimension of "array"
!
!     output:
!
!     indp =  index of nearest data point to "value"
!             if "value" is outside the domain of "array" then indp = 1
!             or "ia" depending on whether array(1) or array(ia) is
!             closest to "value"
!
!             note: if "array" is dimensioned array(0:ia) in the calling
!                   program, then the returned index should be reduced
!                   by one to account for the zero base.
!
!     author:      r. c. pacanowski      e-mail=> rcp@gfdl.gov
!
!     example:
!
!     let model depths be defined by the following:
!     parameter (km=5)
!     dimension z(km)
!     data z /5.0, 10.0, 50.0, 100.0, 250.0/
!
!     k1 = indp (12.5, z, km)
!     k2 = indp (0.0, z, km)
!
!     k1 would be set to 2, & k2 would be set to 1 so that
!     z(k1) would be the nearest data point to 12.5 and z(k2) would
!     be the nearest data point to 0.0
!
!=======================================================================
!
      implicit none
      integer :: i,ia,ii
      integer :: stdout=6
      real*8, dimension(ia) ::  array
      real*8 :: value
!
      do i=2,ia
        if (array(i) .lt. array(i-1)) then
         write (stdout,*)  &
        ' => Error: array must be monotonically increasing in "indp"'   &
     ,  '           when searching for nearest element to value=',value 
          write (stdout,*) '           array(i) < array(i-1) for i=',i 
          write (stdout,*) '           array(i) for i=1..ia follows:'
          do ii=1,ia
            write (stdout,*) 'i=',ii, ' array(i)=',array(ii)
          enddo
          stop
       endif
      enddo
      if (value .lt. array(1) .or. value .gt. array(ia)) then
        if (value .lt. array(1))  indp = 1
        if (value .gt. array(ia)) indp = ia
        return
      else
        do i=2,ia
          if (value .le. array(i)) then
            indp = i
            if (array(i)-value .gt. value-array(i-1)) indp = i-1
            go to 101
          endif
        enddo
101     continue
      endif
 end function indp

