!! $HeadURL: svn://forge.ipsl.fr/orchidee/trunk/ORCHIDEE/src_global/polygones.f90 $
!! $Date: 2023-07-04 15:51:03 +0200 (mar. 04 juil. 2023) $
!! $Revision: 8070 $
MODULE polygones
  !
  ! This module is there to handle polygones. It is an essential tool in interpolation methods.
  !
  USE defprec

  IMPLICIT NONE

  PRIVATE
  PUBLIC :: polygones_pointinside, polygones_extend, polygones_intersection, polygones_cleanup, &
       &    polygones_area, polygones_crossing, polygones_convexhull
  !
  REAL(r_std),PARAMETER                     :: zero=0.0
  !
CONTAINS
!
!=======================================================================================================
!
  SUBROUTINE polygones_pointinside(nvert_in, poly, point_x, point_y, inside)
    !
    ! Routine to determine of point (point_x, point_y) is inside of polygone poly
    ! Mathode based on docume http://www.ecse.rpi.edu/Homepages/wrf/Research/Short_Notes/pnpoly.html
    !
    ! Arguments
    INTEGER(i_std), INTENT(in)              :: nvert_in
    REAL(r_std), DIMENSION(:,:), INTENT(in) :: poly
    REAL(r_std), INTENT(in)                 :: point_x, point_y
    LOGICAL, INTENT(out)                    :: inside
    !
    ! Local
    INTEGER(i_std)                          :: i, j, nvert
    REAL(r_std)                             :: xonline
    !
    !
    inside = .FALSE.
    !
    nvert=SIZE(poly,DIM=1)
    IF ( nvert < nvert_in) THEN
       WRITE(*,*) "Input polygone is smaller than the size proposed in the interface."
       STOP "polygones_pointinside"
    ENDIF
    IF (SIZE(poly,DIM=2) .NE. 2) THEN
       WRITE(*,*) "This cannot be a polygone :", SIZE(poly)
       STOP "polygones_pointinside"
    ENDIF
    !
    j = nvert_in
    DO i=1,nvert_in
       IF ( (poly(i,2) > point_y) .NEQV. (poly(j,2) > point_y) ) THEN
          xonline = (poly(j,1)-poly(i,1))*(point_y-poly(i,2))/(poly(j,2)-poly(i,2))+poly(i,1)
          IF ( point_x < xonline ) THEN
             inside = (.NOT. inside)
          ENDIF
       ENDIF
       j = i
    ENDDO
    !
  END SUBROUTINE polygones_pointinside
!
!=======================================================================================================
!
  SUBROUTINE polygones_lineintersect(la, lb, intersection, point_x, point_y)
    !
    ! Simple alogorith tho determine the intersections of 2 lines.
    !
    ! ARGUMENTS
    REAL(r_std), DIMENSION(2,2), INTENT(in)    :: la, lb
    LOGICAL, INTENT(out)                       :: intersection
    REAL(r_std), INTENT(out)                   :: point_x, point_y
    !
    ! Local
    REAL(r_std)                                :: den, ua, ub
    REAL(r_std)                                :: x1, x2, x3, x4, y1, y2, y3, y4
    !
    intersection = .FALSE.
    !
     x1 = la(1,1)
     y1 = la(1,2)
     x2 = la(2,1)
     y2 = la(2,2)

     x3 = lb(1,1)
     y3 = lb(1,2)
     x4 = lb(2,1)
     y4 = lb(2,2)

     den = (y4-y3)*(x2-x1)-(x4-x3)*(y2-y1)

     IF ( ABS(den) > EPSILON(den) ) THEN
        ua = ((x4-x3)*(y1-y3)-(y4-y3)*(x1-x3))/den
        ub = ((x2-x1)*(y1-y3)-(y2-y1)*(x1-x3))/den
        IF ( ua >= 0 .AND. ua <= 1 .AND. ub >= 0 .AND. ub <= 1) THEN
           intersection = .TRUE.
           point_x = x1 + ua*(x2-x1)
           point_y = y1 + ua*(y2-y1)
        ENDIF
     ENDIF

  END SUBROUTINE polygones_lineintersect
