├── .gitignore ├── CMakeLists.txt ├── LICENSE ├── README.md ├── doc └── diagram.graffle └── src ├── octree_mod.F90 └── octree_test.F90 /.gitignore: -------------------------------------------------------------------------------- 1 | # Prerequisites 2 | *.d 3 | 4 | # Compiled Object files 5 | *.slo 6 | *.lo 7 | *.o 8 | *.obj 9 | 10 | # Precompiled Headers 11 | *.gch 12 | *.pch 13 | 14 | # Compiled Dynamic libraries 15 | *.so 16 | *.dylib 17 | *.dll 18 | 19 | # Fortran module files 20 | *.mod 21 | *.smod 22 | 23 | # Compiled Static libraries 24 | *.lai 25 | *.la 26 | *.a 27 | *.lib 28 | 29 | # Executables 30 | *.exe 31 | *.out 32 | *.app 33 | -------------------------------------------------------------------------------- /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.0.0 FATAL_ERROR) 2 | 3 | project(fortran-octree VERSION 0.0.1 LANGUAGES Fortran) 4 | 5 | find_package(OpenMP) 6 | if (OPENMP_FOUND) 7 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${OpenMP_Fortran_FLAGS}") 8 | endif () 9 | 10 | add_library(fortran_octree src/octree_mod.F90) 11 | 12 | add_executable(octree_test.exe src/octree_test.F90) 13 | target_link_libraries(octree_test.exe fortran_octree) -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 Li Dong 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Fortran octree 2 | A Fortran octree implementation. 3 | 4 | # Test 5 | 6 | ``` 7 | $ mkdir build && cd build 8 | $ cmake .. 9 | $ make 10 | $ ./octree_test [point number, default is 100] 11 | ``` 12 | -------------------------------------------------------------------------------- /doc/diagram.graffle: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dongli/fortran-octree/57f250c89a208147d586cadfdeddb8c88439dd9c/doc/diagram.graffle -------------------------------------------------------------------------------- /src/octree_mod.F90: -------------------------------------------------------------------------------- 1 | module octree_mod 2 | 3 | implicit none 4 | 5 | private 6 | 7 | public point_type 8 | public octree_init 9 | public octree_final 10 | public octree_build 11 | public octree_update 12 | public octree_search 13 | 14 | type config_type 15 | integer max_num_point ! Maximum point number contained in leaf node. 16 | integer max_depth ! Maximum level of branch and leaf nodes 17 | real(8) bbox(2, 3) 18 | end type config_type 19 | 20 | ! Points should be indexed by their id. 21 | type point_type 22 | integer id 23 | real(8) x(3) 24 | end type point_type 25 | 26 | ! There are two kinds of nodes: 27 | ! 1. Branch node with children; 28 | ! 2. Leaf node without child but containing points. 29 | type node_type 30 | integer depth 31 | real(8) bbox(2, 3) 32 | integer num_point 33 | integer, allocatable :: point_ids(:) 34 | type(node_type), pointer :: parent 35 | type(node_type), pointer :: children(:) 36 | end type node_type 37 | 38 | type tree_type 39 | type(point_type), pointer :: points(:) 40 | type(node_type), pointer :: root_node 41 | end type tree_type 42 | 43 | type(config_type) config 44 | type(tree_type) tree 45 | 46 | contains 47 | 48 | subroutine octree_init(max_num_point, max_depth, bbox) 49 | 50 | integer, intent(in), optional :: max_num_point 51 | integer, intent(in), optional :: max_depth 52 | real(8), intent(in), optional :: bbox(2, 3) 53 | 54 | config%max_num_point = merge(max_num_point, 3, present(max_num_point)) 55 | config%max_depth = merge(max_depth, 10, present(max_depth)) 56 | config%bbox = merge(bbox, reshape([0.0d0, 1.0d0, 0.0d0, 1.0d0, 0.0d0, 1.0d0], [2, 3]), present(bbox)) 57 | 58 | if (.not. associated(tree%root_node)) allocate(tree%root_node) 59 | call reset_node(tree%root_node) 60 | tree%root_node%depth = 1 61 | tree%root_node%bbox = config%bbox 62 | 63 | end subroutine octree_init 64 | 65 | subroutine octree_final() 66 | 67 | call clean_node(tree%root_node) 68 | deallocate(tree%root_node) 69 | 70 | end subroutine octree_final 71 | 72 | recursive subroutine octree_build(points, node_) 73 | 74 | type(point_type), intent(in), target :: points(:) 75 | type(node_type), intent(inout), target, optional :: node_ 76 | 77 | type(node_type), pointer :: node 78 | integer i, j 79 | integer num_contained_point 80 | type(point_type), allocatable :: contained_points(:) 81 | 82 | if (present(node_)) then 83 | node => node_ 84 | else 85 | tree%points => points 86 | node => tree%root_node 87 | end if 88 | 89 | ! Leaf node is approached. 90 | if (node%depth >= config%max_depth .or. size(points) <= config%max_num_point) then 91 | if (size(points) > size(node%point_ids)) then 92 | deallocate(node%point_ids) 93 | allocate(node%point_ids(size(points))) 94 | end if 95 | j = 1 96 | do i = 1, size(points) 97 | if (points(i)%x(1) < node%bbox(1, 1) .or. points(i)%x(1) > node%bbox(2, 1) .or. & 98 | points(i)%x(2) < node%bbox(1, 2) .or. points(i)%x(2) > node%bbox(2, 2) .or. & 99 | points(i)%x(3) < node%bbox(1, 3) .or. points(i)%x(3) > node%bbox(2, 3)) cycle 100 | node%point_ids(j) = points(i)%id 101 | j = j + 1 102 | end do 103 | node%num_point = j - 1 104 | return 105 | end if 106 | 107 | ! Copy contained points into a new array. 108 | num_contained_point = 0 109 | do i = 1, size(points) 110 | if (points(i)%x(1) < node%bbox(1, 1) .or. points(i)%x(1) > node%bbox(2, 1) .or. & 111 | points(i)%x(2) < node%bbox(1, 2) .or. points(i)%x(2) > node%bbox(2, 2) .or. & 112 | points(i)%x(3) < node%bbox(1, 3) .or. points(i)%x(3) > node%bbox(2, 3)) cycle 113 | num_contained_point = num_contained_point + 1 114 | end do 115 | allocate(contained_points(num_contained_point)) 116 | j = 1 117 | do i = 1, size(points) 118 | if (points(i)%x(1) < node%bbox(1, 1) .or. points(i)%x(1) > node%bbox(2, 1) .or. & 119 | points(i)%x(2) < node%bbox(1, 2) .or. points(i)%x(2) > node%bbox(2, 2) .or. & 120 | points(i)%x(3) < node%bbox(1, 3) .or. points(i)%x(3) > node%bbox(2, 3)) cycle 121 | contained_points(j)%id = points(i)%id 122 | contained_points(j)%x = points(i)%x 123 | j = j + 1 124 | end do 125 | 126 | if (num_contained_point == 0) return 127 | 128 | ! Subdivide node and run into the child nodes. 129 | call subdivide_node(node) 130 | do i = 1, 8 131 | call octree_build(contained_points, node%children(i)) 132 | end do 133 | 134 | ! if (node%depth == 1) then 135 | ! call print_tree(tree%root_node) 136 | ! end if 137 | 138 | end subroutine octree_build 139 | 140 | subroutine octree_update(node_) 141 | 142 | type(node_type), intent(inout), target, optional :: node_ 143 | 144 | type(node_type), pointer :: node 145 | 146 | if (present(node_)) then 147 | node => node_ 148 | else 149 | node => tree%root_node 150 | end if 151 | 152 | end subroutine octree_update 153 | 154 | recursive subroutine octree_search(x, distance, num_ngb_point, ngb_ids, node_) 155 | 156 | real(8), intent(in) :: x(3) 157 | real(8), intent(in) :: distance 158 | integer, intent(inout) :: num_ngb_point 159 | integer, intent(inout) :: ngb_ids(:) 160 | type(node_type), intent(in), target, optional :: node_ 161 | 162 | type(node_type), pointer :: node 163 | real(8) d2, dx(3) 164 | integer i 165 | 166 | if (present(node_)) then 167 | node => node_ 168 | else 169 | node => tree%root_node 170 | end if 171 | 172 | if (associated(node%children)) then 173 | ! We are at branch node. 174 | do i = 1, 8 175 | if ((x(1) + distance) > node%children(i)%bbox(1,1) .and. & 176 | (x(1) - distance) < node%children(i)%bbox(2,1) .and. & 177 | (x(2) + distance) > node%children(i)%bbox(1,2) .and. & 178 | (x(2) - distance) < node%children(i)%bbox(2,2) .and. & 179 | (x(3) + distance) > node%children(i)%bbox(1,3) .and. & 180 | (x(3) - distance) < node%children(i)%bbox(2,3)) then 181 | call octree_search(x, distance, num_ngb_point, ngb_ids, node%children(i)) 182 | end if 183 | end do 184 | else 185 | if (node%num_point == 0) return 186 | ! We are at leaf node. 187 | d2 = distance * distance 188 | do i = 1, node%num_point 189 | dx(:) = x(:) - tree%points(node%point_ids(i))%x(:) 190 | if (dot_product(dx, dx) < d2) then 191 | num_ngb_point = num_ngb_point + 1 192 | if (num_ngb_point <= size(ngb_ids)) then 193 | ngb_ids(num_ngb_point) = node%point_ids(i) 194 | else 195 | write(6, "('[Error]: octree: The ngb_ids array size is not enough!')") 196 | stop 1 197 | end if 198 | end if 199 | end do 200 | end if 201 | 202 | end subroutine octree_search 203 | 204 | subroutine reset_node(node) 205 | 206 | type(node_type), intent(inout) :: node 207 | 208 | node%num_point = 0 209 | if (.not. allocated(node%point_ids)) allocate(node%point_ids(config%max_num_point)) 210 | nullify(node%parent) 211 | if (size(node%children) == 8) deallocate(node%children) 212 | nullify(node%children) 213 | 214 | end subroutine reset_node 215 | 216 | subroutine subdivide_node(node) 217 | 218 | type(node_type), intent(inout), target :: node 219 | 220 | integer i, j, k, l 221 | real(8) bbox(2, 3) 222 | 223 | allocate(node%children(8)) 224 | l = 1 225 | do k = 1, 2 226 | do j = 1, 2 227 | do i = 1, 2 228 | call reset_node(node%children(l)) 229 | node%children(l)%depth = node%depth + 1 230 | node%children(l)%parent => node 231 | node%children(l)%bbox(1, 1) = node%bbox(1, 1) + (i - 1) * (node%bbox(2, 1) - node%bbox(1, 1)) * 0.5d0 232 | node%children(l)%bbox(2, 1) = node%bbox(2, 1) - (2 - i) * (node%bbox(2, 1) - node%bbox(1, 1)) * 0.5d0 233 | node%children(l)%bbox(1, 2) = node%bbox(1, 2) + (j - 1) * (node%bbox(2, 2) - node%bbox(1, 2)) * 0.5d0 234 | node%children(l)%bbox(2, 2) = node%bbox(2, 2) - (2 - j) * (node%bbox(2, 2) - node%bbox(1, 2)) * 0.5d0 235 | node%children(l)%bbox(1, 3) = node%bbox(1, 3) + (k - 1) * (node%bbox(2, 3) - node%bbox(1, 3)) * 0.5d0 236 | node%children(l)%bbox(2, 3) = node%bbox(2, 3) - (2 - k) * (node%bbox(2, 3) - node%bbox(1, 3)) * 0.5d0 237 | node%children(l)%parent => node 238 | l = l + 1 239 | end do 240 | end do 241 | end do 242 | 243 | end subroutine subdivide_node 244 | 245 | recursive subroutine clean_node(node) 246 | 247 | type(node_type), intent(inout) :: node 248 | 249 | integer i 250 | 251 | if (associated(node%children)) then 252 | do i = 1, 8 253 | call clean_node(node%children(i)) 254 | deallocate(node%children(i)%point_ids) 255 | end do 256 | deallocate(node%children) 257 | end if 258 | 259 | end subroutine clean_node 260 | 261 | subroutine print_node(node) 262 | 263 | type(node_type), intent(in) :: node 264 | 265 | write(6, "('Bounding box: ', 6F8.2)") node%bbox 266 | write(6, "('Depth: ', I3)") node%depth 267 | write(6, "('Point number: ', I3)") node%num_point 268 | write(6, "('Leaf?: ', L1)") .not. associated(node%children) 269 | 270 | end subroutine print_node 271 | 272 | recursive subroutine print_tree(node) 273 | 274 | type(node_type), intent(in) :: node 275 | 276 | integer i 277 | 278 | if (associated(node%children)) then 279 | write(6, "('----------------------------------------------------------------')") 280 | write(6, "('Branch node: ')") 281 | write(6, "(' Bounding box: ', 6F8.2)") node%bbox 282 | write(6, "(' Depth: ', I3)") node%depth 283 | do i = 1, 8 284 | call print_tree(node%children(i)) 285 | end do 286 | else 287 | if (node%num_point == 0) return 288 | write(6, "('Leaf node: ')") 289 | write(6, "(' Bounding box: ', 6F8.2)") node%bbox 290 | write(6, "(' Depth: ', I3)") node%depth 291 | write(6, "(' Points:')", advance='no') 292 | write(6, *) (node%point_ids(i), i = 1, node%num_point) 293 | end if 294 | 295 | end subroutine print_tree 296 | 297 | end module octree_mod 298 | -------------------------------------------------------------------------------- /src/octree_test.F90: -------------------------------------------------------------------------------- 1 | program test_octree 2 | 3 | use octree_mod 4 | 5 | type(point_type), allocatable :: points(:) 6 | integer i, num_seed, num_ngb 7 | integer, allocatable :: seed(:), ngb_ids(:) 8 | real(8) x(3), dx(3) 9 | character(30) arg 10 | 11 | if (command_argument_count() == 1) then 12 | call get_command_argument(1, arg) 13 | read(arg, '(I8)') num_seed 14 | allocate(points(num_seed)) 15 | else 16 | allocate(points(100)) 17 | end if 18 | 19 | call octree_init() 20 | 21 | call random_seed(size=num_seed) 22 | allocate(seed(num_seed)) 23 | seed(:) = 1 24 | call random_seed(put=seed) 25 | deallocate(seed) 26 | 27 | do i = 1, size(points) 28 | call random_number(x) 29 | points(i)%id = i 30 | points(i)%x = x 31 | end do 32 | 33 | call octree_build(points) 34 | 35 | allocate(ngb_ids(500)) 36 | 37 | !$OMP PARALLEL DO 38 | do i = 1, size(points) 39 | !print *, 'Check neighbors of point ', i 40 | num_ngb = 0 41 | call octree_search(points(i)%x, 0.05d0, num_ngb, ngb_ids) 42 | !print *, 'Found ', num_ngb, ' neighbors' 43 | end do 44 | !$OMP END PARALLEL DO 45 | 46 | call octree_final() 47 | 48 | end program test_octree 49 | --------------------------------------------------------------------------------