        module segmentation

contains

      subroutine segment(a,nx,ny,ia)

!     Segmentation of granules using the curvatures in 4 directions
!     adapted from segmentons.pro (Thierry Roudier, 1998)
!     by Nadege Meunier (2000), then by M. Rieutord (16/2/2000)

! Input:
!     a = input image (size: nx,ny)
!     nx,ny input sizes
! OUTPUT:
!     the binary image 'ia'

!     parameters which could be adjusted: 
!       - nconv (size of the convolution)
!	- fac_open (size of the opening kernel)

        use param_run, only: convolution,nconv

	implicit none

	integer, parameter:: fac_open=2
        integer i,j,k,l,nconv2,n,nx,ny
        real*4, dimension (nx,ny) :: a 
        real*4, dimension (:,:), allocatable :: aconv 
	real*4 kern(nconv,nconv)
        real*4 s(fac_open,fac_open)
        real*4 c1,c2,c3,c4,d,sigma,r
	integer, dimension (nx,ny), intent(out) :: ia

! INITIALIZATION

      nconv2=nconv/2
      if (2*nconv2 == nconv) stop'nconv must be odd'
      if (convolution == 'Id') kern=1.
      if (convolution == 'Gaussian') then
!      kern=1.
!      kern = reshape(source=(/ &
!   1,  8, 15,  8, 1, &
!   8, 63,127, 63, 8, &
!  15,127,255,127,15, &
!   8, 63,127, 63, 8, &
!   1,  8, 15,  8, 1 /), shape=(/5,5/) )
        d=nconv2*sqrt(real(2))
        sigma=d/sqrt(log(255d0))

        do j=1,2*nconv2+1
         do i=1,2*nconv2+1
          r=sqrt(float(i-nconv2-1)**2+float(j-nconv2-1)**2)
          kern(i,j)=255d0*exp(-r**2/sigma**2)
         enddo
        enddo

      endif

      allocate(aconv(nx,ny)); aconv=0.



! CONVOLUTION


      do i=nconv2+1,nx-nconv2
         do j=nconv2+1,ny-nconv2

	    do k=1,nconv
	       do l=1,nconv
		  aconv(i+k-nconv2-1,j+l-nconv2-1)= &
                  aconv(i+k-nconv2-1,j+l-nconv2-1)+a(i,j)*kern(k,l)
               end do
            end do

         end do
      end do

! SEGMENTATION : RESEARCH OF NEGATIVE CURVATURE 

      k=0
      do j=2,ny-1
         do i=2,nx-1

            c1= aconv(i-1,j) - 2.*aconv(i,j) + aconv(i+1,j)
            c2= aconv(i,j-1) - 2.*aconv(i,j) + aconv(i,j+1)
            c3= aconv(i-1,j-1) - 2.*aconv(i,j) + aconv(i+1,j+1)
            c4= aconv(i-1,j+1) - 2.*aconv(i,j) + aconv(i+1,j-1)
!           research of negative curvatures = granules
            if (c1.lt.0.and.c2.lt.0.and.c3.lt.0.and.c4.lt.0) then 
!              k=k+1
!	       ix(k)=i ; iy(k)=j
	      ia(i,j)=4
            end if

         end do
      end do

!	n=k
      deallocate(aconv)

      end subroutine


!=================================================================
!=================================================================

      subroutine segmentlab(a,nx,ny,ngmax,ia)

!     Segmentation of granules using the curvatures in 4 directions
!     adapted from segmentons.pro (Thierry Roudier, 1998)
!     by Nadege Meunier (2000), then by M. Rieutord (16/2/2000)
!     then Th. Roudier (2/3/2011) 

! Input:
!     a = input image (size: nx,ny)
!     nx,ny input sizes
! OUTPUT:
!     the binary image 'ia'

