10 class(*),
pointer:: car
17 character(len=32):: name
23 procedure:: insert_before
24 procedure:: insert_after
35 SUBROUTINE init (self, name)
37 character(len=*),
optional:: name
39 nullify (self%head, self%tail)
42 if (
present(name))
then 52 SUBROUTINE append (self, new)
58 if (.not.
associated(self%head)) self%head => new
59 if (
associated(self%tail)) self%tail%next => new
68 SUBROUTINE prepend (self, new)
72 if (.not.
associated(self%tail)) self%tail => new
78 END SUBROUTINE prepend
83 SUBROUTINE find (self, old, prev, next)
86 class(*),
pointer:: old
90 do while (
associated(next))
91 if (
associated(next%car, old))
then 103 SUBROUTINE insert_before (self, old, new)
109 if (
associated(new%prev)) new%prev%next => new
110 if (
associated(new%next)) new%next%prev => new
113 END SUBROUTINE insert_before
118 SUBROUTINE insert_after (self, old, new)
124 if (
associated(new%prev)) new%prev%next => new
125 if (
associated(new%next)) new%next%prev => new
128 END SUBROUTINE insert_after
133 SUBROUTINE remove (self, old)
137 if (
associated(old%prev)) old%prev%next => old%next
138 if (
associated(old%next)) old%next%prev => old%prev
139 if (
associated(old, self%head))
then 140 self%head => old%next
142 if (
associated(old, self%tail))
then 143 self%tail => old%prev
147 END SUBROUTINE remove
158 if (
associated(pop%prev))
then 159 self%tail => pop%prev
160 nullify(self%tail%next)
169 SUBROUTINE test (self)
173 class(*),
pointer:: car, save
174 integer,
pointer:: ip
181 print *,
'===================== Doubly linked list test =======================' 193 if (i == 3)
save => next%car
194 call self%append (next)
199 print *,
'list:', self%n
201 do while (
associated(next))
202 call print (next%car)
210 call self%find (
save, prev, next)
211 call print (next%car)
213 call print (prev%car)
215 subroutine print (car)
216 class(*),
pointer:: car
229 SUBROUTINE delete (self)
235 do while (
associated(item))
237 if (
associated(item%car))
deallocate (item%car)
245 END SUBROUTINE delete
Doubly linked list (DLL), carrying anything, as simply as possible.