!
!=======================================================================================================
!
  SUBROUTINE polygones_extend(nvert_in, poly_in, nbdots, nvert_out, poly_out)
    !
    ! This function simply add nbdots onto each side of the polygone.
    !
    ! Arguments
    INTEGER(i_std), INTENT(in)               :: nvert_in
    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_in
    INTEGER(i_std), INTENT(in)               :: nbdots
    INTEGER(i_std), INTENT(out)              :: nvert_out
    REAL(r_std), DIMENSION(:,:), INTENT(out) :: poly_out
    !
    ! Local
    !
    INTEGER(i_std)                        :: nvert, nvert_tmp, i, j, id, ipos
    REAL(r_std)                           :: xs, xe, ys, ye
    !
    nvert=SIZE(poly_in,DIM=1)
    IF ( nvert < nvert_in ) THEN
       WRITE(*,*) "Input polygone is smaller than the size proposed in the interface."
       STOP "polygones_extend"
    ENDIF
    IF (SIZE(poly_in,DIM=2) .NE. 2) THEN
       WRITE(*,*) "Poly_in cannot be a polygone :", SIZE(poly_in)
       STOP "polygones_extend"
    ENDIF
    nvert_tmp=SIZE(poly_out,DIM=1)
    IF (SIZE(poly_out,DIM=2) .NE. 2) THEN
       WRITE(*,*) "Poly_out cannot be a polygone :", SIZE(poly_out)
       STOP "polygones_extend"
    ENDIF
    !
    IF ( nvert_tmp < nvert_in*nbdots) THEN
       WRITE(*,*) "Poly_out is too small for extending it :", SIZE(poly_out), " we would need :", nvert_in*nbdots
       STOP "polygones_extend"
    ENDIF
    nvert_out = nvert_in*nbdots
    !
    j = nvert_in
    ipos = 0
    DO i=1,nvert_in
       xs = poly_in(j,1)
       xe = poly_in(i,1)
       ys = poly_in(j,2)
       ye = poly_in(i,2)
       IF (xs == xe ) THEN 
          DO id=1,nbdots 
             ipos = ipos + 1
             poly_out(ipos,1) = xs
             poly_out(ipos,2) = ys + (id-1)*(ye-ys)/nbdots
          ENDDO
       ELSE IF (ys == ye ) THEN
          DO id=1,nbdots
             ipos = ipos + 1
             poly_out(ipos,1) = xs + (id-1)*(xe-xs)/nbdots
             poly_out(ipos,2) = ys
          ENDDO
       ELSE
          DO id=1,nbdots
             ipos = ipos + 1
             poly_out(ipos,2) = ys + (id-1)*(ye-ys)/nbdots
             poly_out(ipos,1) = (xs-xe)*(poly_out(ipos,2)-ye)/(ys-ye)+xe
          ENDDO
       ENDIF
       j = i
    ENDDO
    !
  END SUBROUTINE polygones_extend