!     parameters which could be adjusted: 
!       - nconv (size of the convolution)
!	- fac_open (size of the opening kernel)

        use param_run, only: convolution,nconv

	implicit none

        integer i,j,k,l,nconv2,n,nx,ny,ngmax

        character fichier3*100 !!!!!!!!!!!!!!

        real*4, dimension (nx,ny) :: a      
        real*4, dimension (:,:), allocatable :: aconv 
	double precision kern(nconv,nconv)
        real*4 c1,c2,c3,c4,c5,d,sigma,r
        real*4 egal(ngmax)
	real :: MAX
        real*4 diago, lambda_moins, lambda_plus
        integer, dimension (nx,ny), intent(out) :: ia
        integer, dimension (nx,ny) :: tempo
        integer xmoins,ymoins,m,epsilon,ii,num,kk,x,y, num_new
        integer :: H(ngmax),HGRAN(ngmax),BIN,gran,maxi


        xmoins=0 ; ymoins=0 ; m=0 ;epsilon= 0 
        ii=0 ; num= 0 ; kk=0 
        H=0 ; HGRAN=0 ; BIN=0 ; gran=0 ; maxi=0
        tempo=0
        ia=0 
 


! INITIALIZATION

      nconv2=nconv/2
      
      if (2*nconv2 == nconv) stop'nconv must be odd'
      if (convolution == 'Id') kern=1.
      if (convolution == 'Gaussian') then
  
        d=nconv2*sqrt(real(2))
        sigma=d/sqrt(log(255d0))

        do j=1,2*nconv2+1
         do i=1,2*nconv2+1
          r=sqrt(float(i-nconv2-1)**2+float(j-nconv2-1)**2)
          kern(i,j)=255d0*exp(-r**2/sigma**2)
         enddo
        enddo

      end if

      allocate(aconv(nx,ny)); aconv=0.

 a(:,1)=0.
 a(:,ny)=0.
 a(1,:)=0.
 a(nx,:)=0.

 
! CONVOLUTION
!      do i=nconv2+1,nx-nconv2
!         do j=nconv2+1,ny-nconv2
!	    do k=1,nconv
!	       do l=1,nconv
!		  aconv(i+k-nconv2-1,j+l-nconv2-1)= &
!                  aconv(i+k-nconv2-1,j+l-nconv2-1)+a(i,j)*kern(k,l)
!               end do
!            end do
!         end do
!      end do


! SEGMENTATION : RESEARCH OF NEGATIVE CURVATURE 


      do j=2,ny-1
         do i=2,nx-1
!            c1= aconv(i-1,j) - 2.*aconv(i,j) + aconv(i+1,j)
!            c2= aconv(i,j-1) - 2.*aconv(i,j) + aconv(i,j+1)
!            c3= aconv(i-1,j-1) - 2.*aconv(i,j) + aconv(i+1,j+1)
!            c4= aconv(i-1,j+1) - 2.*aconv(i,j) + aconv(i+1,j-1)
!            research of negative curvatures = granules Version Francois 7sept2015
!            c5=  (aconv(i+1,j+1) +aconv(i-1,j-1)-aconv(i-1,j+1)-aconv(i+1,j-1))/4.

!     equivalent pour nconv=1 on evite ainsi la convolution
            c1= a(i-1,j) - 2.*a(i,j) + a(i+1,j)
            c2= a(i,j-1) - 2.*a(i,j) + a(i,j+1)
            c3= a(i-1,j-1) - 2.*a(i,j) + a(i+1,j+1)
            c4= a(i-1,j+1) - 2.*a(i,j) + a(i+1,j-1)
!            research of negative curvatures = granules Version Francois 7sept2015
            c5=  (a(i+1,j+1) +a(i-1,j-1)-a(i-1,j+1)-a(i+1,j-1))/4.


!            research of negative curvatures = granules
!            if (c1.lt.0.and.c2.lt.0.and.c3.lt.0.and.c4.lt.0.) then 
!	      ia(i,j)=1.
!            end if

!            research of negative curvatures = granules Version Francois 7sept2015
            diago=sqrt((c1-c2)**2 /4. +(c5)**2) 
            lambda_moins = (c1+c2)/2. - diago
            lambda_plus  = (c1+c2)/2. + diago
            if (lambda_moins.lt.0.and.lambda_plus.lt.0) then 
	      ia(i,j)=1.
            end if

         end do
      end do
     
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! pour sauvegarder une image pour le controle
	  fichier3='results/image_cont'
          open(unit=4,file=fichier3,form='formatted')
           write(4,*) nx,ny
           write(4,*) ia(1:nx,1:ny)
          close(4)  
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!=================================================================


          
num_new=1
!mise à zero des bordures afin que l'etiquetage 
!fonctionne correctement


! premier passage

