-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmiscellaneous.f90
142 lines (113 loc) · 3.96 KB
/
miscellaneous.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
!> === miscellaneous.f90
!>
!> provide the implementation of a stack structure
!>
!> ===
module miscellaneous
use parameters, only: wp
implicit none
private
public :: T_Stack
type :: T_Stack
integer :: val
type(T_Stack), pointer :: next => null()
contains
procedure :: ssize => stack_size
procedure :: scontains => stack_contains
procedure :: push => stack_push
procedure :: push_unique => stack_push_unique
procedure :: pop => stack_pop
procedure :: get => stack_get
procedure :: free => stack_free
end type
contains
recursive function stack_size(this) result(st_size)
!> returns the size of the stack
!>
!> this: the stack to get the size of
!> n : the size counter
class(T_Stack), target, intent(inout) :: this
integer :: st_size
if (associated(this%next)) then
st_size = stack_size(this%next) + 1
else
st_size = 0
end if
end function stack_size
subroutine stack_push(this, val)
!> push a value onto the stack
!>
!> this: the stack to push onto
!> val : the value to push
class(T_Stack), target, intent(inout) :: this
integer, intent(in) :: val
type(T_Stack), pointer :: new_link => null()
allocate(new_link)
new_link%val = val
new_link%next => this%next
this%next => new_link
end subroutine stack_push
function stack_contains(this, val)
!> check if a value is in the stack
!>
!> this : the stack to check in
!> val : the value to check against
!> stack_contains : .true. if val in the stack, .false. otherwise
class(T_Stack), target, intent(inout) :: this
integer, intent(in) :: val
logical :: stack_contains
integer :: s,k
stack_contains = .false.
s = this%ssize()
if (s > 0) then
do k=1,s
stack_contains = stack_contains .or. (this%get(k) == val)
if (stack_contains) exit
end do
end if
end function stack_contains
subroutine stack_push_unique(this, val)
!> push a value onto the stack only if it is not already in
!>
!> this: the stack to push onto
!> val : the value to push
class(T_Stack), target, intent(inout) :: this
integer, intent(in) :: val
if (.not.this%scontains(val)) call this%push(val)
end subroutine stack_push_unique
function stack_pop(this) result(val)
!> pop a value out of the stack
!>
!> this: the stack to pop the value from
!> val : the popped value
class(T_Stack), target, intent(inout) :: this
integer :: val
class(T_Stack), pointer :: tmp
tmp => this%next
val = tmp%val
this%next => tmp%next
deallocate(tmp)
end function stack_pop
recursive function stack_get(this, n) result(val)
!> get the n-th value in the stack
!>
!> this: the stack to pop the value from
!> n : the index of the desired value
!> val : the n-th value
class(T_Stack), target, intent(inout) :: this
integer , intent(in) :: n
integer :: val
if (n == 1) then
val = this%next%val
else
val = this%next%get(n-1)
end if
end function stack_get
subroutine stack_free(this)
class(T_Stack), intent(inout) :: this
integer :: dummy
do while (associated(this%next))
dummy = this%pop()
end do
end subroutine stack_free
end module miscellaneous