!
!=======================================================================================================
!
  SUBROUTINE polygones_intersection(nvert_a, poly_a, nvert_b, poly_b, nbpts, poly_out)
    !
    ! Find the polygon resulting from the intersection of poly_a and poly_b
    !
    ! Arguments
    INTEGER(i_std), INTENT(in)               :: nvert_a
    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_a
    INTEGER(i_std), INTENT(in)               :: nvert_b
    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_b
    INTEGER(i_std), INTENT(out)              :: nbpts
    REAL(r_std), DIMENSION(:,:), INTENT(out) :: poly_out
    !
    ! Local
    INTEGER(i_std)                            :: nvert_tmpa, nvert_tmpb, nvert_out, i, j
    LOGICAL                                   :: inside
    INTEGER(i_std)                            :: in_a, in_b
    INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: ptin_a, ptin_b
    !
    nvert_tmpa=SIZE(poly_a,DIM=1)
    IF ( nvert_tmpa < nvert_a) THEN
       WRITE(*,*) "Input polygone (poly_a) is smaller than the size proposed in the interface."
       STOP "polygones_intersection"
    ENDIF
    IF (SIZE(poly_a,DIM=2) .NE. 2) THEN
       WRITE(*,*) "Poly_a cannot be a polygone :", SIZE(poly_a)
       STOP "polygones_intersection"
    ENDIF
    ALLOCATE(ptin_a(nvert_a))
    nvert_tmpb=SIZE(poly_b,DIM=1)
    IF ( nvert_tmpb < nvert_a) THEN
       WRITE(*,*) "Input polygone (poly_b) is smaller than the size proposed in the interface."
       STOP "polygones_intersection"
    ENDIF
    IF (SIZE(poly_b,DIM=2) .NE. 2) THEN
       WRITE(*,*) "Poly_b cannot be a polygone :", SIZE(poly_b)
       STOP "polygones_intersection"
    ENDIF
    ALLOCATE(ptin_b(nvert_b))
    !
    !
    in_a = 0
    DO i=1,nvert_a
       CALL polygones_pointinside(nvert_b, poly_b, poly_a(i,1), poly_a(i,2), inside)
       IF ( inside ) THEN
          in_a = in_a + 1
          ptin_a(in_a) = i
       ENDIF
    ENDDO
    !
    in_b = 0
    DO i=1,nvert_b
       CALL polygones_pointinside(nvert_a, poly_a, poly_b(i,1), poly_b(i,2), inside)
       IF ( inside ) THEN
          in_b = in_b + 1
          ptin_b(in_b) = i
       ENDIF
    ENDDO
    !
    nbpts = in_a + in_b
    !
    nvert_out=SIZE(poly_out,DIM=1)
    IF (SIZE(poly_out,DIM=2) .NE. 2) THEN
       WRITE(*,*) "Poly_out cannot be a polygone :", SIZE(poly_out)
       STOP "polygones_intersection"
    ENDIF
    IF ( nbpts <= nvert_out ) THEN
       i = 0
       DO j=1,in_a
          i = i+1
          poly_out(i,:) = poly_a(ptin_a(j),:)
       ENDDO
       DO j=1,in_b
          i = i+1
          poly_out(i,:) = poly_b(ptin_b(j),:)
       ENDDO
    ELSE
       WRITE(*,*) "The intersection polygone has", nbpts, "points and that is more than available in poly_out", SIZE(poly_out)
       STOP "polygones_intersection"
    ENDIF
    !
    DEALLOCATE(ptin_a, ptin_b)
    !
  END SUBROUTINE polygones_intersection
