!
! Module library implementing circular Queue routines.
! (c) 1992-2010, A. Migdalas @ MSCC
! version 0.1 @ 2010/12/05

MODULE IntCircQueue

!
! QUEUE must be implemented by client as Integer Array of
!       shape (1:n), able to hold n-1 nodes. (Actually, it can hold n
!       nodes the first time, but not after circulation has occured.
!
! FIRST is a cursor that keeps track of the Front of the Queue.
! LAST is a cursor that keeps track of the Rear of the Queue.
!      Both FIRST and LAST must be initialized to 0 by client to
!      denote empty Queue. Client is responsible for keeping 
!      them within bounds.

CONTAINS

  !
  ! Enqueues node, i.e. adds it to the rear of the Queue.
  ! If the queue array size has been exceeded, it tries
  ! to insert the node, circularly, to the front of the
  ! array. However, if the queue array is really full, it
  ! returns without error (but sets the Overflow flag).  
  ! Client is responsible to check for Queue overflow.
  !

  SUBROUTINE add_to_circqueue(node,queue,first,last,overflow)
    INTEGER, INTENT(IN) ::  node, first
    INTEGER, INTENT(INOUT) :: last, overflow
    INTEGER, INTENT(INOUT), DIMENSION(:) :: queue

    ! Could be implemented more elegantly using the remainder
    ! function MOD as in last = 1 + MOD( last , SIZE(queue) )
    ! but it is maybe less obvious (??)

    IF ( last == SIZE(queue) ) THEN ! Array size exceeded
       last = 1                     ! Start from the beginning
    ELSE                            ! Array size not exceeded
       last = last + 1              ! Increase to next free
    ENDIF
       
    IF ( first /= last ) THEN       ! Queue is not full
       queue(last) = node           ! Insert node
       overflow = 0                 ! Everything is OK       
    ELSE                            ! Queue is full
       overflow = -2                ! Overflow occurs
    ENDIF

  END SUBROUTINE add_to_circqueue

  !
  ! Dequeues front, i.e. deletes the front node from queue.
  ! If Queue is empty, it does nothing. Client is responsible
  ! to check  underflow for violations of Queue size. Can also
  ! be implemented using MOD.
  !

  SUBROUTINE delete_from_circqueue(first,last,queue,underflow)
    INTEGER, INTENT(INOUT) :: first
    INTEGER, INTENT(OUT) :: underflow
    INTEGER, INTENT(IN) :: last
    INTEGER, INTENT(IN), DIMENSION(:) :: queue

    IF ( first == last ) THEN          ! Queue is empty
       underflow = -1                  ! Underflow occurs
    ELSE                               ! Queue is not empty
       underflow = 0                   ! No underflow
       IF ( first == SIZE(queue) ) THEN! Size of queue array has 
          first = 1                    ! been exceeded. Start over.
       ELSE                            ! Has not been exceeded,
          first = first + 1            ! proceed as usual.
       ENDIF
    ENDIF

  END SUBROUTINE delete_from_circqueue

  !
  ! Selects the front element from queue without deleting it.
  ! If Queue is empty, it does nothing. Client is responsible
  ! to check  for violations of Queue size.
  !

  SUBROUTINE select_from_circqueue(node,queue,first,last,underflow)
    INTEGER, INTENT(IN) :: last,first
    INTEGER, INTENT(OUT) :: node, underflow
    INTEGER, INTENT(IN), DIMENSION(:) :: queue

    IF ( first == last ) THEN          ! Queue is empty
       underflow = -1                  ! Underflow occurs
    ELSE                               ! Queue is not empty
       underflow = 0                   ! No underflow
       IF ( first == SIZE(queue) ) THEN! Size of queue array has 
          node = queue( 1 )            ! been exceeded. Start over.
       ELSE                            ! Has not been exceeded,
          node = queue( first + 1 )    ! proceed as usual.
       ENDIF
    ENDIF

  END SUBROUTINE select_from_circqueue

  !
  ! Number of elements in Queue
  !

  FUNCTION cardinality_of_circqueue(first,last,queue) RESULT(card)
    INTEGER, INTENT(IN) :: last,first
    INTEGER, INTENT(IN), DIMENSION(:) :: queue
    INTEGER :: card

    card = last - first
    IF ( card < 0 ) card = SIZE(queue) + card 

  END FUNCTION cardinality_of_circqueue

  !
  ! Assign Queue elements to Array in FIFO order
  !
  
  FUNCTION queue2array(first,last,queue) RESULT(array)
    INTEGER, INTENT(IN) :: first, last
    INTEGER, INTENT(IN), DIMENSION(:) :: queue
    INTEGER, DIMENSION(SIZE(queue)) :: array
    INTEGER :: k
    
    IF ( last < first ) THEN
       k = SIZE(queue) - first
       array(1:k) = queue(first+1:first+k)
       array(k+1:k+last) = queue(1:last)
       array(k+last+1:SIZE(array)) = 0
    ELSE
       k = last - first 
       array(1:k) = queue(first+1:last)
       array(k+1:SIZE(array)) = 0
    ENDIF
  END FUNCTION queue2array

  !
  ! Check queue for overflow or underflow
  !

  FUNCTION queue_flag(first,last,queue) RESULT(flag)
    INTEGER, INTENT(IN) :: first, last
    INTEGER, INTENT(IN), DIMENSION(:) :: queue
    INTEGER :: flag

    IF ( first == last ) THEN          ! Queue is empty
       flag = -1                       ! Underflow occurs
    ELSEIF ( first == last + 1 ) THEN  ! Queue is full
       flag = -2                       ! Overflow *will* occur
    ELSE                               ! All OK
       flag = 0                        ! No over-/underflow
    ENDIF

  END FUNCTION queue_flag
    
    

END MODULE IntCircQueue