do y=2,ny
 do x=2,nx 

   xmoins=ia(x-1,y) 
   ymoins=ia(x,y-1)

 if(ia(x,y) .gt. 0) then 
  
  if (xmoins .eq. 0 .and. ymoins .eq. 0) then 
    ia(x,y)=num_new
    egal(num_new)=num_new
    num_new=num_new+1
  else 

   if (xmoins .eq. ymoins) then 
    ia(x,y)=xmoins
   else 
      
    if (ymoins .gt. xmoins) then  
     if(xmoins .gt. 0) then 
      epsilon=egal(xmoins)
     end if
     if(xmoins .eq. 0) then 
      epsilon=egal(ymoins)
     end if
    end if 

   if (ymoins .lt. xmoins) then  
     if(ymoins .gt. 0) then 
        epsilon=egal(ymoins)
     end if 
     if(ymoins .eq. 0) then 
      epsilon=egal(xmoins) 
     end if
   end if 

    ia(x,y)=epsilon

    if(xmoins .ne. 0) then      
     do while(egal(xmoins) .ne. epsilon) 
      m=egal(xmoins) 
      egal(xmoins)=epsilon
      xmoins=m
     end do
    end if
 
   if(ymoins .ne. 0) then 
    do while(egal(ymoins) .ne. epsilon) 
     m=egal(ymoins) 
     egal(ymoins)=epsilon
     ymoins=m
    end do
   end if
        
  end if
 end if
end if

 end do
end do 


do kk=1,ngmax
 if(egal(kk) .eq. 0) then 
    go to 9999
 end if

  m=kk
  do while(egal(m) .ne. m)      ! m+1)  
   m=egal(m)                    ! - 1
   egal(kk)=m                   ! +1
  end do
end do

9999 continue

do y=2.,ny 
 do x=2.,nx 
  if(ia(x,y) .gt. 0) then 
   ia(x,y)=egal(ia(x,y))
  end if
 end do
end do 


!goto 888


!on renumerote par ordre croissant sans trou.

!print*,'maxval(ia)=',maxval(ia)

max=maxval(ia)


H=0
BIN=0

! on fait l'histogramme
 
do y=1.,ny 
 do x=1.,nx 
  if(ia(x,y).gt.0) then
   BIN=INT(ia(x,y)) 
   H(BIN)=H(BIN)+1 
  end if
 end do
end do

!=========== ajout le 3 sept2015 ===================================
!on elimine les granules avec une aire inferieure a une aire donnee
! ici 1 pixel
! ici 3 pixels
! ici 7 pixel
! ici 10 pixel 
! ici 15 pixel
! ici 0 pixel on garde tout

!do ii=1,max
!if (H(ii).lt.2) then

! ici 3 pixels
!if (H(ii).lt.4) then  

! if (H(ii).lt.8) then
! if (H(ii).lt.11) then
! if (H(ii).lt.16) then
! if (H(ii).lt.0) then
!  H(ii)=0.
! endif
!enddo 
! on enleve les pixels non utiles

!do y=1.,ny 
! do x=1.,nx 
!  if(ia(x,y).gt.0) then
!   BIN=INT(ia(x,y))
!   if (H(bin).eq.0) then 
!     ia(x,y)=0.
!   end if
!  end if
! end do
!end do

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! pour sauvegarder une image pour le controle
!	  fichier3='results/image_cont'
!          open(unit=4,file=fichier3,form='formatted')
!           write(4,*) nx,ny
!           write(4,*) ia(1:nx,1:ny)
!          close(4)  
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!=========== ajout le 3 sept2015 ====================

! on renumerote
num=1

do ii=1,max
if (H(ii).gt.0) then  
  HGRAN(ii)=num 
  num=num+1   
 endif
enddo 

do y=1.,ny 
 do x=1.,nx     
  if(ia(x,y).gt.0) then
    gran= ia(x,y)
    tempo(x,y)=HGRAN(gran)
  endif
 end do
end do


ia=tempo
 
888   continue


maxi=maxval(ia)
!print*,'maxii out=',maxi


!=================================================================


      deallocate(aconv)

      end subroutine


!=================================================================
!       subroutine pour l'etiquetage seulement
!=================================================================

      subroutine label(a,nx,ny,ngmax,ia)
!      subroutine label_NR(a,nx,ny,ngmax,ia)

