! Program sampling the velocity field and making the wavelet
! filtering/approximation.
! Author: Michel Rieutord
! new version for the computation of the velocity field 31/8/2006

! input: vx,vy,x,y (velocities and positions of the granules)
! output: write, through the output.f90 routine, files containing the original
! velocity field sampled on a regular grid, and first wavelet-filtered fields
! with resolutions decreasing by a factor 2 each time.
! h-suffix = half resol. compared to original field
! m-suffix = quarter   "    "      "   "       "
! l-suffix = eigth   "    "      "   "       "
! The filtering can be increased by increasing ns


        module interpolationth

contains
        subroutine interpol2dth(vx,vy,dv,x,y,n,nc,nnx,nny)

        use param_run
        use m_mres2d
        use m_div_curl
        use deriw2d
        use m_output

        implicit none

        real, dimension (:), intent(in) :: vx,vy,dv,x,y
        integer, intent(in) :: n,nc,nnx,nny
        real, dimension (:,:), allocatable :: rms_ux,rms_uy

        real(kind(0d0)), dimension (:,:), allocatable :: &
                         ux_detail,du_detail,uy_detail
        real(kind(0d0)), target, dimension (:,:), allocatable :: ux,uy, &
         du,ux_recons,uy_recons,du_recons,rxx,rxy,ryy,u2ux,u2uy,u2,buf, &
         sxx,sxy,syy,bufb,rxx_recons,rxy_recons,ryy_recons, &
         sxx_recons,sxy_recons,syy_recons

        real(kind(0d0)), pointer, dimension(:,:) :: uxp,uyp,dup,div, &
         del_div,curl,rx,ry

        real xmin,xmax,ymin,ymax,dvmin,dumoy,uxmoy,uymoy,u2uxmoy,u2uymoy
        real u2m,rxxmoy,rxymoy,ryymoy,sxxmoy,sxymoy,syymoy
        integer bin_sp_test,dimx,dimy,i,ii,il,j,jj,k,l,ns,kk(1000)
        logical warn

! Make the matrices of data
        !xmin=minval(x(1:n)); xmax=maxval(x(1:n))
        !ymin=minval(y(1:n)); ymax=maxval(y(1:n))
;        xmin=nx1; xmax=nx2
;        ymin=ny1; ymax=ny2
        xmin=0 ; xmax=nnx !!!!!!!! THIERRY LE 7 AVRIL 2011
        ymin=0 ; ymax=nny !!!!!!!! THIERRY LE 7 AVRIL 2011

        dimx=int((xmax-xmin)/bin_sp)+1
        dimy=int((ymax-ymin)/bin_sp)+1
  !!      print*,'nx1,nx2,ny1,ny2',nx1,nx2,ny1,ny2
  !!      print*,'dimensions x y',dimx,dimy

        allocate(ux(dimx,dimy),uy(dimx,dimy),du(dimx,dimy))
        allocate(u2ux(dimx,dimy),u2uy(dimx,dimy),u2(dimx,dimy))
        allocate(rms_ux(dimx,dimy),rms_uy(dimx,dimy))
        allocate(buf(dimx,dimy),bufb(dimx,dimy))
        allocate(ux_recons(dimx,dimy),uy_recons(dimx,dimy))
        allocate(ux_detail(dimx,dimy),uy_detail(dimx,dimy))
        allocate(du_recons(dimx,dimy),du_detail(dimx,dimy))
        allocate(rxx(dimx,dimy),rxy(dimx,dimy),ryy(dimx,dimy))
        allocate(rxx_recons(dimx,dimy),rxy_recons(dimx,dimy),ryy_recons(dimx,dimy))
        allocate(sxx_recons(dimx,dimy),sxy_recons(dimx,dimy),syy_recons(dimx,dimy))
        allocate(sxx(dimx,dimy),sxy(dimx,dimy),syy(dimx,dimy))

