├── .gitignore ├── .gitmodules ├── CMakeLists.txt ├── LICENSE ├── README.md ├── build └── .keep ├── src ├── kdtree.F90 ├── kdtree_mod.F90 ├── kdtree_test.F90 ├── kdtree_utils_mod.F90 ├── node_mod.F90 ├── node_placing_mod.F90 └── qsort_mod.F90 └── tools ├── plot_kdtree_2d_search.ncl └── plot_node_placing.ncl /.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "lib/unit-test"] 2 | path = lib/unit-test 3 | url = https://github.com/dongli/fortran-unit-test 4 | -------------------------------------------------------------------------------- /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.0) 2 | 3 | project(fortran_kdtree LANGUAGES Fortran) 4 | 5 | if (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") 6 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none") 7 | if (CMAKE_BUILD_TYPE STREQUAL "Debug") 8 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -Wall -Wextra -Warray-temporaries -Wconversion -fimplicit-none -fbacktrace -fcheck=all -ffpe-trap=zero,overflow,underflow -finit-real=nan") 9 | else () 10 | set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffpe-summary=none -Ofast") 11 | endif () 12 | endif () 13 | 14 | set (CMAKE_Fortran_MODULE_DIRECTORY "${CMAKE_BINARY_DIR}") 15 | include_directories(${CMAKE_BINARY_DIR}) 16 | 17 | if (EXISTS ${PROJECT_SOURCE_DIR}/lib/unit-test/CMakeLists.txt) 18 | add_subdirectory(lib/unit-test) 19 | set(RUN_TEST ON) 20 | endif () 21 | 22 | set(sources 23 | src/kdtree_utils_mod.F90 24 | src/node_mod.F90 25 | src/node_placing_mod.F90 26 | src/qsort_mod.F90 27 | src/kdtree_mod.F90 28 | src/kdtree.F90 29 | ) 30 | 31 | add_library(fortran_kdtree ${sources}) 32 | 33 | if (RUN_TEST) 34 | add_executable(kdtree_test.exe src/kdtree_test.F90) 35 | target_link_libraries(kdtree_test.exe fortran_kdtree fortran_unit_test) 36 | endif () 37 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 董理 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 | # Introduction 2 | 3 | KD-Tree is a standard data structure for indexing data, especially in 3D space. It is an extension of Binary-Space Partition (BSP) to more than one dimension. For more information on KD-Tree, please refer Wiki. 4 | 5 | This repository is a Fortran implementation of KD-Tree. We need KD-Tree in scientific HPC scenarios, so Fortran is still the right language, and also we need more modern library interfaces. 6 | 7 | # Usage 8 | 9 | ```fortran 10 | use kdtree 11 | 12 | real(8), allocatable :: x(:,:) ! num_dim, num_point 13 | integer, allocatable :: ngb_idx(:,:) ! num_ngb, num_point 14 | type(kdtree_type) kdtree 15 | integer i 16 | 17 | ! Allocate x and ngb_idx, and set x accordingly. 18 | 19 | call kdtree%build(x) 20 | do i = 1, size(x, 2) 21 | call kdtree%search(x(:,i), ngb_idx(:,i)) 22 | end do 23 | 24 | ! Other works ... 25 | ``` 26 | 27 | # Contributors 28 | 29 | - Li Dong 30 | -------------------------------------------------------------------------------- /build/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/dongli/fortran-kdtree/d2b750d80335f403eaae57c3e8cf135c5ae93a20/build/.keep -------------------------------------------------------------------------------- /src/kdtree.F90: -------------------------------------------------------------------------------- 1 | module kdtree 2 | 3 | use kdtree_mod 4 | 5 | end module kdtree 6 | -------------------------------------------------------------------------------- /src/kdtree_mod.F90: -------------------------------------------------------------------------------- 1 | module kdtree_mod 2 | 3 | use kdtree_utils_mod 4 | use node_mod 5 | 6 | implicit none 7 | 8 | private 9 | 10 | public kdtree_type 11 | 12 | type kdtree_type 13 | type(node_type), pointer :: root_node => null() 14 | contains 15 | procedure, private :: kdtree_build_1 16 | procedure, private :: kdtree_build_2 17 | generic :: build => kdtree_build_1, kdtree_build_2 18 | procedure, private :: kdtree_search_r4 19 | procedure, private :: kdtree_search_r8 20 | generic :: search => kdtree_search_r4, kdtree_search_r8 21 | procedure :: range_search => kdtree_range_search 22 | final :: kdtree_final 23 | end type kdtree_type 24 | 25 | integer node_access_count 26 | 27 | contains 28 | 29 | recursive subroutine kdtree_build_1(this, x, start_node) 30 | 31 | class(kdtree_type), intent(inout) :: this 32 | real(8), intent(in) :: x(:,:) 33 | type(node_type), intent(inout), target, optional :: start_node 34 | 35 | integer num_point, num_dim, part_dim, i, d 36 | real(8) xvar, max_xvar 37 | real(8) xmed ! Median coordinate along one dimension 38 | type(node_type), pointer :: node 39 | 40 | num_dim = size(x, 1) 41 | num_point = size(x, 2) 42 | 43 | ! Calculate the variance along each dimension, and choose the dimension with the 44 | ! largest value as the partition dimension. 45 | max_xvar = -1 46 | do d = 1, num_dim 47 | xvar = variance(x(d,:)) 48 | if (max_xvar < xvar) then 49 | max_xvar = xvar 50 | part_dim = d 51 | end if 52 | end do 53 | 54 | ! Calculate the median number along the chosen dimension as the partition location. 55 | xmed = median(x(part_dim,:)) 56 | 57 | ! Create tree structures. 58 | if (present(start_node)) then 59 | node => start_node 60 | else 61 | allocate(this%root_node) 62 | call this%root_node%init() 63 | node => this%root_node 64 | node%num_point = num_point 65 | ! Create global index array. 66 | allocate(node%global_idx_array(num_point)) 67 | do i = 1, num_point 68 | node%global_idx_array(i) = i 69 | end do 70 | end if 71 | if (num_point == 1) then 72 | ! Reach the leaf node, return back. 73 | node%x = x(:,1) 74 | node%global_idx = node%global_idx_array(1) 75 | call node%discard_arrays() 76 | return 77 | end if 78 | call node%create_child_nodes(part_dim, num_dim, num_point) 79 | 80 | node%global_idx = -1 81 | do i = 1, num_point 82 | if (x(part_dim,i) < xmed) then 83 | call node%left %add_point(x(:,i), node%global_idx_array(i)) 84 | else if (x(part_dim,i) > xmed) then 85 | call node%right%add_point(x(:,i), node%global_idx_array(i)) 86 | else 87 | ! If there is already a point on the cut line, save it to both sides. 88 | if (node%global_idx /= -1) then 89 | call node%left %add_point(node%x, node%global_idx) 90 | call node%right%add_point(node%x, node%global_idx) 91 | end if 92 | ! Save the cut point. 93 | node%x = x(:,i) 94 | node%global_idx = node%global_idx_array(i) 95 | end if 96 | end do 97 | 98 | ! Clean memory usage. 99 | call node%discard_arrays() 100 | call node%left %end_point() 101 | call node%right%end_point() 102 | 103 | ! Recursively build subtrees. 104 | if (node%left%num_point > 0) then 105 | call this%build(node%left%x_array, start_node=node%left) 106 | else 107 | deallocate(node%left) 108 | end if 109 | if (node%right%num_point > 0) then 110 | call this%build(node%right%x_array, start_node=node%right) 111 | else 112 | deallocate(node%right) 113 | end if 114 | 115 | end subroutine kdtree_build_1 116 | 117 | subroutine kdtree_build_2(this, x, y) 118 | 119 | class(kdtree_type), intent(inout) :: this 120 | real(8), intent(in) :: x(:) 121 | real(8), intent(in) :: y(:) 122 | 123 | real(8), allocatable :: xy(:,:) 124 | 125 | if (size(x) /= size(y)) then 126 | stop '[Error]: kdtree_build: Dimensions of x and y is not the same!' 127 | end if 128 | 129 | allocate(xy(2,size(x))) 130 | 131 | xy(1,:) = x 132 | xy(2,:) = y 133 | 134 | call this%build(xy) 135 | 136 | deallocate(xy) 137 | 138 | end subroutine kdtree_build_2 139 | 140 | recursive subroutine kdtree_search_r4(this, x, ngb_idx, mute, start_node, ngb_dist, ngb_count) 141 | 142 | class(kdtree_type), intent(in) :: this 143 | real(4), intent(in) :: x(:) 144 | integer, intent(inout) :: ngb_idx(:) 145 | logical, intent(in), optional :: mute 146 | type(node_type), intent(in), target, optional :: start_node 147 | real(4), intent(inout), target, optional :: ngb_dist(:) 148 | integer, intent(inout), target, optional :: ngb_count 149 | 150 | logical mute_opt 151 | real(4) dist 152 | type(node_type), pointer :: node 153 | real(4), pointer :: ngb_dist_opt(:) 154 | integer, pointer :: ngb_count_opt 155 | 156 | mute_opt = .true.; if (present(mute)) mute_opt = mute 157 | if (present(start_node)) then 158 | node => start_node 159 | else 160 | node => this%root_node 161 | end if 162 | if (present(ngb_count)) then 163 | ngb_count_opt => ngb_count 164 | else 165 | allocate(ngb_count_opt) 166 | ngb_count_opt = 0 167 | node_access_count = 0 168 | end if 169 | if (present(ngb_dist)) then 170 | ngb_dist_opt => ngb_dist 171 | else 172 | allocate(ngb_dist_opt(size(ngb_idx))) 173 | end if 174 | 175 | node_access_count = node_access_count + 1 176 | dist = norm2(x - node%x) 177 | 178 | call record_potential_ngb_r4(ngb_count_opt, ngb_idx, ngb_dist_opt, dist, node%global_idx) 179 | 180 | ! Check if the hypersphere with the radius as the distance of the farest neightbor intersects 181 | ! the splitting hyperplane. 182 | if (node%part_dim /= 0) then 183 | dist = abs(x(node%part_dim) - node%x(node%part_dim)) 184 | if (x(node%part_dim) < node%x(node%part_dim)) then 185 | if (associated(node%left)) then 186 | call this%search(x, ngb_idx, start_node=node%left, ngb_dist=ngb_dist_opt, ngb_count=ngb_count_opt) 187 | end if 188 | if (associated(node%right)) then 189 | if (dist < ngb_dist_opt(ngb_count_opt)) then 190 | call this%search(x, ngb_idx, start_node=node%right, ngb_dist=ngb_dist_opt, ngb_count=ngb_count_opt) 191 | end if 192 | end if 193 | else 194 | if (associated(node%right)) then 195 | call this%search(x, ngb_idx, start_node=node%right, ngb_dist=ngb_dist_opt, ngb_count=ngb_count_opt) 196 | end if 197 | if (associated(node%left)) then 198 | if (dist < ngb_dist_opt(ngb_count_opt)) then 199 | call this%search(x, ngb_idx, start_node=node%left, ngb_dist=ngb_dist_opt, ngb_count=ngb_count_opt) 200 | end if 201 | end if 202 | end if 203 | end if 204 | 205 | if (.not. present(ngb_dist )) deallocate(ngb_dist_opt) 206 | if (.not. present(ngb_count)) deallocate(ngb_count_opt) 207 | if (.not. present(start_node) .and. .not. mute_opt) then 208 | write(*, '("Searched ", I0, " of ", I0, " nodes.")') node_access_count, this%root_node%num_point 209 | end if 210 | 211 | end subroutine kdtree_search_r4 212 | 213 | recursive subroutine kdtree_search_r8(this, x, ngb_idx, mute, start_node, ngb_dist, ngb_count) 214 | 215 | class(kdtree_type), intent(in) :: this 216 | real(8), intent(in) :: x(:) 217 | integer, intent(inout) :: ngb_idx(:) 218 | logical, intent(in), optional :: mute 219 | type(node_type), intent(in), target, optional :: start_node 220 | real(8), intent(inout), target, optional :: ngb_dist(:) 221 | integer, intent(inout), target, optional :: ngb_count 222 | 223 | logical mute_opt 224 | real(8) dist 225 | type(node_type), pointer :: node 226 | real(8), pointer :: ngb_dist_opt(:) 227 | integer, pointer :: ngb_count_opt 228 | 229 | mute_opt = .true.; if (present(mute)) mute_opt = mute 230 | if (present(start_node)) then 231 | node => start_node 232 | else 233 | node => this%root_node 234 | end if 235 | if (present(ngb_count)) then 236 | ngb_count_opt => ngb_count 237 | else 238 | allocate(ngb_count_opt) 239 | ngb_count_opt = 0 240 | node_access_count = 0 241 | end if 242 | if (present(ngb_dist)) then 243 | ngb_dist_opt => ngb_dist 244 | else 245 | allocate(ngb_dist_opt(size(ngb_idx))) 246 | end if 247 | 248 | node_access_count = node_access_count + 1 249 | dist = norm2(x - node%x) 250 | 251 | call record_potential_ngb_r8(ngb_count_opt, ngb_idx, ngb_dist_opt, dist, node%global_idx) 252 | 253 | ! Check if the hypersphere with the radius as the distance of the farest neightbor intersects 254 | ! the splitting hyperplane. 255 | if (node%part_dim /= 0) then 256 | dist = abs(x(node%part_dim) - node%x(node%part_dim)) 257 | if (x(node%part_dim) < node%x(node%part_dim)) then 258 | if (associated(node%left)) then 259 | call this%search(x, ngb_idx, start_node=node%left, ngb_dist=ngb_dist_opt, ngb_count=ngb_count_opt) 260 | end if 261 | if (associated(node%right)) then 262 | if (dist < ngb_dist_opt(ngb_count_opt)) then 263 | call this%search(x, ngb_idx, start_node=node%right, ngb_dist=ngb_dist_opt, ngb_count=ngb_count_opt) 264 | end if 265 | end if 266 | else 267 | if (associated(node%right)) then 268 | call this%search(x, ngb_idx, start_node=node%right, ngb_dist=ngb_dist_opt, ngb_count=ngb_count_opt) 269 | end if 270 | if (associated(node%left)) then 271 | if (dist < ngb_dist_opt(ngb_count_opt)) then 272 | call this%search(x, ngb_idx, start_node=node%left, ngb_dist=ngb_dist_opt, ngb_count=ngb_count_opt) 273 | end if 274 | end if 275 | end if 276 | end if 277 | 278 | if (.not. present(ngb_dist )) deallocate(ngb_dist_opt) 279 | if (.not. present(ngb_count)) deallocate(ngb_count_opt) 280 | if (.not. present(start_node) .and. .not. mute_opt) then 281 | write(*, '("Searched ", I0, " of ", I0, " nodes.")') node_access_count, this%root_node%num_point 282 | end if 283 | 284 | end subroutine kdtree_search_r8 285 | 286 | subroutine kdtree_range_search(this, x, ngb_idx, radius, ngb_dist, ngb_bunch) 287 | 288 | class(kdtree_type), intent(in) :: this 289 | real(8), intent(in) :: x(:) 290 | integer, intent(inout), allocatable :: ngb_idx(:) 291 | real(8), intent(in) :: radius 292 | real(8), intent(inout), allocatable, optional :: ngb_dist(:) 293 | integer, intent(in), optional :: ngb_bunch 294 | 295 | integer nb, n, i 296 | logical finished 297 | real(8), allocatable :: ngb_dist_opt(:) 298 | integer, allocatable :: final_ngb_idx(:) 299 | 300 | if (present(ngb_bunch)) then 301 | nb = ngb_bunch 302 | else 303 | nb = 50 304 | end if 305 | 306 | if (.not. allocated(ngb_idx)) allocate(ngb_idx(nb)) 307 | allocate(ngb_dist_opt(size(ngb_idx))) 308 | 309 | finished = .false. 310 | do while (.not. finished) 311 | call this%search(x, ngb_idx, mute=.true., ngb_dist=ngb_dist_opt) 312 | do i = 1, size(ngb_idx) 313 | if (ngb_dist_opt(i) > radius) then 314 | finished = .true. 315 | exit 316 | end if 317 | end do 318 | if (.not. finished) then 319 | ! Increase search size by nb. 320 | n = size(ngb_idx) + nb 321 | deallocate(ngb_idx ); allocate(ngb_idx (n)) 322 | deallocate(ngb_dist_opt); allocate(ngb_dist_opt(n)) 323 | end if 324 | end do 325 | 326 | ! Remove ngb outside range. 327 | allocate(final_ngb_idx(size(ngb_idx))) 328 | n = 0 329 | do i = 1, size(ngb_idx) 330 | if (ngb_dist_opt(i) <= radius) then 331 | n = n + 1 332 | final_ngb_idx(n) = ngb_idx(i) 333 | end if 334 | end do 335 | deallocate(ngb_idx); allocate(ngb_idx(n)) 336 | do i = 1, n 337 | ngb_idx(i) = final_ngb_idx(i) 338 | end do 339 | deallocate(final_ngb_idx) 340 | if (present(ngb_dist)) then 341 | if (allocated(ngb_dist)) deallocate(ngb_dist) 342 | allocate(ngb_dist(n)) 343 | n = 0 344 | do i = 1, size(ngb_dist_opt) 345 | if (ngb_dist_opt(i) <= radius) then 346 | n = n + 1 347 | ngb_dist(n) = ngb_dist_opt(i) 348 | end if 349 | end do 350 | end if 351 | deallocate(ngb_dist_opt) 352 | 353 | end subroutine kdtree_range_search 354 | 355 | subroutine kdtree_final(this) 356 | 357 | type(kdtree_type), intent(inout) :: this 358 | 359 | if (associated(this%root_node)) deallocate(this%root_node) 360 | 361 | end subroutine kdtree_final 362 | 363 | subroutine record_potential_ngb_r4(ngb_count_opt, ngb_idx, ngb_dist, dist, global_idx) 364 | 365 | integer, intent(inout) :: ngb_count_opt 366 | integer, intent(inout) :: ngb_idx(:) 367 | real(4), intent(inout) :: ngb_dist(:) 368 | real(4), intent(in) :: dist 369 | integer, intent(in) :: global_idx 370 | 371 | integer i, j 372 | logical replaced 373 | 374 | ! This acts as a priority queue. 375 | replaced = .false. 376 | do i = 1, ngb_count_opt 377 | if (ngb_idx(i) == global_idx) return 378 | if (dist < ngb_dist(i)) then 379 | ngb_count_opt = min(ngb_count_opt + 1, size(ngb_idx)) 380 | do j = ngb_count_opt, i + 1, -1 381 | ngb_dist(j) = ngb_dist(j-1) 382 | ngb_idx (j) = ngb_idx (j-1) 383 | end do 384 | ngb_dist(i) = dist 385 | ngb_idx (i) = global_idx 386 | replaced = .true. 387 | exit 388 | end if 389 | end do 390 | if (.not. replaced .and. ngb_count_opt < size(ngb_idx)) then 391 | ngb_count_opt = ngb_count_opt + 1 392 | ngb_dist(ngb_count_opt) = dist 393 | ngb_idx (ngb_count_opt) = global_idx 394 | end if 395 | 396 | ! write(*, '("===== ", I0, X, I0)') global_idx 397 | ! do i = 1, ngb_count_opt 398 | ! write(*, '(I8)', advance='no') ngb_idx(i) 399 | ! if (mod(i, 20) == 0) write(*, *) 400 | ! end do 401 | ! write(*, *) 402 | ! do i = 1, ngb_count_opt 403 | ! write(*, '(F8.4)', advance='no') ngb_dist(i) 404 | ! if (mod(i, 20) == 0) write(*, *) 405 | ! end do 406 | ! write(*, *) 407 | ! pause 408 | 409 | end subroutine record_potential_ngb_r4 410 | 411 | subroutine record_potential_ngb_r8(ngb_count_opt, ngb_idx, ngb_dist, dist, global_idx) 412 | 413 | integer, intent(inout) :: ngb_count_opt 414 | integer, intent(inout) :: ngb_idx(:) 415 | real(8), intent(inout) :: ngb_dist(:) 416 | real(8), intent(in) :: dist 417 | integer, intent(in) :: global_idx 418 | 419 | integer i, j 420 | logical replaced 421 | 422 | ! This acts as a priority queue. 423 | replaced = .false. 424 | do i = 1, ngb_count_opt 425 | if (ngb_idx(i) == global_idx) return 426 | if (dist < ngb_dist(i)) then 427 | ngb_count_opt = min(ngb_count_opt + 1, size(ngb_idx)) 428 | do j = ngb_count_opt, i + 1, -1 429 | ngb_dist(j) = ngb_dist(j-1) 430 | ngb_idx (j) = ngb_idx (j-1) 431 | end do 432 | ngb_dist(i) = dist 433 | ngb_idx (i) = global_idx 434 | replaced = .true. 435 | exit 436 | end if 437 | end do 438 | if (.not. replaced .and. ngb_count_opt < size(ngb_idx)) then 439 | ngb_count_opt = ngb_count_opt + 1 440 | ngb_dist(ngb_count_opt) = dist 441 | ngb_idx (ngb_count_opt) = global_idx 442 | end if 443 | 444 | end subroutine record_potential_ngb_r8 445 | 446 | end module kdtree_mod 447 | -------------------------------------------------------------------------------- /src/kdtree_test.F90: -------------------------------------------------------------------------------- 1 | program kdtree_test 2 | 3 | use unit_test 4 | use node_placing_mod 5 | use kdtree 6 | 7 | implicit none 8 | 9 | integer num_seed 10 | integer, allocatable :: seed(:) 11 | type(kdtree_type) tree 12 | 13 | type(test_suite_type) test_suite 14 | 15 | call test_suite_init('KD-Tree test') 16 | 17 | ! Initialize random seeds. 18 | call random_seed(num_seed) 19 | allocate(seed(num_seed)) 20 | seed = 2 21 | call random_seed(put=seed) 22 | 23 | call test_case_create('Test 1D 1 of 10') 24 | call test_1d(10, 1) 25 | call test_case_create('Test 1D 2 of 10') 26 | call test_1d(10, 2) 27 | call test_case_create('Test 1D 3 of 10') 28 | call test_1d(10, 3) 29 | call test_case_create('Test 1D 4 of 10') 30 | call test_1d(10, 4) 31 | call test_case_create('Test 1D 5 of 10') 32 | call test_1d(10, 5) 33 | call test_case_create('Test 1D 6 of 10') 34 | call test_1d(10, 6) 35 | call test_case_create('Test 1D 7 of 10') 36 | call test_1d(10, 7) 37 | 38 | call test_case_create('Test 2D') 39 | 40 | call test_2d() 41 | call test_2d_range_search() 42 | 43 | call test_suite_report() 44 | 45 | call test_suite_final() 46 | 47 | deallocate(seed) 48 | 49 | contains 50 | 51 | subroutine test_1d(num_point, num_ngb) 52 | 53 | integer, intent(in) :: num_point 54 | integer, intent(in) :: num_ngb 55 | 56 | real(8), allocatable :: x(:,:) 57 | real(8), allocatable :: ngb_dist(:) 58 | integer, allocatable :: ngb_idx(:) 59 | integer i 60 | 61 | allocate(x(1,num_point)) 62 | allocate(ngb_dist(num_ngb)) 63 | allocate(ngb_idx(num_ngb)) 64 | 65 | do i = 1, size(x, 2) 66 | call random_number(x(1,i)) 67 | end do 68 | 69 | call tree%build(x) 70 | call tree%search([0.5d0], ngb_idx, ngb_dist=ngb_dist) 71 | 72 | do i = 1, size(x, 2) 73 | if (all(ngb_idx /= i)) then 74 | call assert_true(all(norm2(x(:,i) - [0.5d0]) > ngb_dist), __FILE__, __LINE__) 75 | end if 76 | end do 77 | 78 | deallocate(ngb_dist) 79 | deallocate(ngb_idx) 80 | 81 | end subroutine test_1d 82 | 83 | subroutine test_2d() 84 | 85 | real(8), allocatable :: x(:,:) 86 | real(8) ngb_dist(10) 87 | integer i, j, ngb_idx(10), fail_count 88 | 89 | call node_placing([0.0d0,1.0d0,0.0d0,1.0d0], radius, x) 90 | 91 | call tree%build(x) 92 | call tree%search([0.5d0,0.5d0], ngb_idx, ngb_dist=ngb_dist) 93 | 94 | do i = 1, size(x, 2) 95 | if (all(ngb_idx /= i)) then 96 | call assert_true(all(norm2(x(:,i) - [0.5d0,0.5d0]) > ngb_dist), __FILE__, __LINE__) 97 | end if 98 | end do 99 | 100 | fail_count = 0 101 | do j = 1, size(x, 2) 102 | call tree%search(x(:,j), ngb_idx, ngb_dist=ngb_dist) 103 | do i = 1, size(x, 2) 104 | if (all(ngb_idx /= i)) then 105 | if (.not. all(norm2(x(:,i) - x(:,j)) > ngb_dist)) then 106 | fail_count = fail_count + 1 107 | end if 108 | end if 109 | end do 110 | end do 111 | call assert_equal(fail_count, 0) 112 | 113 | end subroutine test_2d 114 | 115 | subroutine test_2d_range_search() 116 | 117 | real(8), allocatable :: x(:,:) 118 | real(8) :: x0(2) = [0.5d0,0.5d0], r = 0.02d0 119 | integer i, fail_count 120 | integer, allocatable :: ngb_idx(:) 121 | 122 | call node_placing([0.0d0,1.0d0,0.0d0,1.0d0], radius, x) 123 | 124 | call tree%build(x) 125 | call tree%range_search(x0, ngb_idx, r) 126 | 127 | fail_count = 0 128 | do i = 1, size(x, 2) 129 | if (norm2(x(:,i) - x0) < r .and. .not. any(ngb_idx == i)) then 130 | fail_count = fail_count + 1 131 | end if 132 | end do 133 | call assert_equal(fail_count, 0) 134 | 135 | deallocate(ngb_idx) 136 | 137 | end subroutine test_2d_range_search 138 | 139 | real(8) function radius(x) 140 | 141 | real(8), intent(in) :: x(2) 142 | 143 | radius = 0.008d0 144 | 145 | end function radius 146 | 147 | end program kdtree_test 148 | -------------------------------------------------------------------------------- /src/kdtree_utils_mod.F90: -------------------------------------------------------------------------------- 1 | module kdtree_utils_mod 2 | 3 | use qsort_mod 4 | 5 | implicit none 6 | 7 | interface median 8 | module procedure median_r4 9 | module procedure median_r8 10 | end interface median 11 | 12 | interface variance 13 | module procedure variance_r4 14 | module procedure variance_r8 15 | end interface variance 16 | 17 | contains 18 | 19 | real(4) function median_r4(x) result(res) 20 | 21 | real(4), intent(in) :: x(:) 22 | 23 | ! NOTE: We do not deallocate tmp, let OS withdraw the memory. 24 | real(4), allocatable, save :: tmp(:) 25 | 26 | if (allocated(tmp)) then 27 | if (size(tmp) < size(x)) then 28 | deallocate(tmp) 29 | allocate(tmp(size(x))) 30 | end if 31 | else 32 | allocate(tmp(size(x))) 33 | end if 34 | tmp(:size(x)) = x; call qsort(tmp(:size(x))) 35 | ! NOTE: Plus 1 to avoid 0 index. 36 | res = tmp(int(size(x) * 0.5) + 1) 37 | 38 | end function median_r4 39 | 40 | real(8) function median_r8(x) result(res) 41 | 42 | real(8), intent(in) :: x(:) 43 | 44 | ! NOTE: We do not deallocate tmp, let OS withdraw the memory. 45 | real(8), allocatable, save :: tmp(:) 46 | 47 | if (allocated(tmp)) then 48 | if (size(tmp) < size(x)) then 49 | deallocate(tmp) 50 | allocate(tmp(size(x))) 51 | end if 52 | else 53 | allocate(tmp(size(x))) 54 | end if 55 | tmp(:size(x)) = x; call qsort(tmp(:size(x))) 56 | ! NOTE: Plus 1 to avoid 0 index. 57 | res = tmp(int(size(x) * 0.5) + 1) 58 | 59 | end function median_r8 60 | 61 | real(4) function variance_r4(x) result(res) 62 | 63 | real(4), intent(in) :: x(:) 64 | 65 | real(4) xa 66 | 67 | xa = sum(x) / size(x) 68 | res = sum((x - xa)**2) / size(x) 69 | 70 | end function variance_r4 71 | 72 | real(8) function variance_r8(x) result(res) 73 | 74 | real(8), intent(in) :: x(:) 75 | 76 | real(8) xa 77 | 78 | xa = sum(x) / size(x) 79 | res = sum((x - xa)**2) / size(x) 80 | 81 | end function variance_r8 82 | 83 | end module kdtree_utils_mod 84 | -------------------------------------------------------------------------------- /src/node_mod.F90: -------------------------------------------------------------------------------- 1 | module node_mod 2 | 3 | implicit none 4 | 5 | private 6 | 7 | public node_type 8 | 9 | type node_type 10 | integer :: id = 1 11 | integer :: part_dim = 0 12 | real(8), allocatable :: x(:) 13 | integer global_idx 14 | integer :: num_point = 0 15 | ! The following two arrays are used at build time, after that they will be descarded. 16 | real(8), allocatable :: x_array(:,:) 17 | integer, allocatable :: global_idx_array(:) 18 | type(node_type), pointer :: parent => null() 19 | type(node_type), pointer :: left => null() 20 | type(node_type), pointer :: right => null() 21 | contains 22 | procedure :: init => node_init 23 | procedure :: create_child_nodes => node_create_child_nodes 24 | procedure :: add_point => node_add_point 25 | procedure :: end_point => node_end_point 26 | procedure :: discard_arrays => node_discard_arrays 27 | final :: node_final 28 | end type node_type 29 | 30 | contains 31 | 32 | subroutine node_init(this, num_dim, max_num_point, parent) 33 | 34 | class(node_type), intent(inout) :: this 35 | integer, intent(in), optional :: num_dim 36 | integer, intent(in), optional :: max_num_point 37 | type(node_type), intent(in), target, optional :: parent 38 | 39 | if (allocated(this%x )) deallocate(this%x ) 40 | if (allocated(this%x_array )) deallocate(this%x_array ) 41 | if (allocated(this%global_idx_array)) deallocate(this%global_idx_array) 42 | if (present(num_dim) .and. present(max_num_point)) then 43 | allocate(this%x (num_dim )) 44 | allocate(this%x_array (num_dim,max_num_point)) 45 | allocate(this%global_idx_array( max_num_point)) 46 | end if 47 | if (present(parent )) this%parent => parent 48 | 49 | end subroutine node_init 50 | 51 | subroutine node_create_child_nodes(this, part_dim, num_dim, max_num_point) 52 | 53 | class(node_type), intent(inout) :: this 54 | integer, intent(in) :: part_dim 55 | integer, intent(in) :: num_dim 56 | integer, intent(in) :: max_num_point 57 | 58 | this%part_dim = part_dim 59 | 60 | if (associated(this%left )) deallocate(this%left ) 61 | if (associated(this%right)) deallocate(this%right) 62 | allocate(this%left) 63 | allocate(this%right) 64 | 65 | this%left %id = this%id * 10 66 | this%right%id = this%id * 10 + 1 67 | 68 | call this%left %init(num_dim, max_num_point, this) 69 | call this%right%init(num_dim, max_num_point, this) 70 | 71 | end subroutine node_create_child_nodes 72 | 73 | subroutine node_add_point(this, x, global_idx) 74 | 75 | class(node_type), intent(inout) :: this 76 | real(8), intent(in) :: x(:) 77 | integer, intent(in) :: global_idx 78 | 79 | this%num_point = this%num_point + 1 80 | if (this%num_point > size(this%x_array, 2)) then 81 | write(*, '("[Error]: ", A, ":", I0, ":", A)') __FILE__, __LINE__, 'Array size is not sufficient!' 82 | stop 1 83 | end if 84 | this%x_array(:,this%num_point) = x 85 | this%global_idx_array(this%num_point) = global_idx 86 | 87 | end subroutine node_add_point 88 | 89 | subroutine node_end_point(this) 90 | 91 | class(node_type), intent(inout) :: this 92 | 93 | real(8), allocatable :: rtmp(:,:) 94 | integer, allocatable :: itmp(:) 95 | integer m, n, i, j 96 | 97 | if (this%num_point > 0) then 98 | m = size(this%x_array, 1) 99 | n = this%num_point 100 | 101 | allocate(rtmp(m,n)) 102 | allocate(itmp( n)) 103 | 104 | do j = 1, n 105 | do i = 1, m 106 | rtmp(i,j) = this%x_array(i,j) 107 | end do 108 | itmp(j) = this%global_idx_array(j) 109 | end do 110 | 111 | deallocate(this%x_array ) 112 | deallocate(this%global_idx_array) 113 | 114 | allocate(this%x_array (m,n)) 115 | allocate(this%global_idx_array( n)) 116 | 117 | this%x_array = rtmp 118 | this%global_idx_array = itmp 119 | 120 | deallocate(rtmp) 121 | deallocate(itmp) 122 | end if 123 | 124 | end subroutine node_end_point 125 | 126 | subroutine node_discard_arrays(this) 127 | 128 | ! Discard arrays since they are no longer needed. 129 | 130 | class(node_type), intent(inout) :: this 131 | 132 | if (allocated(this%x_array )) deallocate(this%x_array ) 133 | if (allocated(this%global_idx_array)) deallocate(this%global_idx_array) 134 | 135 | end subroutine node_discard_arrays 136 | 137 | recursive subroutine node_final(this) 138 | 139 | type(node_type), intent(inout) :: this 140 | 141 | if (allocated(this%x )) deallocate(this%x ) 142 | if (allocated(this%x_array )) deallocate(this%x_array ) 143 | if (allocated(this%global_idx_array)) deallocate(this%global_idx_array) 144 | if (associated(this%left )) deallocate(this%left ) 145 | if (associated(this%right )) deallocate(this%right ) 146 | 147 | end subroutine node_final 148 | 149 | end module node_mod 150 | -------------------------------------------------------------------------------- /src/node_placing_mod.F90: -------------------------------------------------------------------------------- 1 | module node_placing_mod 2 | 3 | ! This module implement the "node-placing" algorithm to generate 2D grids. 4 | ! 5 | ! Reference: 6 | ! 7 | ! - Fornberg, Bengt and Flyer, Natasha, 2015: Fast generation of 2-D node 8 | ! distributions for mesh-free PDE discretizations. Computer & Mathematics 9 | ! with Applications, 69, 531-544. 10 | 11 | implicit none 12 | 13 | private 14 | 15 | public node_placing 16 | 17 | interface 18 | real(8) function node_radius_interface(x) 19 | real(8), intent(in) :: x(2) 20 | end function node_radius_interface 21 | end interface 22 | 23 | real(8), parameter :: pi = atan(1.0d0) * 4.0d0 24 | integer, parameter :: adj_num_pdp = 5 ! Adjust PDP number 25 | 26 | contains 27 | 28 | subroutine node_placing(box, radius, xy, init_num_node) 29 | 30 | real(8), intent(in) :: box(4) 31 | procedure(node_radius_interface) radius 32 | real(8), intent(out), allocatable :: xy(:,:) 33 | integer, intent(in), optional :: init_num_node 34 | 35 | integer init_num_node_opt ! Initial guessed node number 36 | integer num_node ! Node number 37 | integer num_pdp ! PDP number 38 | integer i, im(1), nw 39 | integer outside_count ! Counter for PDPs that are outside box 40 | integer idx_left ! Leftmost index of PDP within the radius of a grid 41 | integer idx_right ! Rightmost index of PDP within the radius of a grid 42 | real(8) rand, dx 43 | real(8) r ! Radius or resolution of grid 44 | real(8) ym(1) ! Minimum y in PDPs 45 | real(8) d ! Distance between placed node and PDPs 46 | real(8) angle_left 47 | real(8) angle_right 48 | real(8) angle 49 | real(8), allocatable :: pdp(:,:) 50 | 51 | if (allocated(xy)) deallocate(xy) 52 | 53 | ! Set the initial node number. 54 | init_num_node_opt = 10000; if (present(init_num_node)) init_num_node_opt = init_num_node 55 | 56 | num_node = 0 57 | num_pdp = init_num_node_opt 58 | allocate(pdp(2,init_num_node_opt)) ! Allocate more memory to accommodate increasing PDPs. 59 | allocate(xy (2,init_num_node_opt)) 60 | 61 | ! Place initial PDPs along bottom. 62 | dx = (box(2) - box(1)) / num_pdp 63 | do i = 1, num_pdp 64 | pdp(1,i) = box(1) + dx * (i - 0.5) 65 | call random_number(rand) 66 | pdp(2,i) = box(3) + 1.0d-4 * rand 67 | end do 68 | 69 | ! Find the lowest PDP. 70 | ym = minval(pdp(2,:num_pdp)); im = minloc(pdp(2,:num_pdp)) 71 | do while (ym(1) <= box(4)) 72 | num_node = num_node + 1 73 | ! Assign the lowest PDP as a node. 74 | xy(:,num_node) = pdp(:,im(1)) 75 | r = radius(xy(:,num_node)) 76 | idx_left = 0; idx_right = 0 77 | do i = 1, num_pdp 78 | d = norm2(pdp(:,i) - xy(:,num_node)) 79 | if (d <= r) then 80 | if (idx_left == 0) idx_left = i 81 | idx_right = i 82 | end if 83 | end do 84 | if (idx_left >= im(1)) idx_left = im(1) - 1 85 | if (idx_left < 1) then 86 | idx_left = im(1) 87 | angle_left = pi 88 | else 89 | angle_left = atan2(pdp(2,idx_left) - xy(2,num_node), pdp(1,idx_left) - xy(1,num_node)) 90 | end if 91 | if (idx_right <= im(1)) idx_right = im(1) + 1 92 | if (idx_right > num_pdp) then 93 | idx_right = im(1) 94 | angle_right = 0.0d0 95 | else 96 | angle_right = atan2(pdp(2,idx_right) - xy(2,num_node), pdp(1,idx_right) - xy(1,num_node)) 97 | end if 98 | nw = idx_right - idx_left + 1 99 | if (nw > adj_num_pdp) then 100 | ! There are more PDPs contained in the circle. 101 | do i = idx_left + adj_num_pdp, num_pdp - nw + adj_num_pdp 102 | pdp(:,i) = pdp(:,i+nw-adj_num_pdp) 103 | end do 104 | else if (nw < adj_num_pdp) then 105 | ! There are less PDPs contained in the circle. 106 | do i = num_pdp - nw + adj_num_pdp, idx_left + adj_num_pdp, -1 107 | pdp(:,i) = pdp(:,i+nw-adj_num_pdp) 108 | end do 109 | end if 110 | ! Push PDPs toward top. 111 | do i = 0, adj_num_pdp - 1 112 | angle = angle_left - (2 * i + 1) * 0.1 * (angle_left - angle_right) 113 | pdp(1,idx_left+i) = xy(1,num_node) + r * cos(angle) 114 | pdp(2,idx_left+i) = xy(2,num_node) + r * sin(angle) 115 | end do 116 | num_pdp = num_pdp - nw + adj_num_pdp 117 | ! Remove PDPs outside box. 118 | outside_count = count(pdp(1,:) < box(1) .or. pdp(1,:) > box(2)) 119 | if (outside_count > 0) then 120 | num_pdp = num_pdp - outside_count 121 | pdp(2,:) = pack(pdp(2,:), pdp(1,:) >= box(1) .and. pdp(1,:) <= box(2)) 122 | pdp(1,:) = pack(pdp(1,:), pdp(1,:) >= box(1) .and. pdp(1,:) <= box(2)) 123 | end if 124 | ! Find the next lowest PDP. 125 | ym = minval(pdp(2,:num_pdp)); im = minloc(pdp(2,:num_pdp)) 126 | ! Enlarge array size if necessary. 127 | if (num_node == init_num_node_opt) then 128 | init_num_node_opt = init_num_node_opt * 2 129 | call resize_array(xy, dim=2, new_size=init_num_node_opt) 130 | end if 131 | end do 132 | 133 | ! Clean zeros from output array. 134 | call resize_array(xy, dim=2, new_size=num_node) 135 | 136 | deallocate(pdp) 137 | 138 | end subroutine node_placing 139 | 140 | subroutine resize_array(x, dim, new_size) 141 | 142 | real(8), intent(inout), allocatable :: x(:,:) 143 | integer, intent(in) :: dim 144 | integer, intent(in) :: new_size 145 | 146 | real(8), allocatable :: y(:,:) 147 | integer nx(2), ny(2), i 148 | 149 | nx = shape(x) 150 | ny = nx 151 | ny(dim) = new_size 152 | 153 | allocate(y(ny(1),ny(2))) 154 | 155 | if (nx(dim) <= ny(dim)) then 156 | y(:nx(1),:nx(2)) = x(:nx(1),:nx(2)) 157 | else 158 | y(:ny(1),:ny(2)) = x(:ny(1),:ny(2)) 159 | end if 160 | 161 | deallocate(x) 162 | 163 | allocate(x(ny(1),ny(2))) 164 | 165 | x = y 166 | 167 | deallocate(y) 168 | 169 | end subroutine resize_array 170 | 171 | subroutine debug_write(num_pdp, pdp, num_node, node) 172 | 173 | integer, intent(in) :: num_pdp 174 | real(8), intent(in) :: pdp(:,:) 175 | integer, intent(in) :: num_node 176 | real(8), intent(in) :: node(:,:) 177 | 178 | character(10) tag 179 | integer i 180 | 181 | write(tag, '(I0)') num_node 182 | 183 | open(10, file='node_placing.pdp.' // trim(tag) // '.txt') 184 | do i = 1, num_pdp 185 | write(10, *) pdp(:,i) 186 | end do 187 | close(10) 188 | 189 | open(10, file='node_placing.node.' // trim(tag) // '.txt') 190 | do i = 1, num_node 191 | write(10, *) node(:,i) 192 | end do 193 | close(10) 194 | 195 | end subroutine debug_write 196 | 197 | end module node_placing_mod 198 | -------------------------------------------------------------------------------- /src/qsort_mod.F90: -------------------------------------------------------------------------------- 1 | module qsort_mod 2 | 3 | implicit none 4 | 5 | private 6 | 7 | public qsort 8 | 9 | interface qsort 10 | module procedure qsort_r4 11 | module procedure qsort_r8 12 | end interface qsort 13 | 14 | contains 15 | 16 | recursive subroutine qsort_r4(x, left_idx, right_idx) 17 | 18 | real(4), intent(inout) :: x(:) 19 | integer, intent(in), optional :: left_idx 20 | integer, intent(in), optional :: right_idx 21 | 22 | 23 | integer left_idx_opt, right_idx_opt, i, j 24 | real(4) tmp, x0 25 | 26 | left_idx_opt = 1 ; if (present(left_idx )) left_idx_opt = left_idx 27 | right_idx_opt = size(x); if (present(right_idx)) right_idx_opt = right_idx 28 | 29 | x0 = x((left_idx_opt + right_idx_opt) / 2) 30 | i = left_idx_opt; j = right_idx_opt 31 | do 32 | do while (x(i) < x0) 33 | i = i + 1 34 | end do 35 | do while (x(j) > x0) 36 | j = j - 1 37 | end do 38 | if (i >= j) exit 39 | tmp = x(i); x(i) = x(j); x(j) = tmp 40 | i = i + 1; j = j - 1 41 | end do 42 | 43 | if (left_idx_opt < i - 1) call qsort(x, left_idx_opt, i - 1) 44 | if (j + 1 < right_idx_opt) call qsort(x, j + 1, right_idx_opt) 45 | 46 | end subroutine qsort_r4 47 | 48 | recursive subroutine qsort_r8(x, left_idx, right_idx) 49 | 50 | real(8), intent(inout) :: x(:) 51 | integer, intent(in), optional :: left_idx 52 | integer, intent(in), optional :: right_idx 53 | 54 | 55 | integer left_idx_opt, right_idx_opt, i, j 56 | real(8) tmp, x0 57 | 58 | left_idx_opt = 1 ; if (present(left_idx )) left_idx_opt = left_idx 59 | right_idx_opt = size(x); if (present(right_idx)) right_idx_opt = right_idx 60 | 61 | x0 = x((left_idx_opt + right_idx_opt) / 2) 62 | i = left_idx_opt; j = right_idx_opt 63 | do 64 | do while (x(i) < x0) 65 | i = i + 1 66 | end do 67 | do while (x(j) > x0) 68 | j = j - 1 69 | end do 70 | if (i >= j) exit 71 | tmp = x(i); x(i) = x(j); x(j) = tmp 72 | i = i + 1; j = j - 1 73 | end do 74 | 75 | if (left_idx_opt < i - 1) call qsort(x, left_idx_opt, i - 1) 76 | if (j + 1 < right_idx_opt) call qsort(x, j + 1, right_idx_opt) 77 | 78 | end subroutine qsort_r8 79 | 80 | end module qsort_mod 81 | -------------------------------------------------------------------------------- /tools/plot_kdtree_2d_search.ncl: -------------------------------------------------------------------------------- 1 | if (.not. isdefined("tag")) then 2 | print("Argument tag is needed!") 3 | exit 4 | end if 5 | 6 | if (.not. isdefined("ngb")) then 7 | print("Argument ngb is needed!") 8 | exit 9 | end if 10 | ngb = ngb - 1 11 | 12 | wks = gsn_open_wks("pdf", "kdtree_2d") 13 | 14 | node_file_path = "node_placing.node." + sprinti("%d", tag) + ".txt" 15 | node := asciiread(node_file_path, (/numAsciiRow(node_file_path),2/), "float") 16 | 17 | res = True 18 | res@gsnDraw = False 19 | res@gsnFrame = False 20 | res@trXMinF = 0.0 21 | res@trXMaxF = 1.0 22 | res@trYMinF = 0.0 23 | res@trYMaxF = 1.0 24 | 25 | res_node = True 26 | res_node@gsMarkerColor = "blue" 27 | res_node@gsMarkerSizeF = 10.0 28 | 29 | res_ngb = True 30 | res_ngb@gsMarkerColor = "red" 31 | res_ngb@gsMarkerSizeF = 10.0 32 | res_ngb@gsMarkerIndex = 4 33 | 34 | base = gsn_blank_plot(wks, res) 35 | 36 | plot_node = gsn_add_polymarker(wks, base, node(:,0), node(:,1), res_node) 37 | 38 | plot_ngb = gsn_add_polymarker(wks, base, node(ngb,0), node(ngb,1), res_ngb) 39 | 40 | res_query = True 41 | res_query@gsMarkerSizeF = 10.0 42 | res_query@gsMarkerIndex = 12 43 | 44 | plot_query = gsn_add_polymarker(wks, base, (/0.5/), (/0.5/), res_query) 45 | 46 | draw(base) 47 | frame(wks) 48 | -------------------------------------------------------------------------------- /tools/plot_node_placing.ncl: -------------------------------------------------------------------------------- 1 | wks = gsn_open_wks("pdf", "node_placing") 2 | 3 | do tag = 1, 380 4 | pdp_file_path = "node_placing.pdp." + sprinti("%d", tag) + ".txt" 5 | pdp := asciiread(pdp_file_path, (/numAsciiRow(pdp_file_path),2/), "float") 6 | 7 | node_file_path = "node_placing.node." + sprinti("%d", tag) + ".txt" 8 | node := asciiread(node_file_path, (/numAsciiRow(node_file_path),2/), "float") 9 | 10 | res = True 11 | res@gsnDraw = False 12 | res@gsnFrame = False 13 | res@trXMinF = 0.0 14 | res@trXMaxF = 1.0 15 | res@trYMinF = 0.0 16 | res@trYMaxF = 1.0 17 | 18 | res_pdp = True 19 | res_pdp@gsMarkerColor = "red" 20 | res_pdp@gsMarkerSizeF = 10.0 21 | 22 | res_node = True 23 | res_node@gsMarkerColor = "blue" 24 | res_node@gsMarkerSizeF = 10.0 25 | 26 | base = gsn_blank_plot(wks, res) 27 | 28 | plot_pdp = gsn_add_polymarker(wks, base, pdp(:,0), pdp(:,1), res_pdp) 29 | 30 | plot_node = gsn_add_polymarker(wks, base, node(:,0), node(:,1), res_node) 31 | 32 | draw(base) 33 | frame(wks) 34 | end do 35 | --------------------------------------------------------------------------------