!
!=======================================================================================================
!
  SUBROUTINE polygones_cleanup(nvert_in, poly_in, nvert_out, poly_out)
    !
    ! Clean_up the polygone by deleting points which are redundant and ordering based 
    ! on the proximity of the points. Beware this does not give a convex hull to the surface
    ! inside the polygone.
    !
    ! Arguments
    INTEGER(i_std), INTENT(in)               :: nvert_in
    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_in
    INTEGER(i_std), INTENT(out)              :: nvert_out
    REAL(r_std), DIMENSION(:,:), INTENT(out) :: poly_out
    !
    ! Local
    !
    INTEGER(i_std)                           :: nvert, nvert_tmpin, nvert_tmp
    INTEGER(i_std)                           :: i, j
    INTEGER(i_std), DIMENSION(1)             :: ismin
    REAL(r_std), ALLOCATABLE, DIMENSION(:)   :: dist
    REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: poly_tmp
    !
    nvert_tmpin=SIZE(poly_in,DIM=1)
    IF ( nvert_tmpin < nvert_in ) THEN
       WRITE(*,*) "Input polygone is smaller than the size proposed in the interface."
       STOP "polygones_cleanup"
    ENDIF
    IF (SIZE(poly_in,DIM=2) .NE. 2) THEN
       WRITE(*,*) "Poly_in cannot be a polygone :", SIZE(poly_in)
       STOP "polygones_cleanup"
    ENDIF
    nvert_tmp=SIZE(poly_out,DIM=1)
    IF (SIZE(poly_out,DIM=2) .NE. 2) THEN
       WRITE(*,*) "Poly_out cannot be a polygone :", SIZE(poly_out)
       STOP "polygones_cleanup"
    ENDIF
    !
    ALLOCATE(poly_tmp(nvert_in,2))
    ALLOCATE(dist(nvert_in))
    !
    nvert = nvert_in-1
    poly_tmp(1:nvert,:) = poly_in(2:nvert_in,:)
    poly_out(1,:) = poly_in(1,:)
    nvert_out = 1
    !
    DO WHILE ( nvert > 0 ) 
       !
       DO j=1,nvert
          dist(j) = SQRT((poly_out(nvert_out,1)-poly_tmp(j,1))**2+(poly_out(nvert_out,2)-poly_tmp(j,2))**2)
       ENDDO
       !
       ismin = MINLOC(dist(1:nvert))
       !
       IF ( dist(ismin(1)) > EPSILON(dist(1)) ) THEN
          !
          ! The smallest distance between 2 vertices is larger than zero :
          ! Add the vertex to poly_out and delete it from poly_tmp
          !
          nvert_out = nvert_out + 1
          IF ( nvert_out > nvert_tmp) THEN
             WRITE(*,*) "Output polygone too small"
             STOP "polygones_cleanup"
          ENDIF
          poly_out(nvert_out,:) = poly_tmp(ismin(1),:)
          poly_tmp(ismin(1):nvert-1,:) = poly_tmp(ismin(1)+1:nvert,:)
       ELSE
          !
          ! Else the vertex already exists in poly_out and thus we just need
          ! to delete it from poly_tmp
          !
          poly_tmp(ismin(1):nvert-1,:) = poly_tmp(ismin(1)+1:nvert,:)
       ENDIF
       !
       ! One less vertices exists in poly_tmp
       !
       nvert = nvert-1
       !
    ENDDO

    DEALLOCATE(poly_tmp, dist)

  END SUBROUTINE polygones_cleanup
!
!=======================================================================================================
!
  SUBROUTINE polygones_area(nvert_in, poly_in, dx, dy, area)
    !
    ! Find the polygon resulting from the intersection of poly_a and poly_b
    !
    ! Arguments
    INTEGER(i_std), INTENT(in)               :: nvert_in
    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_in
    REAL(r_std), INTENT(in)                  :: dx, dy
    REAL(r_std), INTENT(out)                 :: area
    !
    ! Local
    !
    INTEGER(i_std)     :: nvert, i, j
    !
    nvert = SIZE(poly_in,DIM=1)
    IF ( nvert < nvert_in) THEN
       WRITE(*,*) "Input polygone is smaller than the size proposed in the interface."
       STOP "polygones_area"
    ENDIF
    IF (SIZE(poly_in,DIM=2) .NE. 2) THEN
       WRITE(*,*) "Poly_in cannot be a polygone :", SIZE(poly_in)
       STOP "polygones_area"
    ENDIF
    !
    area = zero
    j = nvert_in
    DO i=1,nvert_in
!!       area = area + (dy*(poly_in(j,2)+poly_in(i,2))/2.0)*(dx*(poly_in(j,1)-poly_in(i,1)))
       area = area + dy*dx/2.0*(poly_in(j,2)+poly_in(i,2))*(poly_in(j,1)-poly_in(i,1))
       j = i
    ENDDO
    !
    area = ABS(area)
    !
  END SUBROUTINE polygones_area