!     Segmentation of granules using the curvatures in 4 directions
!     adapted from segmentons.pro (Thierry Roudier, 1998)
!     by Nadege Meunier (2000), then by M. Rieutord (16/2/2000)
!     then Th. Roudier (2/3/2011) 

! Input:
!     xn,yn input sizes
! OUTPUT:
!     the binary image 'ia'

        

	implicit none

        integer i,j,k,l,n,nx,ny,ngmax
!        
        real*4, dimension (nx,ny) :: a   
! modif N. Renon
!        integer, dimension (nx,ny) :: a      

        real*4 egal(ngmax)
! modif N.Renon
!        integer egal(ngmax)
	real :: MAX
        integer, dimension (nx,ny), intent(out) :: ia
        integer, dimension (nx,ny) :: tempo
        integer xmoins,ymoins,m,epsilon,ii,num,kk,x,y, num_new
        integer :: H(ngmax),HGRAN(ngmax),BIN,gran,maxi
!       integer, dimension (nx,ny) :: a     
 

      xmoins=0 ; ymoins=0 ; m=0 ;epsilon= 0 
        ii=0 ; num= 0 ; kk=0 
        H=0 ; HGRAN=0 ; BIN=0 ; gran=0 ; maxi=0
        tempo=0
        ia=0 
!=================================================================

num_new=1

!mise à zero des bordures afin que l'etiquetage 
!fonctionne correctement

! Quand a était un simple precision
ia=int(a)
 !ia=a

 ia(:,1)=0.
 ia(:,ny)=0.
 ia(1,:)=0.
 ia(nx,:)=0.

! premier passage

do y=2,ny
 do x=2,nx 

   xmoins=ia(x-1,y) 
   ymoins=ia(x,y-1)

 if(ia(x,y) .gt. 0) then 
  
  if (xmoins .eq. 0 .and. ymoins .eq. 0) then 
    ia(x,y)=num_new
    egal(num_new)=num_new
    num_new=num_new+1
  else 

   if (xmoins .eq. ymoins) then 
    ia(x,y)=xmoins
   else 
      
    if (ymoins .gt. xmoins) then  
     if(xmoins .gt. 0) then 
      epsilon=egal(xmoins)
     end if
     if(xmoins .eq. 0) then 
      epsilon=egal(ymoins)
     end if
    end if 

   if (ymoins .lt. xmoins) then  
     if(ymoins .gt. 0) then 
        epsilon=egal(ymoins)
     end if 
     if(ymoins .eq. 0) then 
      epsilon=egal(xmoins) 
     end if
   end if 

    ia(x,y)=epsilon

    if(xmoins .ne. 0) then      
     do while(egal(xmoins) .ne. epsilon) 
      m=egal(xmoins) 
      egal(xmoins)=epsilon
      xmoins=m
     end do
    end if
 
   if(ymoins .ne. 0) then 
    do while(egal(ymoins) .ne. epsilon) 
     m=egal(ymoins) 
     egal(ymoins)=epsilon
     ymoins=m
    end do
   end if
        
  end if
 end if
end if

 end do
end do 


do kk=1,ngmax 
 if(egal(kk) .eq. 0) then 
    go to 9999
 end if

  m=kk
  do while(egal(m) .ne. m)      ! m+1)   
   m=egal(m)                    ! - 1
   egal(kk)=m                   ! +1
  end do
end do

9999 continue

do y=2.,ny 
 do x=2.,nx 
  if(ia(x,y) .gt. 0) then 
   ia(x,y)=egal(ia(x,y))
  end if
 end do
end do 


!on renumerote par ordre croissant sans trou.

max=maxval(ia)

H=0
BIN=0

! on fait l'histogramme
 
do y=1.,ny 
 do x=1.,nx 
  if(ia(x,y).gt.0) then
   BIN=INT(ia(x,y)) 
   H(BIN)=H(BIN)+1 
  end if
 end do
end do

! on renumerote
num=1


do ii=1,max
 if (H(ii).gt.0) then
  HGRAN(ii)=num 
  num=num+1   
 endif
enddo 

do y=1.,ny 
 do x=1.,nx     
  if(ia(x,y).gt.0) then
    gran= ia(x,y)
     tempo(x,y)=HGRAN(gran)
  endif
 end do
end do

ia=tempo
 
maxi=maxval(ia)
!!!print*,'maxii out=',maxi


      end subroutine


      end module
