Octopus
list_node.F90
Go to the documentation of this file.
1!! Copyright (C) 2019 M. Oliveira
2!!
3!! This Source Code Form is subject to the terms of the Mozilla Public
4!! License, v. 2.0. If a copy of the MPL was not distributed with this
5!! file, You can obtain one at https://mozilla.org/MPL/2.0/.
6!!
7
8#include "global.h"
9
12module list_node_oct_m
13 use global_oct_m
14 use math_oct_m
15 implicit none
16
17 private
18 public :: list_node_t
19
22 type :: list_node_t
23 private
24 logical :: clone
26 class(*), pointer :: value => null()
27 type(list_node_t), pointer :: next_node => null()
28 contains
29 procedure :: get => list_node_get
30 procedure :: next => list_node_next
31 procedure :: set_next => list_node_set_next
32 procedure :: is_equal => list_node_is_equal
33 procedure :: copy => list_node_copy
34 final :: list_node_finalize
35 end type list_node_t
36
37 interface list_node_t
38 procedure list_node_constructor
39 end interface list_node_t
40
41contains
42
43 ! ---------------------------------------------------------
46 function list_node_constructor(value, next, clone) result(constructor)
47 class(*), target :: value
48 class(list_node_t), pointer :: next
49 logical, intent(in) :: clone
50 class(list_node_t), pointer :: constructor
51
52 ! No safe_allocate macro here, as its counterpart in linked_list.F90
53 ! causes an internal compiler error with GCC 6.4.0
54 allocate(constructor)
55 constructor%next_node => next
56 constructor%clone = clone
57 if (constructor%clone) then
58 allocate(constructor%value, source=value)
59 else
60 constructor%value => value
61 end if
62
63 end function list_node_constructor
64
65 ! ---------------------------------------------------------
68 function list_node_copy(this, next)
69 class(list_node_t), target :: this
70 class(list_node_t), pointer :: next
71 class(list_node_t), pointer :: list_node_copy
72
73 list_node_copy => list_node_constructor(this%value, next, this%clone)
74
75 end function list_node_copy
76
77 ! ---------------------------------------------------------
79 function list_node_next(this) result(next)
80 class(list_node_t), intent(in) :: this
81 class(list_node_t), pointer :: next
82
83 next => this%next_node
84
85 end function list_node_next
86
87 ! ---------------------------------------------------------
88 subroutine list_node_set_next(this, next_node)
89 class(list_node_t), intent(inout) :: this
90 class(list_node_t), pointer :: next_node
91
92 this%next_node => next_node
93
94 end subroutine list_node_set_next
95
96 ! ---------------------------------------------------------
98 function list_node_get(this) result(get)
99 class(list_node_t), intent(in) :: this
100 class(*), pointer :: get
101
102 get => this%value
103
104 end function list_node_get
106 ! ---------------------------------------------------------
107 logical function list_node_is_equal(this, value) result(is_equal)
108 class(list_node_t), intent(in) :: this
109 class(*), target :: value
110
111 ! First try to match the two types and compare the values.
112 ! Note that the list of types taken into account might not be exhaustive.
113 is_equal = .false.
114 select type (ptr => this%value)
115 type is (integer)
116 select type (value)
117 type is (integer)
118 is_equal = value == ptr
119 end select
120 type is (real(real64))
121 select type (value)
122 type is (real(real64))
123 is_equal = is_close(value, ptr)
124 end select
125 type is (complex(real64))
126 select type (value)
127 type is (complex(real64))
128 is_equal = is_close(value, ptr)
129 end select
130 type is (character(len=*))
131 select type (value)
132 type is (character(len=*))
133 is_equal = value == ptr
134 end select
135 type is (logical)
136 select type (value)
137 type is (logical)
138 is_equal = value .eqv. ptr
139 end select
140 end select
141
142 ! If we were not able to match the types, then we check if the two values
143 ! point to the same target.
144 if (.not. is_equal) then
145 is_equal = associated(this%value, value)
146 end if
147
148 end function list_node_is_equal
149
150 subroutine list_node_finalize(this)
151 type(list_node_t), intent(inout) :: this
152
153 if (associated(this%next_node)) then
154 nullify(this%next_node)
155 end if
156 if (associated(this%value)) then
157 if (this%clone) then
158 deallocate(this%value)
159 else
160 nullify(this%value)
161 end if
162 end if
163
164 end subroutine list_node_finalize
165
166end module list_node_oct_m
This module implements a node of a polymorphic linked list.
Definition: list_node.F90:105
class(list_node_t) function, pointer list_node_constructor(value, next, clone)
create a new node
Definition: list_node.F90:140
class(list_node_t) function, pointer list_node_copy(this, next)
copy a node
Definition: list_node.F90:162
subroutine list_node_finalize(this)
Definition: list_node.F90:244
class(list_node_t) function, pointer list_node_next(this)
get next node
Definition: list_node.F90:173
subroutine list_node_set_next(this, next_node)
Definition: list_node.F90:182
logical function list_node_is_equal(this, value)
Definition: list_node.F90:201
class(*) function, pointer list_node_get(this)
get data of node
Definition: list_node.F90:192
This module is intended to contain "only mathematical" functions and procedures.
Definition: math.F90:115
class for a node in a polymorphic linked list
Definition: list_node.F90:115