!
!=======================================================================================================
!
  SUBROUTINE polygones_crossing(nvert_a, poly_a, nvert_b, poly_b, nbpts, crossings)
    !
    ! Find the polygon resulting from the intersection of poly_a and poly_b
    !
    ! Arguments
    INTEGER(i_std), INTENT(in)               :: nvert_a
    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_a
    INTEGER(i_std), INTENT(in)               :: nvert_b
    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_b
    INTEGER(i_std), INTENT(out)              :: nbpts
    REAL(r_std), DIMENSION(:,:), INTENT(out) :: crossings
    !
    ! Local
    !
    INTEGER(i_std)                            :: nvert, ia, ja, ib, jb
    REAL(r_std), DIMENSION(2,2)               :: la, lb
    REAL(r_std)                               :: x, y
    LOGICAL                                   :: intersect
    !
    nvert=SIZE(poly_a,DIM=1)
    IF ( nvert < nvert_a) THEN
       WRITE(*,*) "Input polygone (poly_a) is smaller than the size proposed in the interface."
       STOP "polygones_crossing"
    ENDIF
    IF (SIZE(poly_a,DIM=2) .NE. 2) THEN
       WRITE(*,*) "Poly_a cannot be a polygone :", SIZE(poly_a)
       STOP "polygones_crossing"
    ENDIF
    nvert=SIZE(poly_b,DIM=1)
    IF ( nvert < nvert_b) THEN
       WRITE(*,*) "Input polygone (poly_b) is smaller than the size proposed in the interface."
       STOP "polygones_crossing"
    ENDIF
    IF (SIZE(poly_b,DIM=2) .NE. 2) THEN
       WRITE(*,*) "Poly_b cannot be a polygone :", SIZE(poly_b)
       STOP "polygones_crossing"
    ENDIF
    nvert=SIZE(crossings,DIM=1)
    IF (SIZE(crossings,DIM=2) .NE. 2) THEN
       WRITE(*,*) "Poly_a cannot be a polygone :", SIZE(poly_a)
       STOP "polygones_crossing"
    ENDIF
    !
    nbpts = 0
    !
    ja = nvert_a
    DO ia=1,nvert_a
       !
       ! Put one side of the polygone a into la
       !
       la(1,1) = poly_a(ja,1)
       la(1,2) = poly_a(ja,2)
       la(2,1) = poly_a(ia,1)
       la(2,2) = poly_a(ia,2)
       !
       jb = nvert_b
       DO ib=1,nvert_b
          !
          ! Put one side of the polygone b into lb
          !
          lb(1,1) = poly_b(jb,1)
          lb(1,2) = poly_b(jb,2)
          lb(2,1) = poly_b(ib,1)
          lb(2,2) = poly_b(ib,2)
          !
          CALL polygones_lineintersect(la, lb, intersect, x, y)
          !
          IF ( intersect ) THEN
             nbpts = nbpts + 1
             IF ( nbpts <= nvert ) THEN
                crossings(nbpts, 1) = x
                crossings(nbpts, 2) = y
             ELSE
                WRITE(*,*) "Polygone to write the intersection points is too small", nvert, nbpts
                STOP "polygones_crossing"
             ENDIF
          ENDIF
          !
          jb = ib
       ENDDO
       ja = ia
    ENDDO
    !

  END SUBROUTINE polygones_crossing
