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