ORDER Subroutine

private subroutine ORDER(NV3, NS3)

Arguments

Type	Intent	Optional	Attributes		Name
integer,	intent(in)			::	NV3
integer,	intent(in)			::	NS3
Called By

Help
Source Code

ORDER
Source Code

SUBROUTINE ORDER(NV3,NS3)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Legacy Code
          !       DATE WRITTEN
          !       MODIFIED       na
          !       RE-ENGINEERED  Lawrie, Oct 2000

          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine sorts the vertices found by inclosure and
          ! intercept in to clockwise order so that the overlap polygon
          ! may be used in computing subsequent overlaps.

          ! METHODOLOGY EMPLOYED:
          ! The slopes of the lines from the left-most vertex to all
          ! others are found.  The slopes are sorted into descending
          ! sequence.  This sequence puts the vertices in clockwise order.

          ! REFERENCES:
          ! BLAST/IBLAST code, original author George Walton

          ! USE STATEMENTS:
          ! na

  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine

          ! SUBROUTINE ARGUMENT DEFINITIONS:
  INTEGER, INTENT(IN) :: NV3  ! Number of vertices of figure NS3
  INTEGER, INTENT(IN) :: NS3  ! Location to place results of overlap

          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na

          ! INTERFACE BLOCK SPECIFICATIONS
          ! na

          ! DERIVED TYPE DEFINITIONS
          ! na

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  REAL(r64), ALLOCATABLE, SAVE, DIMENSION(:) :: SLOPE  ! Slopes from left-most vertex to others
  REAL(r64) DELTAX ! Difference between X coordinates of two vertices
  REAL(r64) DELTAY ! Difference between Y coordinates of two vertices
  REAL(r64) SAVES  ! Temporary location for exchange of variables
  REAL(r64) SAVEX  ! Temporary location for exchange of variables
  REAL(r64) SAVEY  ! Temporary location for exchange of variables
  REAL(r64) XMIN   ! X coordinate of left-most vertex
  REAL(r64) YXMIN  !
  INTEGER I      ! Sort index
  INTEGER IM1    ! Sort control
  INTEGER J      ! Sort index
  INTEGER M      ! Number of slopes to be sorted
  INTEGER N      ! Vertex number
  INTEGER P      ! Location of first slope to be sorted
  LOGICAL, SAVE :: FirstTimeFlag=.true.

  IF (FirstTimeFlag) THEN
    ALLOCATE(SLOPE(MAX(10,MaxVerticesPerSurface+1)))
    FirstTimeFlag=.false.
  ENDIF
          ! Determine left-most vertex.

  XMIN  = XTEMP(1)
  YXMIN = YTEMP(1)
  DO N = 2, NV3
    IF (XTEMP(N) >= XMIN) CYCLE
    XMIN  = XTEMP(N)
    YXMIN = YTEMP(N)
  END DO

          ! Determine slopes from left-most vertex to all others.  Identify
          ! first and second or last points as they occur.

  P = 1
  M = 0
  DO N = 1, NV3

    DELTAX = XTEMP(N) - XMIN
    DELTAY = YTEMP(N) - YXMIN

    IF (ABS(DELTAX) > 0.5d0) THEN

      M        = M + 1
      SLOPE(M) = DELTAY/DELTAX
      XTEMP(M) = XTEMP(N)
      YTEMP(M) = YTEMP(N)

    ELSEIF (DELTAY > 0.5d0) THEN

      P          = 2
      HCX(2,NS3) = NINT(XTEMP(N),i64)
      HCY(2,NS3) = NINT(YTEMP(N),i64)

    ELSEIF (DELTAY < -0.5d0) THEN

      HCX(NV3,NS3) = NINT(XTEMP(N),i64)
      HCY(NV3,NS3) = NINT(YTEMP(N),i64)

    ELSE

      HCX(1,NS3) = NINT(XMIN,i64)
      HCY(1,NS3) = NINT(YXMIN,i64)

    END IF

  END DO

  ! Sequence the temporary arrays in order of decreasing slopes.(bubble sort)

  IF (M /= 1) THEN

    DO I = 2, M
      IM1 = I - 1
      DO J = 1, IM1
        IF (SLOPE(I) <= SLOPE(J)) CYCLE
        SAVEX    = XTEMP(I)
        SAVEY    = YTEMP(I)
        SAVES    = SLOPE(I)
        XTEMP(I) = XTEMP(J)
        YTEMP(I) = YTEMP(J)
        SLOPE(I) = SLOPE(J)
        XTEMP(J) = SAVEX
        YTEMP(J) = SAVEY
        SLOPE(J) = SAVES
      END DO
    END DO

  END IF

          ! Place sequenced points in the homogeneous coordinate arrays.

  DO N = 1, M
    HCX(N+P,NS3)=NINT(XTEMP(N),i64)
    HCY(N+P,NS3)=NINT(YTEMP(N),i64)
  END DO

  RETURN

END SUBROUTINE ORDER
All Procedures