!
!=======================================================================================================
!
  SUBROUTINE polygones_convexhull(nvert_in, poly_in, nvert_out, poly_out)
    !
    ! Routine orders points in poly_in so that they form a convex shape. This is based on the Graham scan
    ! algorith as implemented by Alan Miller : http://jblevins.org/mirror/amiller/
    !
    ! The output polygone can be smaller than the input one as we are computing the convex envelope.
    !
    ! Arguments
    INTEGER(i_std), INTENT(in)               :: nvert_in
    REAL(r_std), DIMENSION(:,:), INTENT(in)  :: poly_in
    INTEGER(i_std), INTENT(out)              :: nvert_out
    REAL(r_std), DIMENSION(:,:), INTENT(out) :: poly_out
    !
    ! Local
    !
    INTEGER(i_std)                           :: nvert, nvert_tmp
    INTEGER(i_std), ALLOCATABLE, DIMENSION(:):: iwk, next, vertex
    REAL(r_std)                              :: xmin, temp, dy, dx2, dy1, dy2
    REAL(r_std)                              :: x1, x2, y1, y2
    REAL(r_std)                              :: xmax, ymin, ymax
    REAL(r_std)                              :: dx, dx1
    REAL(r_std)                              :: dmax, dmax1, dmax2
    REAL(r_std)                              :: dist, dmin
    INTEGER(i_std)                           :: i, i1, i2, j, jp1, jp2, i2save, i3, i2next
    LOGICAL                                  :: points_todo
    INTEGER(i_std), PARAMETER                :: nextinc=20
    !
    nvert_tmp=SIZE(poly_in,DIM=1)
    IF ( nvert_tmp < nvert_in) THEN
       WRITE(*,*) "Input polygone is smaller than the size proposed in the interface."
       STOP "polygones_convexhull"
    ENDIF
    IF ( nvert_tmp <= 2 ) THEN
       WRITE(*,*) "The input polygone is too small to compute a convex hull."
       STOP "polygones_convexhull"
    ENDIF
    IF (SIZE(poly_in,DIM=2) .NE. 2) THEN
       WRITE(*,*) "Poly_a cannot be a polygone :", SIZE(poly_in)
       STOP "polygones_convexhull"
    ENDIF
    IF (SIZE(poly_out,DIM=2) .NE. 2) THEN
       WRITE(*,*) "Poly_b cannot be a polygone :", SIZE(poly_out)
       STOP "polygones_convexhull"
    ENDIF
    !
    ALLOCATE(vertex(nvert_in))
    ALLOCATE(iwk(nvert_in))
    ALLOCATE(next(nvert_in*nextinc))
    !
    !
    !  Choose the points with smallest & largest x- values as the
    !  first two vertices of the polygon.
    !
    IF (poly_in(1,1) > poly_in(nvert_in,1)) THEN
       vertex(1) = nvert_in
       vertex(2) = 1
       xmin = poly_in(nvert_in,1)
       xmax = poly_in(1,1)
    ELSE
       vertex(1) = 1
       vertex(2) = nvert_in
       xmin = poly_in(1,1)
       xmax = poly_in(nvert_in,1)
    END IF
    
    DO i = 2, nvert_in-1
       temp = poly_in(i,1)
       IF (temp < xmin) THEN
          vertex(1) = i
          xmin = temp
       ELSE IF (temp > xmax) THEN
          vertex(2) = i
          xmax = temp
       END IF
    END DO
    !
    !       Special case, xmax = xmin.
    !
    IF (xmax == xmin) THEN
       IF (poly_in(1,2) > poly_in(nvert_in,2)) THEN
          vertex(1) = nvert_in
          vertex(2) = 1
          ymin = poly_in(nvert_in,2)
          ymax = poly_in(1,2)
       ELSE
          vertex(1) = 1
          vertex(2) = nvert_in
          ymin = poly_in(1,2)
          ymax = poly_in(nvert_in,2)
       END IF
       
       DO i = 2, nvert_in-1
          temp = poly_in(i,2)
          IF (temp < ymin) THEN
             vertex(1) = i
             ymin = temp
          ELSE IF (temp > ymax) THEN
             vertex(2) = i
             ymax = temp
          END IF
       END DO
       
       nvert = 2
       IF (ymax == ymin) nvert = 1
       RETURN
    END IF
    !
    !  Set up two initial lists of points; those points above & those below the
    !  line joining the first two vertices.    next(i) will hold the pointer to the
    !  point furthest from the line joining vertex(i) to vertex(i+1) on the left
    !  hand side.
    !
    i1 = vertex(1)
    i2 = vertex(2)
    iwk(i1) = -1
    iwk(i2) = -1
    dx = xmax - xmin
    y1 = poly_in(i1,2)
    dy = poly_in(i2,2) - y1
    dmax = zero
    dmin = zero
    next(1) = -1
    next(2) = -1
    !
    DO i = 1, nvert_in
       IF (i == vertex(1) .OR. i == vertex(2)) CYCLE
       dist = (poly_in(i,2) - y1)*dx - (poly_in(i,1) - xmin)*dy
       IF (dist > zero) THEN
          iwk(i1) = i
          i1 = i
          IF (dist > dmax) THEN
             next(1) = i
             dmax = dist
          END IF
       ELSE IF (dist < zero) THEN
          iwk(i2) = i
          i2 = i
          IF (dist < dmin) THEN
             next(2) = i
             dmin = dist
          END IF
       END IF
    END DO
    !
    !  Ends of lists are indicated by pointers to -ve positions.
    !
    iwk(i1) = -1
    iwk(i2) = -1
    nvert = 2
    !
    j = 1
    !
    !  Start of main process.
    !
    !  Introduce new vertex between vertices j & j+1, if one has been found.
    !  Otherwise increase j.   Exit if no more vertices.
    !
    !
    points_todo = .TRUE.
    DO WHILE ( points_todo )
       !
       DO WHILE ( points_todo .AND. next(j) < 0 )
          IF (j == nvert) points_todo = .FALSE.
          j = j + 1
       ENDDO
          !
       IF ( points_todo ) THEN
          !
          jp1 = j + 1
          IF ( jp1 >= nvert_in*nextinc) THEN
             STOP "polygones_convexhull : please increase nextinc"
          ENDIF
          !
          DO i = nvert, jp1, -1
             vertex(i+1) = vertex(i)
             next(i+1) = next(i)
          END DO
          jp2 = jp1 + 1
          nvert = nvert + 1
          IF (jp2 > nvert) jp2 = 1
          i1 = vertex(j)
          i2 = next(j)
          i3 = vertex(jp2)
          vertex(jp1) = i2
          !
          !  Process the list of points associated with vertex j.   New list at vertex j
          !  consists of those points to the left of the line joining it to the new
          !  vertex (j+1).   Similarly for the list at the new vertex.
          !  Points on or to the right of these lines are dropped.
          !
          x1 = poly_in(i1,1)
          x2 = poly_in(i2,1)
          y1 = poly_in(i1,2)
          y2 = poly_in(i2,2)
          !
          dx1 = x2 - x1
          dx2 = poly_in(i3,1) - x2
          dy1 = y2 - y1
          dy2 = poly_in(i3,2) - y2
          dmax1 = zero
          dmax2 = zero
          next(j) = -1
          next(jp1) = -1
          i2save = i2
          i2next = iwk(i2)
          i = iwk(i1)
          iwk(i1) = -1
          iwk(i2) = -1
          !
          DO WHILE ( i > 0 )
             IF (i /= i2save) THEN
                dist = (poly_in(i,2) - y1)*dx1 - (poly_in(i,1) - x1)*dy1
                IF (dist > zero) THEN
                   iwk(i1) = i
                   i1 = i
                   IF (dist > DMAX1) THEN
                      next(j) = i
                      dmax1 = dist
                   END IF
                ELSE
                   dist = (poly_in(i,2) - y2)*dx2 - (poly_in(i,1) - x2)*dy2
                   IF (dist > zero) THEN
                      iwk(i2) = i
                      i2 = i
                      IF (dist > dmax2) THEN
                         next(jp1) = i
                         dmax2 = dist
                      END IF
                   END IF
                END IF
                i = iwk(i)
             ELSE
                i = i2next
             END IF
             !
             !  Get next point from old list at vertex j.
             !
          ENDDO
          !
          !  End lists with -ve values.
          !
          iwk(i1) = -1
          iwk(i2) = -1
          !
       ENDIF
    ENDDO
    !
    ! Copy the polygone in he right order to the output variable
    !
    nvert_out = nvert
    nvert_tmp=SIZE(poly_out,DIM=1)
    IF ( nvert_tmp < nvert_out) THEN
       WRITE(*,*) "Ouptput polygone is smaller than the size proposed in the interface."
       STOP "polygones_convexhull"
    ENDIF
    !
    DO i=1,nvert
       poly_out(i,:) = poly_in(vertex(i),:)
    ENDDO
    !
    DEALLOCATE(vertex, iwk, next)
    !
  END SUBROUTINE polygones_convexhull

END MODULE polygones
