FrontISTR  5.7.0
Large-scale structural analysis program with finit element method
hecmw_adapt_extemb.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_EXTEMB
10 !C***
11 !C
12 !C extend EMBEDDED region to NEIGHBORING region
13 !C
14 subroutine hecmw_adapt_extemb (hecMESH)
15  use hecmw_util
16  use hecmw_adapt_int_sr
17  use hecmw_adapt_int_sr_rev
18  implicit real*8 (a-h,o-z)
19 
20  integer(kind=kint), dimension(:), allocatable :: WR, WS
21  dimension ndiv(6)
22 
23  type (hecmwST_local_mesh) :: hecMESH
24 
25  nrow= 0
26  !C
27  !C +-------+
28  !C | INIT. |
29  !C +-------+
30  !C===
31  do iedg= 1, hecmesh%n_adapt_edge
32  if (hecmesh%adapt_iemb(iedg).eq.1) hecmesh%adapt_iemb(iedg)=2
33  enddo
34 
35  !C
36  !C-- TETRAHEDRA
37  do icel0= 1, hecmesh%n_adapt_act_elem_341
38  icel= hecmesh%adapt_act_elem_341(icel0)
39  is= hecmesh%elem_node_index(icel-1)
40  n1= hecmesh%elem_node_item (is+1)
41  n2= hecmesh%elem_node_item (is+2)
42  n3= hecmesh%elem_node_item (is+3)
43  n4= hecmesh%elem_node_item (is+4)
44 
45  call hecmw_adapt_edge_info ( hecmesh, n1, n2, ie1, 1 )
46  call hecmw_adapt_edge_info ( hecmesh, n1, n3, ie2, 1 )
47  call hecmw_adapt_edge_info ( hecmesh, n1, n4, ie3, 1 )
48  call hecmw_adapt_edge_info ( hecmesh, n2, n3, ie4, 1 )
49  call hecmw_adapt_edge_info ( hecmesh, n2, n4, ie5, 1 )
50  call hecmw_adapt_edge_info ( hecmesh, n3, n4, ie6, 1 )
51 
52  ndiv(1)= 0
53  ndiv(2)= 0
54  ndiv(3)= 0
55  ndiv(4)= 0
56  ndiv(5)= 0
57  ndiv(6)= 0
58 
59  if (hecmesh%adapt_iemb(ie1).eq.2) ndiv(1)= 1
60  if (hecmesh%adapt_iemb(ie2).eq.2) ndiv(2)= 1
61  if (hecmesh%adapt_iemb(ie3).eq.2) ndiv(3)= 1
62  if (hecmesh%adapt_iemb(ie4).eq.2) ndiv(4)= 1
63  if (hecmesh%adapt_iemb(ie5).eq.2) ndiv(5)= 1
64  if (hecmesh%adapt_iemb(ie6).eq.2) ndiv(6)= 1
65 
66  ndivsum= ndiv(1)+ndiv(2)+ndiv(3)+ndiv(4)+ndiv(5)+ndiv(6)
67 
68  if (ndivsum.ge.1) then
69  if (hecmesh%adapt_iemb(ie1).eq.0) hecmesh%adapt_iemb(ie1)= 1
70  if (hecmesh%adapt_iemb(ie2).eq.0) hecmesh%adapt_iemb(ie2)= 1
71  if (hecmesh%adapt_iemb(ie3).eq.0) hecmesh%adapt_iemb(ie3)= 1
72  if (hecmesh%adapt_iemb(ie4).eq.0) hecmesh%adapt_iemb(ie4)= 1
73  if (hecmesh%adapt_iemb(ie5).eq.0) hecmesh%adapt_iemb(ie5)= 1
74  if (hecmesh%adapt_iemb(ie6).eq.0) hecmesh%adapt_iemb(ie6)= 1
75  endif
76  enddo
77 
78  !C
79  !C-- PRISMs
80  do icel0= 1, hecmesh%n_adapt_act_elem_351
81  icel= hecmesh%adapt_act_elem_351(icel0)
82  is= hecmesh%elem_node_index(icel-1)
83  n1= hecmesh%elem_node_item (is+1)
84  n2= hecmesh%elem_node_item (is+2)
85  n3= hecmesh%elem_node_item (is+3)
86  n4= hecmesh%elem_node_item (is+4)
87  n5= hecmesh%elem_node_item (is+5)
88  n6= hecmesh%elem_node_item (is+6)
89 
90  call hecmw_adapt_edge_info ( hecmesh, n1, n2, ie1, 1 )
91  call hecmw_adapt_edge_info ( hecmesh, n2, n3, ie2, 1 )
92  call hecmw_adapt_edge_info ( hecmesh, n3, n1, ie3, 1 )
93  call hecmw_adapt_edge_info ( hecmesh, n4, n5, ie4, 1 )
94  call hecmw_adapt_edge_info ( hecmesh, n5, n6, ie5, 1 )
95  call hecmw_adapt_edge_info ( hecmesh, n6, n4, ie6, 1 )
96 
97  ndiv(1)= 0
98  ndiv(2)= 0
99  ndiv(3)= 0
100  ndiv(4)= 0
101  ndiv(5)= 0
102  ndiv(6)= 0
103 
104  if (hecmesh%adapt_iemb(ie1).eq.2) ndiv(1)= 1
105  if (hecmesh%adapt_iemb(ie2).eq.2) ndiv(2)= 1
106  if (hecmesh%adapt_iemb(ie3).eq.2) ndiv(3)= 1
107  if (hecmesh%adapt_iemb(ie4).eq.2) ndiv(4)= 1
108  if (hecmesh%adapt_iemb(ie5).eq.2) ndiv(5)= 1
109  if (hecmesh%adapt_iemb(ie6).eq.2) ndiv(6)= 1
110 
111  ndivsum= ndiv(1)+ndiv(2)+ndiv(3)+ndiv(4)+ndiv(5)+ndiv(6)
112 
113  if (ndivsum.ge.1) then
114  if (hecmesh%adapt_iemb(ie1).eq.0) hecmesh%adapt_iemb(ie1)= 1
115  if (hecmesh%adapt_iemb(ie2).eq.0) hecmesh%adapt_iemb(ie2)= 1
116  if (hecmesh%adapt_iemb(ie3).eq.0) hecmesh%adapt_iemb(ie3)= 1
117  if (hecmesh%adapt_iemb(ie4).eq.0) hecmesh%adapt_iemb(ie4)= 1
118  if (hecmesh%adapt_iemb(ie5).eq.0) hecmesh%adapt_iemb(ie5)= 1
119  if (hecmesh%adapt_iemb(ie6).eq.0) hecmesh%adapt_iemb(ie6)= 1
120  endif
121  enddo
122  !C===
123 
124  !C
125  !C-- exchange IEMB
126  n1= hecmesh%adapt_import_edge_index(hecmesh%n_neighbor_pe)
127  n2= hecmesh%adapt_export_edge_index(hecmesh%n_neighbor_pe)
128  m = max(n1, n2)
129  allocate (ws(m), wr(m))
130 
131  ws= 0
132  wr= 0
133  call hecmw_adapt_int_send_recv_rev &
134  & ( hecmesh%n_adapt_edge, hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, &
135  & hecmesh%adapt_import_edge_index, &
136  & hecmesh%adapt_import_edge_item , &
137  & hecmesh%adapt_export_edge_index, &
138  & hecmesh%adapt_export_edge_item , &
139  & ws, wr, hecmesh%adapt_iemb, hecmesh%MPI_COMM, &
140  & hecmesh%my_rank, 1, m)
141 
142  ws= 0
143  wr= 0
144  call hecmw_adapt_int_send_recv &
145  & ( hecmesh%n_adapt_edge, hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, &
146  & hecmesh%adapt_import_edge_index, &
147  & hecmesh%adapt_import_edge_item , &
148  & hecmesh%adapt_export_edge_index, &
149  & hecmesh%adapt_export_edge_item , &
150  & ws, wr, hecmesh%adapt_iemb, hecmesh%MPI_COMM, &
151  & hecmesh%my_rank, 1, m)
152 
153  do iedg= 1, hecmesh%n_adapt_edge
154  if (hecmesh%adapt_iemb(iedg).eq.1) hecmesh%adapt_iemb(iedg)=2
155  enddo
156 
157  !C
158  !C +----------------------+
159  !C | extend embedded zone |
160  !C +----------------------+
161  !C RULE : set all EDGEs IEMB(ie)=1 if at least ONE
162  !C EDGE of the TETRAHEDRON is marked as IEMB(ie)=2
163  !C===
164  do irow= 1, nrow
165  !C
166  !C== set IEMB(ie) = 1
167 
168  !C
169  !C-- TETRAHEDRA
170  do icel0= 1, hecmesh%n_adapt_act_elem_341
171  icel= hecmesh%adapt_act_elem_341(icel0)
172  is= hecmesh%elem_node_index(icel-1)
173  n1= hecmesh%elem_node_item (is+1)
174  n2= hecmesh%elem_node_item (is+2)
175  n3= hecmesh%elem_node_item (is+3)
176  n4= hecmesh%elem_node_item (is+4)
177 
178  call hecmw_adapt_edge_info ( hecmesh, n1, n2, ie1, 1 )
179  call hecmw_adapt_edge_info ( hecmesh, n1, n3, ie2, 1 )
180  call hecmw_adapt_edge_info ( hecmesh, n1, n4, ie3, 1 )
181  call hecmw_adapt_edge_info ( hecmesh, n2, n3, ie4, 1 )
182  call hecmw_adapt_edge_info ( hecmesh, n2, n4, ie5, 1 )
183  call hecmw_adapt_edge_info ( hecmesh, n3, n4, ie6, 1 )
184 
185  ndiv(1)= 0
186  ndiv(2)= 0
187  ndiv(3)= 0
188  ndiv(4)= 0
189  ndiv(5)= 0
190  ndiv(6)= 0
191 
192  if (hecmesh%adapt_iemb(ie1).eq.2) ndiv(1)= 1
193  if (hecmesh%adapt_iemb(ie2).eq.2) ndiv(2)= 1
194  if (hecmesh%adapt_iemb(ie3).eq.2) ndiv(3)= 1
195  if (hecmesh%adapt_iemb(ie4).eq.2) ndiv(4)= 1
196  if (hecmesh%adapt_iemb(ie5).eq.2) ndiv(5)= 1
197  if (hecmesh%adapt_iemb(ie6).eq.2) ndiv(6)= 1
198 
199  ndivsum= ndiv(1)+ndiv(2)+ndiv(3)+ndiv(4)+ndiv(5)+ndiv(6)
200 
201  if (ndivsum.ge.1) then
202  if (hecmesh%adapt_iemb(ie1).eq.0) hecmesh%adapt_iemb(ie1)= 1
203  if (hecmesh%adapt_iemb(ie2).eq.0) hecmesh%adapt_iemb(ie2)= 1
204  if (hecmesh%adapt_iemb(ie3).eq.0) hecmesh%adapt_iemb(ie3)= 1
205  if (hecmesh%adapt_iemb(ie4).eq.0) hecmesh%adapt_iemb(ie4)= 1
206  if (hecmesh%adapt_iemb(ie5).eq.0) hecmesh%adapt_iemb(ie5)= 1
207  if (hecmesh%adapt_iemb(ie6).eq.0) hecmesh%adapt_iemb(ie6)= 1
208  endif
209  enddo
210 
211  !C
212  !C-- PRISMs
213  do icel0= 1, hecmesh%n_adapt_act_elem_351
214  icel= hecmesh%adapt_act_elem_351(icel0)
215  is= hecmesh%elem_node_index(icel-1)
216  n1= hecmesh%elem_node_item (is+1)
217  n2= hecmesh%elem_node_item (is+2)
218  n3= hecmesh%elem_node_item (is+3)
219  n4= hecmesh%elem_node_item (is+4)
220  n5= hecmesh%elem_node_item (is+5)
221  n6= hecmesh%elem_node_item (is+6)
222 
223  call hecmw_adapt_edge_info ( hecmesh, n1, n2, ie1, 1 )
224  call hecmw_adapt_edge_info ( hecmesh, n2, n3, ie2, 1 )
225  call hecmw_adapt_edge_info ( hecmesh, n3, n1, ie3, 1 )
226  call hecmw_adapt_edge_info ( hecmesh, n4, n5, ie4, 1 )
227  call hecmw_adapt_edge_info ( hecmesh, n5, n6, ie5, 1 )
228  call hecmw_adapt_edge_info ( hecmesh, n6, n4, ie6, 1 )
229 
230  ndiv(1)= 0
231  ndiv(2)= 0
232  ndiv(3)= 0
233  ndiv(4)= 0
234  ndiv(5)= 0
235  ndiv(6)= 0
236 
237  if (hecmesh%adapt_iemb(ie1).eq.2) ndiv(1)= 1
238  if (hecmesh%adapt_iemb(ie2).eq.2) ndiv(2)= 1
239  if (hecmesh%adapt_iemb(ie3).eq.2) ndiv(3)= 1
240  if (hecmesh%adapt_iemb(ie4).eq.2) ndiv(4)= 1
241  if (hecmesh%adapt_iemb(ie5).eq.2) ndiv(5)= 1
242  if (hecmesh%adapt_iemb(ie6).eq.2) ndiv(6)= 1
243 
244  ndivsum= ndiv(1)+ndiv(2)+ndiv(3)+ndiv(4)+ndiv(5)+ndiv(6)
245 
246  if (ndivsum.ge.1) then
247  if (hecmesh%adapt_iemb(ie1).eq.0) hecmesh%adapt_iemb(ie1)= 1
248  if (hecmesh%adapt_iemb(ie2).eq.0) hecmesh%adapt_iemb(ie2)= 1
249  if (hecmesh%adapt_iemb(ie3).eq.0) hecmesh%adapt_iemb(ie3)= 1
250  if (hecmesh%adapt_iemb(ie4).eq.0) hecmesh%adapt_iemb(ie4)= 1
251  if (hecmesh%adapt_iemb(ie5).eq.0) hecmesh%adapt_iemb(ie5)= 1
252  if (hecmesh%adapt_iemb(ie6).eq.0) hecmesh%adapt_iemb(ie6)= 1
253  endif
254  enddo
255  !C==
256 
257  !C
258  !C-- exchange IEMB
259  ws= 0
260  wr= 0
261  call hecmw_adapt_int_send_recv_rev &
262  & ( hecmesh%n_adapt_edge, &
263  & hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, &
264  & hecmesh%adapt_import_edge_index, &
265  & hecmesh%adapt_import_edge_item , &
266  & hecmesh%adapt_export_edge_index, &
267  & hecmesh%adapt_export_edge_item , &
268  & ws, wr, hecmesh%adapt_iemb, hecmesh%MPI_COMM, &
269  & hecmesh%my_rank, 1, m)
270 
271  ws= 0
272  wr= 0
273  call hecmw_adapt_int_send_recv &
274  & ( hecmesh%n_adapt_edge, &
275  & hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, &
276  & hecmesh%adapt_import_edge_index, &
277  & hecmesh%adapt_import_edge_item , &
278  & hecmesh%adapt_export_edge_index, &
279  & hecmesh%adapt_export_edge_item , &
280  & ws, wr, hecmesh%adapt_iemb, hecmesh%MPI_COMM, &
281  & hecmesh%my_rank, 1, m)
282 
283  !C
284  !C-- set IEMB(ie) = 2
285  do iedg= 1, hecmesh%n_adapt_edge
286  if ( hecmesh%adapt_iemb(iedg).eq.1 ) then
287  hecmesh%adapt_iemb(iedg)= 2
288  endif
289  enddo
290 
291  enddo
292 
293  deallocate (ws, wr)
294  !C===
295 
296  !C
297  !C-- LOOP OVER ALL EDGEs
298  do iedg= 1, hecmesh%n_adapt_edge
299  if ( hecmesh%adapt_iemb(iedg).eq.2 ) hecmesh%adapt_iemb(iedg)= 1
300  enddo
301 
302  return
303 end
hecmw_adapt_int_sr_rev
Adaptive Mesh Refinement.
Definition: hecmw_adapt_int_sr_rev.f90:7
hecmw_adapt_int_sr
Adaptive Mesh Refinement.
Definition: hecmw_adapt_int_sr.f90:7
hecmw_adapt_int_sr_rev::hecmw_adapt_int_send_recv_rev
subroutine hecmw_adapt_int_send_recv_rev(N, NEIBPETOT, NEIBPE, STACK_EXPORT, NOD_EXPORT, STACK_IMPORT, NOD_IMPORT, WS, WR, X, SOLVER_COMM, my_rank, NB, m)
Definition: hecmw_adapt_int_sr_rev.f90:18
hecmw_util
I/O and Utility.
Definition: hecmw_util_f.F90:7
hecmw_adapt_int_sr::hecmw_adapt_int_send_recv
subroutine hecmw_adapt_int_send_recv(N, NEIBPETOT, NEIBPE, STACK_IMPORT, NOD_IMPORT, STACK_EXPORT, NOD_EXPORT, WS, WR, X, SOLVER_COMM, my_rank, NB, m)
Definition: hecmw_adapt_int_sr.f90:18
hecmw_adapt_edge_info
subroutine hecmw_adapt_edge_info(hecMESH, nod1, nod2, iedge, NFLAG)
Adaptive Mesh Refinement.
Definition: hecmw_adapt_edge_info.f90:13
hecmw_adapt_extemb
subroutine hecmw_adapt_extemb(hecMESH)
Adaptive Mesh Refinement.
Definition: hecmw_adapt_extemb.f90:15