! Mise a zero (s'avere necessaire)
        ux=0d0;  uy=0d0; du=0d0; du_recons=0d0; du_detail=0d0
        rms_ux=0d0;  rms_uy=0d0
        ux_recons=0d0; uy_recons=0d0; ux_detail=0d0; uy_detail=0d0
        rxx=0; rxy=0; ryy=0; u2ux=0; u2uy=0; u2=0

! Scan the bins of the velocity map
! For each bin, take the average velocity of granules falling in the bin

        do j=1,dimy
!!         print*,'progress',j,dimy
         do i=1,dimx
! bin (i,j) : find all the granules falling in it!
          l=0; kk=0
          do k=1,n
           ii=int((x(k)-xmin)/bin_sp)+1
           jj=int((y(k)-ymin)/bin_sp)+1
           if ( abs(i-ii)+abs(j-jj) == 0) then
            l=l+1
            kk(l)=k
           endif
          enddo
! Compute the mean velocity in bin (i,j)
          ux(i,j)=0; uy(i,j)=0; u2(i,j)=0
          u2ux(i,j)=0; u2uy(i,j)=0; rxx(i,j)=0; rxy(i,j)=0; ryy(i,j)=0
          do il=1,l
           ux(i,j)=ux(i,j)+vx(kk(il))/l
           uy(i,j)=uy(i,j)+vy(kk(il))/l
           u2(i,j)=u2(i,j)+(vx(kk(il))**2+vy(kk(il))**2)/l
           u2ux(i,j)=u2ux(i,j)+(vx(kk(il))**2+vy(kk(il))**2)*vx(kk(il))/l
           u2uy(i,j)=u2uy(i,j)+(vx(kk(il))**2+vy(kk(il))**2)*vy(kk(il))/l
           rxx(i,j)=rxx(i,j)+vx(kk(il))**2/l
           rxy(i,j)=rxy(i,j)+vx(kk(il))*vy(kk(il))/l
           ryy(i,j)=ryy(i,j)+vy(kk(il))**2/l
          enddo
          if (i==1 .and. j==1 .and. verbose>=2) then
           do il=1,l
 !!!          print*,'l,vx,vy',il,kk(il),vx(kk(il)),vy(kk(il))
           enddo
!!!           print*,'moyenne',ux(i,j),uy(i,j)
          endif
! Rms of velocity in bin (i,j)
          rms_ux(i,j)=0; rms_uy(i,j)=0
          do il=1,l
           rms_ux(i,j)=rms_ux(i,j)+(vx(kk(il))-ux(i,j))**2/l
           rms_uy(i,j)=rms_uy(i,j)+(vy(kk(il))-uy(i,j))**2/l
          enddo
          rms_ux(i,j)=sqrt(rms_ux(i,j)); rms_uy(i,j)=sqrt(rms_uy(i,j))
          du(i,j)=sqrt(rms_ux(i,j)+rms_uy(i,j))/sqrt(2d0)
          if (verbose>=2) print*,'nb granules in ij',i,j,l
          if (verbose>=2) print*,'u',ux(i,j),uy(i,j)
          if (verbose>=2) print*,'rms',du(i,j)
         enddo
        enddo
   !!     print*,'percentage of data',real(count(abs(ux)+abs(uy) /= 0d0))/size(ux)

! Sortie des champs originaux (contenant les zeros)
         uxp => ux
         uyp => uy
         dup => du
         call divergence(uxp,uyp,dup,div,del_div)
         call rot(uxp,uyp,dup,curl,del_div)
         ns=0
         call output(ux,'ux',dimx,dimy,nc,ns)
         call output(uy,'uy',dimx,dimy,nc,ns)
         call output(div,'div',dimx,dimy,nc,ns)
         call output(curl,'rot',dimx,dimy,nc,ns)
         call output(du,'err',dimx,dimy,nc,ns)
! Shear
         buf=dx(uxp,1)
         call output(buf,'sxx',dimx,dimy,nc,ns)
         buf=dx(uyp,1)+dx(uxp,2)
         call output(buf,'sxy',dimx,dimy,nc,ns)
         buf=dx(uyp,2)
         call output(buf,'syy',dimx,dimy,nc,ns)

! Output of the Reynolds stress
         call output(rxx,'rxx',dimx,dimy,nc,ns)
         call output(rxy,'rxy',dimx,dimy,nc,ns)
         call output(ryy,'ryy',dimx,dimy,nc,ns)
         uxp => u2ux
         uyp => u2uy
         call divergence(uxp,uyp,dup,div,del_div)
         call output(div,'tra',dimx,dimy,nc,ns)
! The same but using <u^2>
         buf=(ux**2+uy**2)*ux
         bufb=(ux**2+uy**2)*uy
         uxp => buf
         uyp => bufb
         call divergence(uxp,uyp,dup,div,del_div)
         call output(div,'trb',dimx,dimy,nc,ns)

! Direct calculation of v_j\partial_j v^2
         uxp => u2
         buf=ux*dx(uxp,1)+uy*dx(uxp,2)
         call output(buf,'trc',dimx,dimy,nc,ns)


!        print*,'ux apres le 1er output',ux(1:10,1:10)
! décompositions ondelettes de Daubechies + reconstruction
! the largest scale is given by the user: it is N_min (the minimum
! spatial frequency).

! number of scales
!        ns=int(log(real(min(dimx,dimy)/n_min))/log(2.))+1

        uxmoy=sum(ux)/size(ux); ux=ux-uxmoy
        uymoy=sum(uy)/size(uy); uy=uy-uymoy
        dumoy=sum(du)/size(du); du=du-dumoy
        u2uxmoy=sum(u2ux)/size(u2ux); u2ux=u2ux-u2uxmoy
        u2uymoy=sum(u2uy)/size(u2uy); u2uy=u2uy-u2uymoy
        u2m=sum(u2)/size(u2); u2=u2-u2m
        rxxmoy=sum(rxx)/size(rxx); rxx=rxx-rxxmoy
        rxymoy=sum(rxy)/size(rxy); rxy=rxy-rxymoy
        ryymoy=sum(ryy)/size(ryy); ryy=ryy-ryymoy

! compute the Reynolds force -\partial_j(R_ij)
        buf=ux**2
        bufb=ux*uy

         uxp => buf
         uyp => bufb
         call divergence(uxp,uyp,dup,rx,del_div)
         buf=uy**2
         uxp => bufb
         uyp => buf
         call divergence(uxp,uyp,dup,ry,del_div)
         call output(rx,'rx',dimx,dimy,nc,ns)
         call output(ry,'ry',dimx,dimy,nc,ns)

! computation of the four best approximations+++++++++++++++++++++++++++
        do ns=1,4
         call mres2d(ux,ux_recons,ns,0,wavelet) ! computes the approximation
         call mres2d(uy,uy_recons,ns,0,wavelet)
         call mres2d(du,du_recons,ns,0,wavelet)
        ! print*,'ns',ns
        ! print*,'ux',ux(1:10,1:10)
        ! print*,'ux_recons',ux_recons(1:10,1:10)

         ux_recons=ux_recons+uxmoy
         uy_recons=uy_recons+uymoy
         du_recons=du_recons+dumoy

         uxp => ux_recons
         uyp => uy_recons
         dup => du_recons

         call divergence(uxp,uyp,dup,div,del_div)
         call rot(uxp,uyp,dup,curl,del_div)
!call output(ux_recons,uy_recons,div,curl,du_recons,del_div,dimx,dimy,nc,ns)
         call output(ux_recons,'ux',dimx,dimy,nc,ns)
         call output(uy_recons,'uy',dimx,dimy,nc,ns)
         call output(div,'div',dimx,dimy,nc,ns)
         call output(curl,'rot',dimx,dimy,nc,ns)
         call output(du_recons,'err',dimx,dimy,nc,ns)
! Shear
         buf=dx(uxp,1)
         call output(buf,'sxx',dimx,dimy,nc,ns)
         buf=dx(uyp,1)+dx(uxp,2)
         call output(buf,'sxy',dimx,dimy,nc,ns)
         buf=dx(uyp,2)
         call output(buf,'syy',dimx,dimy,nc,ns)

! Div du tenseur de Reynolds
         buf=ux_recons**2
         bufb=ux_recons*uy_recons

         uxp => buf
         uyp => bufb
         call divergence(uxp,uyp,dup,rx,del_div)
         buf=uy_recons**2
         uxp => bufb
         uyp => buf
         call divergence(uxp,uyp,dup,ry,del_div)
         call output(rx,'rx',dimx,dimy,nc,ns)
         call output(ry,'ry',dimx,dimy,nc,ns)

! Fonction de transfert non-lineaire
         call mres2d(u2ux,ux_recons,ns,0,wavelet) ! computes the approximation
         call mres2d(u2uy,uy_recons,ns,0,wavelet)
         ux_recons=ux_recons+u2uxmoy
         uy_recons=uy_recons+u2uymoy
         uxp => ux_recons
         uyp => uy_recons
         call divergence(uxp,uyp,dup,div,del_div)
         call output(div,'tra',dimx,dimy,nc,ns)
! The same but using <u^2>
         buf=(ux_recons**2+uy_recons**2)*ux_recons
         bufb=(ux_recons**2+uy_recons**2)*uy_recons
         uxp => buf
         uyp => bufb
         call divergence(uxp,uyp,dup,div,del_div)
         call output(div,'trb',dimx,dimy,nc,ns)

! Direct calculation of v_j\partial_j v^2
         call mres2d(u2,ux_recons,ns,0,wavelet) ! computes the approximation
         ux_recons=ux_recons+u2m
         uxp => ux_recons
         buf=ux*dx(uxp,1)+uy*dx(uxp,2)
         call output(buf,'trc',dimx,dimy,nc,ns)

! computation of the Reynolds stress components
         call mres2d(rxx,rxx_recons,ns,0,wavelet) ! computes the approximation
         call mres2d(rxy,rxy_recons,ns,0,wavelet)
         call mres2d(ryy,ryy_recons,ns,0,wavelet)
         rxx_recons=rxx_recons+rxxmoy
         rxy_recons=rxy_recons+rxymoy
         ryy_recons=ryy_recons+ryymoy
         call output(rxx_recons,'rxx',dimx,dimy,nc,ns)
         call output(rxy_recons,'rxy',dimx,dimy,nc,ns)
         call output(ryy_recons,'ryy',dimx,dimy,nc,ns)


! End of computation of the four best approximations+++++++++++++++++++++++++++
        enddo


        ns=4

! computation of the details; useful for checking
        
         if (ns >= 1 .and. check == 'yes') then
                do i=1,ns
                  call mres2d(ux,ux_detail,i,4,wavelet)
                  call mres2d(uy,uy_detail,i,4,wavelet)
                  call mres2d(du,du_detail,i,4,wavelet)
                  ux_recons=ux_recons+ux_detail
                  uy_recons=uy_recons+uy_detail
                  du_recons=du_recons+du_detail
                enddo
         endif

!         if (check == 'yes') then
!         print*,'difference original/reconstruction en relatif'
!         print*,maxval(abs(ux_recons-uxmoy-ux))/maxval(abs(ux))
!        endif
!        print*,maxval(abs(uy_recons-uy))/maxval(abs(uy))
!        print*,'another estimate of the error'
!        print*,maxval(abs(ux_recons-uxmoy-ux)/sqrt(ux**2+uy**2), &
!                        sqrt(ux**2+uy**2) /= 0.)


        deallocate(ux_recons,uy_recons,du_recons)

        end subroutine

        end module
