FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_adapt_edge_comm_table.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!-------------------------------------------------------------------------------
6
7!C
8!C***
9!C*** hecmw_adapt_edge_comm_table
10!C***
11!C
12!C global edge information
13!C edge-based communication table
14!C
15subroutine hecmw_adapt_edge_comm_table (hecMESH)
16
17 use hecmw_util
20
21 implicit real*8 (a-h,o-z)
22
23 integer(kind=kint ), pointer :: wSI(:), wSE(:)
24 integer(kind=kint ), pointer :: wiIa(:), wiEa(:), wiIb(:), wiEb(:)
25 integer(kind=kint ), dimension(:), allocatable :: IW1, IW2
26
27 type (hecmwST_local_mesh) :: hecMESH
28
29 !C
30 !C +-------------------------+
31 !C | EDGE related parameters |
32 !C +-------------------------+
33 !C===
34 allocate (hecmesh%adapt_iemb (hecmesh%n_adapt_edge), &
35 & hecmesh%adapt_mid_edge(hecmesh%n_adapt_edge))
36 hecmesh%adapt_iemb = 0
37 hecmesh%adapt_mid_edge= 0
38
39 allocate (hecmesh%rev_neighbor_pe(0:hecmesh%n_neighbor_pe))
40
41 hecmesh%rev_neighbor_pe(hecmesh%my_rank)= 0
42 do neib= 1, hecmesh%n_neighbor_pe
43 hecmesh%rev_neighbor_pe(hecmesh%neighbor_pe(neib))= neib
44 enddo
45
46 allocate (hecmesh%adapt_act_elem_341(hecmesh%n_adapt_elem_341))
47 allocate (hecmesh%adapt_act_elem_351(hecmesh%n_adapt_elem_351))
48
49 icouta= 0
50 icoupa= 0
51 do icel= 1, hecmesh%n_elem
52 ityp= hecmesh%elem_type(icel)
53 !C
54 !C-- TETRAHEDRA : active
55 if (ityp.eq.341) then
56 if (hecmesh%adapt_type(icel).eq.0) then
57 icouta = icouta + 1
58 hecmesh%adapt_act_elem_341(icouta)= icel
59 endif
60 endif
61 !C
62 !C-- PRISMS : active
63 if (ityp.eq.351) then
64 if (hecmesh%adapt_type(icel).eq.0) then
65 icoupa = icoupa + 1
66 hecmesh%adapt_act_elem_351(icoupa)= icel
67 endif
68 endif
69 enddo
70
71 hecmesh%n_adapt_act_elem_341= icouta
72 hecmesh%n_adapt_act_elem_351= icoupa
73 !C===
74 !C
75 !C +---------------+
76 !C | Global EDGE # |
77 !C +---------------+
78 !C===
79 nnn= 0
80 do ie= 1, hecmesh%n_adapt_edge
81 if (hecmesh%adapt_edge_home(ie).eq.hecmesh%my_rank) nnn= nnn + 1
82 enddo
83 hecmesh%n_adapt_edge_global= hecmesh%n_adapt_act_edge
84
85 call hecmw_allreduce_i (hecmesh, hecmesh%n_adapt_edge_global, 1, hecmw_sum)
86 !C===
87
88 !C
89 !C +-----------------------------+
90 !C | prepare EXTERNAL edge info. |
91 !C +-----------------------------+
92 !C===
93
94 !C
95 !C-- init.
96 neibpetot= hecmesh%n_neighbor_pe
97
98 allocate (iw1(hecmesh%n_neighbor_pe))
99 allocate (wse(0:hecmesh%n_neighbor_pe), wsi(0:hecmesh%n_neighbor_pe))
100 iw1 = 0
101 wse = 0
102 wsi = 0
103
104 !C
105 !C-- search IMPORT items
106 do ie= 1, hecmesh%n_adapt_edge
107 ih= hecmesh%adapt_edge_home(ie)
108 if (ih.ne.hecmesh%my_rank) then
109 ihr = hecmesh%rev_neighbor_pe(ih)
110 wsi(ihr)= wsi(ihr) + 1
111 endif
112 enddo
113 !C
114 !C-- exchange INFO. on IMPORT item #
115 stime0= mpi_wtime()
117 & ( hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, wsi, wse, &
118 & hecmesh%MPI_COMM, hecmesh%my_rank)
119 etime0= mpi_wtime()
120 commtime= commtime + etime0 - stime0
121
122 !C
123 !C-- IMPORT/EXPORT item #
124 do neib= 1, hecmesh%n_neighbor_pe
125 wsi(neib)= wsi(neib-1) + wsi(neib)
126 wse(neib)= wse(neib-1) + wse(neib)
127 enddo
128
129 !C
130 !C-- send as IMPORT/recv. as EXPORT
131 allocate (wiia(wsi(hecmesh%n_neighbor_pe)*4))
132 allocate (wiea(wse(hecmesh%n_neighbor_pe)*4))
133 allocate (wiib(wsi(hecmesh%n_neighbor_pe) ))
134 allocate (wieb(wse(hecmesh%n_neighbor_pe) ))
135 ! JF
136 wiia=0
137 wiea=0
138 wiib=0
139 wieb=0
140
141 do ie= 1, hecmesh%n_adapt_edge
142 ih= hecmesh%adapt_edge_home(ie)
143
144 if (ih.ne.hecmesh%my_rank) then
145 ihr = hecmesh%rev_neighbor_pe(ih)
146 iw1(ihr ) = iw1(ihr) + 1
147 is = wsi(ihr-1)+iw1(ihr)
148
149 in1= hecmesh%adapt_edge_node(2*ie-1)
150 in2= hecmesh%adapt_edge_node(2*ie )
151
152 wiia(4*is-3)= hecmesh%node_ID(2*in1 )
153 wiia(4*is-2)= hecmesh%node_ID(2*in1-1)
154 wiia(4*is-1)= hecmesh%node_ID(2*in2 )
155 wiia(4*is )= hecmesh%node_ID(2*in2-1)
156 endif
157 enddo
158
159 len= max(wsi(hecmesh%n_neighbor_pe),wse(hecmesh%n_neighbor_pe), &
160 & hecmesh%n_adapt_edge)
161
162 deallocate (iw1)
163 allocate (iw1(len*4), iw2(len*4))
164 iw1 = 0
165 iw2 = 0
166 stime0= mpi_wtime()
168 & (len, hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, &
169 & wsi, wiia, wse, wiea, iw1, iw2, &
170 & hecmesh%MPI_COMM, hecmesh%my_rank, 4)
171 etime0= mpi_wtime()
172 commtime= commtime + etime0 - stime0
173
174 deallocate (iw1, iw2)
175 !C===
176
177 !C
178 !C +---------------------+
179 !C | EXTERNAL edge info. |
180 !C +---------------------+
181 !C===
182
183
184 !C
185 !C-- find LOCAL edge ID at DESTINY
186 do neib= 1, hecmesh%n_neighbor_pe
187 is= wse(neib-1)+1
188 ie= wse(neib )
189 do k= is, ie
190 ip1= wiea(4*k-3)
191 in1= wiea(4*k-2)
192 ip2= wiea(4*k-1)
193 in2= wiea(4*k )
194 call hecmw_adapt_local_node_info (ip1,in1,inc1)
195 call hecmw_adapt_local_node_info (ip2,in2,inc2)
196 call hecmw_adapt_edge_info (hecmesh, inc1,inc2,ie0,1)
197 wieb(k)= ie0
198 enddo
199 enddo
200
201 len= max(wsi(hecmesh%n_neighbor_pe),wse(hecmesh%n_neighbor_pe),iedgtot)
202 allocate (iw1(len), iw2(len))
203 iw1 = 0
204 iw2 = 0
205
206 stime0= mpi_wtime()
208 & (len, hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, &
209 & wse, wieb, wsi, wiib, iw1, iw2, &
210 & hecmesh%MPI_COMM, hecmesh%my_rank, 1)
211 etime0= mpi_wtime()
212 commtime= commtime + etime0 - stime0
213
214 !C
215 !C-- reconstruct IMPORT table
216
217 deallocate (iw1)
218 allocate (iw1(hecmesh%n_neighbor_pe))
219 iw1 = 0
220
221 do ie= 1, hecmesh%n_adapt_edge
222 ih= hecmesh%adapt_edge_home(ie)
223
224 if (ih.ne.hecmesh%my_rank) then
225 ihr = hecmesh%rev_neighbor_pe(ih)
226 iw1(ihr )= iw1(ihr) + 1
227
228 wiib(wsi(ihr-1)+iw1(ihr))= ie
229 endif
230 enddo
231
232 !C
233 !C-- new ARRAY
234 allocate (hecmesh%adapt_import_edge_index(0:hecmesh%n_neighbor_pe))
235 allocate (hecmesh%adapt_export_edge_index(0:hecmesh%n_neighbor_pe))
236
237 do neib= 0, hecmesh%n_neighbor_pe
238 hecmesh%adapt_import_edge_index(neib)= wsi(neib)
239 hecmesh%adapt_export_edge_index(neib)= wse(neib)
240 enddo
241
242 maximport= wsi(hecmesh%n_neighbor_pe)
243 maxexport= wse(hecmesh%n_neighbor_pe)
244
245 allocate (hecmesh%adapt_import_edge_item(maximport))
246 allocate (hecmesh%adapt_export_edge_item(maxexport))
247 do k= 1, maximport
248 hecmesh%adapt_import_edge_item(k)= wiib(k)
249 enddo
250 do k= 1, maxexport
251 hecmesh%adapt_export_edge_item(k)= wieb(k)
252 enddo
253
254 deallocate (iw1,iw2)
255 deallocate (wse,wsi,wiea,wieb,wiia,wiib)
256
257 !C===
258contains
259 subroutine hecmw_adapt_local_node_info (ip,in,in0)
260 do i= 1, hecmesh%n_node
261 if (hecmesh%node_ID(2*i) .eq.ip .and. &
262 & hecmesh%node_ID(2*i-1).eq.in) then
263 in0= i
264 return
265 endif
266 enddo
267 end subroutine hecmw_adapt_local_node_info
268end subroutine hecmw_adapt_edge_comm_table
subroutine hecmw_adapt_local_node_info(ip, in, in0)
subroutine hecmw_adapt_edge_comm_table(hecmesh)
Adaptive Mesh Refinement.
subroutine hecmw_adapt_edge_info(hecmesh, nod1, nod2, iedge, nflag)
Adaptive Mesh Refinement.
Adaptive Mesh Refinement.
subroutine hecmw_adapt_item_send_recv(n, neibpetot, neibpe, stack_import, nod_import, stack_export, nod_export, ws, wr, solver_comm, my_rank, ntab)
Adaptive Mesh Refinement.
subroutine hecmw_adapt_stack_send_recv(neibpetot, neibpe, stack_import, stack_export, solver_comm, my_rank)
I/O and Utility.
Definition: hecmw_util_f.F90:7
integer(kind=kint), parameter hecmw_sum