1module m_elstack 2 3use m_buffer 4 5private 6 7! 8! Simple stack to keep track of which elements have appeared so far 9! 10integer, parameter, private :: STACK_SIZE = 40 11 12type, public :: elstack_t 13private 14 integer :: n_items 15 type(buffer_t), dimension(STACK_SIZE) :: data 16end type elstack_t 17 18public :: push_elstack, pop_elstack, reset_elstack, print_elstack 19public :: init_elstack 20public :: get_top_elstack, is_empty, get_elstack_signature 21 22interface is_empty 23 module procedure is_empty_elstack 24end interface 25private :: is_empty_elstack 26 27CONTAINS 28 29!----------------------------------------------------------------- 30subroutine init_elstack(elstack) 31type(elstack_t), intent(inout) :: elstack 32 33integer :: i 34 35elstack%n_items = 0 36do i = 1, STACK_SIZE ! to avoid "undefined status" 37 call init_buffer(elstack%data(i)) 38enddo 39end subroutine init_elstack 40 41!----------------------------------------------------------------- 42subroutine reset_elstack(elstack) 43type(elstack_t), intent(inout) :: elstack 44 45integer :: i 46 47elstack%n_items = 0 48do i = 1, STACK_SIZE 49 call reset_buffer(elstack%data(i)) 50enddo 51end subroutine reset_elstack 52 53!----------------------------------------------------------------- 54function is_empty_elstack(elstack) result(answer) 55type(elstack_t), intent(in) :: elstack 56logical :: answer 57 58answer = (elstack%n_items == 0) 59end function is_empty_elstack 60 61!----------------------------------------------------------------- 62subroutine push_elstack(item,elstack) 63type(buffer_t), intent(in) :: item 64type(elstack_t), intent(inout) :: elstack 65 66integer :: n 67 68n = elstack%n_items 69if (n == STACK_SIZE) then 70 stop "*Element stack full" 71endif 72n = n + 1 73elstack%data(n) = item 74elstack%n_items = n 75 76end subroutine push_elstack 77 78!----------------------------------------------------------------- 79subroutine pop_elstack(elstack,item) 80type(elstack_t), intent(inout) :: elstack 81type(buffer_t), intent(out) :: item 82 83! 84! We assume the elstack is not empty... (the user has called is_empty first) 85! 86integer :: n 87 88n = elstack%n_items 89if (n == 0) then 90 stop "*********Element stack empty" 91endif 92item = elstack%data(n) 93elstack%n_items = n - 1 94 95end subroutine pop_elstack 96 97!----------------------------------------------------------------- 98subroutine get_top_elstack(elstack,item) 99! 100! Get the top element of the stack, *without popping it*. 101! 102type(elstack_t), intent(in) :: elstack 103type(buffer_t), intent(out) :: item 104 105! 106! We assume the elstack is not empty... (the user has called is_empty first) 107! 108integer :: n 109 110n = elstack%n_items 111if (n == 0) then 112 stop "*********Element stack empty" 113endif 114item = elstack%data(n) 115 116end subroutine get_top_elstack 117 118!----------------------------------------------------------------- 119subroutine print_elstack(elstack,unit) 120type(elstack_t), intent(in) :: elstack 121integer, intent(in) :: unit 122integer :: i 123 124do i = elstack%n_items, 1, -1 125 write(unit=unit,fmt=*) str(elstack%data(i)) 126enddo 127 128end subroutine print_elstack 129 130!------------------------------------------------------------- 131subroutine get_elstack_signature(elstack,string) 132type(elstack_t), intent(in) :: elstack 133character(len=*), intent(out) :: string 134integer :: i, length, j 135 136string = "" 137j = 0 138do i = 1, elstack%n_items 139 length = len(elstack%data(i)) 140 string(j+1:j+1) = "/" 141 j = j+1 142 string(j+1:j+length) = str(elstack%data(i)) 143 j = j + length 144enddo 145 146end subroutine get_elstack_signature 147 148end module m_elstack 149 150 151 152 153 154