FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_array_util.f90
Go to the documentation of this file.
1!-------------------------------------------------------------------------------
2! Copyright (c) 2019 FrontISTR Commons
3! This software is released under the MIT License, see LICENSE.txt
4!-------------------------------------------------------------------------------
5
7 use hecmw_util
8 implicit none
9
10 private
11 public :: hecmw_qsort_int_array
12 public :: hecmw_uniq_int_array
14
15contains
16
17 recursive subroutine hecmw_qsort_int_array(array, istart, iend)
18 implicit none
19 integer(kind=kint), intent(inout) :: array(:)
20 integer(kind=kint), intent(in) :: istart, iend
21 integer(kind=kint) :: left, right, center
22 integer(kind=kint) :: pivot, tmp
23 if (istart >= iend) return
24 center = (istart + iend) / 2
25 pivot = array(center)
26 left = istart
27 right = iend
28 do
29 do while (array(left) < pivot)
30 left = left + 1
31 end do
32 do while (pivot < array(right))
33 right = right - 1
34 end do
35 if (left >= right) exit
36 tmp = array(left)
37 array(left) = array(right)
38 array(right) = tmp
39 left = left + 1
40 right = right - 1
41 end do
42 if (istart < left-1) call hecmw_qsort_int_array(array, istart, left-1)
43 if (right+1 < iend) call hecmw_qsort_int_array(array, right+1, iend)
44 end subroutine hecmw_qsort_int_array
45
46 subroutine hecmw_uniq_int_array(array, istart, iend, ndup)
47 implicit none
48 integer(kind=kint), intent(inout) :: array(:)
49 integer(kind=kint), intent(in) :: istart, iend
50 integer(kind=kint), intent(out) :: ndup
51 integer(kind=kint) :: i
52 ndup = 0
53 do i = istart+1, iend
54 if (array(i) == array(i - 1 - ndup)) then
55 ndup = ndup + 1
56 else if (ndup > 0) then
57 array(i - ndup) = array(i)
58 endif
59 end do
60 end subroutine hecmw_uniq_int_array
61
62 subroutine hecmw_bsearch_int_array(array, istart, iend, val, idx)
63 implicit none
64 integer(kind=kint), intent(in) :: array(:)
65 integer(kind=kint), intent(in) :: istart, iend
66 integer(kind=kint), intent(in) :: val
67 integer(kind=kint), intent(out) :: idx
68 integer(kind=kint) :: center, left, right, pivot
69 left = istart
70 right = iend
71 do
72 if (left > right) then
73 idx = -1
74 exit
75 end if
76 center = (left + right) / 2
77 pivot = array(center)
78 if (val < pivot) then
79 right = center - 1
80 cycle
81 else if (pivot < val) then
82 left = center + 1
83 cycle
84 else ! if (pivot == val) then
85 idx = center
86 exit
87 end if
88 end do
89 end subroutine hecmw_bsearch_int_array
90
91end module hecmw_array_util
subroutine, public hecmw_bsearch_int_array(array, istart, iend, val, idx)
recursive subroutine, public hecmw_qsort_int_array(array, istart, iend)
subroutine, public hecmw_uniq_int_array(array, istart, iend, ndup)
I/O and Utility.
Definition: hecmw_util_f.F90:7