FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_pair_array.f90
Go to the documentation of this file.
2 use hecmw_util
3
4 private
5
6 public :: hecmwst_pair_array
10 public :: hecmw_pair_array_sort
12
13 type hecmwst_pair
14 integer(kind=kint) :: id
15 integer(kind=kint) :: i1, i2
16 end type hecmwst_pair
17
19 integer(kind=kint) :: num
20 integer(kind=kint) :: max_num
21 type (hecmwst_pair), pointer :: pairs(:) => null()
22 end type hecmwst_pair_array
23
24contains
25
26 subroutine hecmw_pair_array_init(parray, max_num)
27 implicit none
28 type (hecmwst_pair_array), intent(inout) :: parray
29 integer(kind=kint), intent(in) :: max_num
30 !if (associated(parray%pairs)) deallocate(parray%pairs)
31 allocate(parray%pairs(max_num))
32 parray%max_num = max_num
33 parray%num = 0
34 end subroutine hecmw_pair_array_init
35
36 subroutine hecmw_pair_array_finalize(parray)
37 implicit none
38 type (hecmwst_pair_array), intent(inout) :: parray
39 if (associated(parray%pairs)) deallocate(parray%pairs)
40 parray%max_num = 0
41 parray%num = 0
42 end subroutine hecmw_pair_array_finalize
43
44 subroutine hecmw_pair_array_append(parray, id, i1, i2)
45 implicit none
46 type (hecmwst_pair_array), intent(inout) :: parray
47 integer(kind=kint), intent(in) :: id, i1, i2
48 if (parray%num >= parray%max_num) then
49 stop 'ERROR: hecmw_pair_array_append: overflow'
50 endif
51 parray%num = parray%num + 1
52 parray%pairs(parray%num)%id = id
53 parray%pairs(parray%num)%i1 = i1
54 parray%pairs(parray%num)%i2 = i2
55 end subroutine hecmw_pair_array_append
56
57 subroutine hecmw_pair_array_sort(parray)
58 implicit none
59 type (hecmwst_pair_array), intent(inout) :: parray
60 call pairs_sort(parray%pairs, 1, parray%num)
61 end subroutine hecmw_pair_array_sort
62
63 function hecmw_pair_array_find_id(parray, i1, i2)
64 implicit none
65 integer(kind=kint) :: hecmw_pair_array_find_id
66 type (hecmwst_pair_array), intent(inout) :: parray
67 integer(kind=kint), intent(in) :: i1, i2
68 type (hecmwst_pair) :: p
69 integer(kind=kint) :: id
70 p%i1 = i1
71 p%i2 = i2
72 call pairs_find(parray%pairs, 1, parray%num, p, id)
74 end function hecmw_pair_array_find_id
75
76 function pairs_comp(p1, p2)
77 implicit none
78 integer(kind=kint) :: pairs_comp
79 type (hecmwst_pair), intent(in) :: p1, p2
80 if (p1%i1 < p2%i1) then
81 pairs_comp = -1
82 else if (p1%i1 > p2%i1) then
83 pairs_comp = 1
84 else
85 if (p1%i2 < p2%i2) then
86 pairs_comp = -1
87 else if (p1%i2 > p2%i2) then
88 pairs_comp = 1
89 else
90 pairs_comp = 0
91 endif
92 endif
93 end function pairs_comp
94
95 recursive subroutine pairs_sort(pairs, from, to)
96 implicit none
97 type (hecmwst_pair), pointer :: pairs(:)
98 integer(kind=kint), intent(in) :: from, to
99 integer(kind=kint) :: center, left, right
100 type (hecmwst_pair) :: pivot, tmp
101 if (from >= to) return
102 center = (from + to) / 2
103 pivot = pairs(center)
104 left = from
105 right = to
106 do
107 do while (pairs_comp(pairs(left), pivot) < 0)
108 left = left + 1
109 enddo
110 do while (pairs_comp(pivot, pairs(right)) < 0)
111 right = right - 1
112 enddo
113 if (left >= right) exit
114 tmp = pairs(left)
115 pairs(left) = pairs(right)
116 pairs(right) = tmp
117 left = left + 1
118 right = right - 1
119 enddo
120 if (from < left-1) call pairs_sort(pairs, from, left-1)
121 if (right+1 < to) call pairs_sort(pairs, right+1, to)
122 return
123 end subroutine pairs_sort
124
125 recursive subroutine pairs_find(pairs, from, to, p, id)
126 implicit none
127 type (hecmwst_pair), pointer :: pairs(:)
128 integer(kind=kint), intent(in) :: from, to
129 type (hecmwst_pair), intent(in) :: p
130 integer(kind=kint), intent(out) :: id
131 integer(kind=kint) :: center, icomp
132 if (from > to) then
133 id = -1
134 return
135 endif
136 center = (from + to) / 2
137 icomp = pairs_comp(p, pairs(center))
138 if (icomp < 0) then
139 call pairs_find(pairs, from, center-1, p, id)
140 return
141 else if (icomp > 0) then
142 call pairs_find(pairs, center+1, to, p, id)
143 return
144 else
145 id = pairs(center)%id
146 return
147 endif
148 end subroutine pairs_find
149
150end module hecmw_pair_array
subroutine, public hecmw_pair_array_append(parray, id, i1, i2)
subroutine, public hecmw_pair_array_finalize(parray)
integer(kind=kint) function, public hecmw_pair_array_find_id(parray, i1, i2)
subroutine, public hecmw_pair_array_init(parray, max_num)
subroutine, public hecmw_pair_array_sort(parray)
I/O and Utility.
Definition: hecmw_util_f.F90:7