! ! Module library implementing Stack routines ! (c) 1992-2010, A. Migdalas @ MSCC ! version 0.7 @ 2009/08/07 MODULE IntStack ! ! STACK must be implemented by client as Integer Array. ! Client is responsible for checking the array bounds. ! LAST is a cursor that keeps track of the Top of the Stack. ! It must be initialized by client to 0 to denote empty ! Stack. Client is responsible for keeping it within bounds. ! At any time LAST gives the cardinality of the Stack. At ! any time STACK(1:LAST) provides LIFO order. ! CONTAINS ! ! Pushes Node into the Stack, if there is ! available space. If not it just returns, ! without error. Client is responsible to ! check for Stack over-/underflow (Procedures ! return silently) ! SUBROUTINE add_to_stack(node,stack,last,overflow) INTEGER, INTENT(IN) :: node INTEGER, INTENT(INOUT) :: last, overflow INTEGER, INTENT(INOUT), DIMENSION(:) :: stack IF ( last < SIZE(stack) ) THEN ! Array not size exceeded last = last + 1 ! Move to the next position stack(last) = node ! Store Node overflow = 0 ! All is OK ELSE ! Array size will be exceeded overflow = -2 ! Inform of Overflow END IF END SUBROUTINE add_to_stack ! ! Deletes the top element of the Stack. ! If stack is empty, it does nothing. ! Client is responsible to check for ! Stack underflow. ! SUBROUTINE delete_from_stack(last,underflow) INTEGER, INTENT(INOUT) :: last, underflow IF ( last > 0 ) THEN ! Lower bound 1 last = last - 1 ! has not been underflow = 0 ! violated ELSE ! Lower bound is underflow = -1 ! violated, warn ENDIF END SUBROUTINE delete_from_stack ! ! Selects the top element of the Stack ! without deleting it. If cursor Last is ! out of bounds does nothing. Client is ! responsible to perform over- and underflow ! checks. ! SUBROUTINE select_from_stack(node,stack,last,flag) INTEGER :: node,last, flag INTEGER, DIMENSION(:) :: stack IF ( last > 0 .AND. last <= SIZE(stack) ) THEN ! Within bounds node = stack(last) ! Read element flag = 0 ! All OK ELSE ! Bounds violated flag = -3 ! Warn ENDIF END SUBROUTINE select_from_stack ! Stack condition FUNCTION stack_flag(stack,last) RESULT(flag) INTEGER :: last, flag INTEGER, DIMENSION(:) :: stack IF ( last > 0 .AND. last <= SIZE(stack) ) THEN ! Within bounds flag = 0 ! All OK ELSE ! Bounds violated flag = -3 ! Warn ENDIF END FUNCTION stack_flag END MODULE IntStack