FrontISTR  5.7.0
Large-scale structural analysis program with finit element method
hecmw_adapt_allocate.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_allocate
10 !C***
11 !C
12 
13 subroutine hecmw_adapt_allocate (hecMESH)
14 
15  use hecmw_util
16  type (hecmwST_local_mesh) :: hecMESH
17 
18  integer(kind=kint), pointer :: WORKaI(:)
19  real(kind=kreal), pointer :: workar(:)
20 
21  !C
22  !C +-------+
23  !C | ERROR |
24  !C +-------+
25  !C===
26  if (hecmesh%hecmw_flag_initcon .eq.1) call hecmw_adapt_error_exit (hecmesh, 201)
27  if (hecmesh%hecmw_flag_parttype.eq.2) call hecmw_adapt_error_exit (hecmesh, 202)
28  if (hecmesh%n_dof_grp.ne.1) call hecmw_adapt_error_exit (hecmesh, 203)
29  if (hecmesh%n_elem_mat_ID.ne.hecmesh%n_elem) &
30  & call hecmw_adapt_error_exit (hecmesh, 204)
31  !C===
32 
33  !C
34  !C +--------------+
35  !C | INITIAL MESH |
36  !C +--------------+
37  !C===
38  call mpi_barrier (hecmesh%MPI_COMM, ierr)
39  write (*,'(a,i5,4i8)') 'PE#', hecmesh%my_rank, &
40  & hecmesh%n_node, hecmesh%nn_internal, &
41  & hecmesh%n_elem, hecmesh%ne_internal
42 
43  hecmesh%nn_array= 9 * hecmesh%n_node + 1
44  hecmesh%ne_array= 9 * hecmesh%n_elem + 1
45  hecmesh%nx_array= max(hecmesh%nn_array,hecmesh%ne_array)
46 
47  if (hecmesh%hecmw_flag_adapt.eq.0) then
48  allocate (hecmesh%when_i_was_refined_node (hecmesh%nn_array))
49  allocate (hecmesh%when_i_was_refined_elem (hecmesh%ne_array))
50 
51  allocate (hecmesh%adapt_parent (2*hecmesh%ne_array))
52  allocate (hecmesh%adapt_parent_type ( hecmesh%ne_array))
53  allocate (hecmesh%adapt_type ( hecmesh%ne_array))
54  allocate (hecmesh%adapt_level ( hecmesh%ne_array))
55 
56  allocate (hecmesh%adapt_children_item (2*8*hecmesh%ne_array))
57  allocate (hecmesh%adapt_children_index (0:hecmesh%ne_array))
58 
59  hecmesh%when_i_was_refined_node= 0
60  hecmesh%when_i_was_refined_elem= 0
61 
62  hecmesh%adapt_parent = 0
63  hecmesh%adapt_parent_type = 0
64  hecmesh%adapt_type = 0
65  hecmesh%adapt_level = 0
66 
67  hecmesh%adapt_children_item = 0
68  hecmesh%adapt_children_index= 0
69 
70  do icel= 1, hecmesh%n_elem
71  hecmesh%adapt_parent ( 2*icel)= -1
72  hecmesh%adapt_children_index( icel)= 8 * icel
73 
74  is= 16*(icel-1)
75  hecmesh%adapt_children_item (is+ 2)= -1
76  hecmesh%adapt_children_item (is+ 4)= -1
77  hecmesh%adapt_children_item (is+ 6)= -1
78  hecmesh%adapt_children_item (is+ 8)= -1
79  hecmesh%adapt_children_item (is+10)= -1
80  hecmesh%adapt_children_item (is+12)= -1
81  hecmesh%adapt_children_item (is+14)= -1
82  hecmesh%adapt_children_item (is+16)= -1
83  enddo
84  endif
85  !C===
86 
87  !C
88  !C +-------------------+
89  !C | RE-ALLOCATE: node |
90  !C +-------------------+
91  !C===
92 
93  !C
94  !C-- COORDINATEs
95  allocate (workar(3*hecmesh%n_node))
96  do i= 1, hecmesh%n_node
97  workar(3*i-2)= hecmesh%node(3*i-2)
98  workar(3*i-1)= hecmesh%node(3*i-1)
99  workar(3*i )= hecmesh%node(3*i )
100  enddo
101 
102  deallocate (hecmesh%node)
103  allocate (hecmesh%node(3*hecmesh%nn_array))
104  hecmesh%node= 0.d0
105  do i= 1, hecmesh%n_node
106  hecmesh%node(3*i-2)= workar(3*i-2)
107  hecmesh%node(3*i-1)= workar(3*i-1)
108  hecmesh%node(3*i )= workar(3*i )
109  enddo
110  deallocate (workar)
111 
112  !C
113  !C-- node_ID
114  allocate (workai(2*hecmesh%n_node))
115  do i= 1, hecmesh%n_node
116  workai(2*i-1)= hecmesh%node_ID(2*i-1)
117  workai(2*i )= hecmesh%node_ID(2*i )
118  enddo
119 
120  deallocate (hecmesh%node_ID)
121  allocate (hecmesh%node_ID(2*hecmesh%nn_array))
122  hecmesh%node_ID= 0
123  do i= 1, hecmesh%n_node
124  hecmesh%node_ID(2*i-1)= workai(2*i-1)
125  hecmesh%node_ID(2*i )= workai(2*i )
126  enddo
127  deallocate (workai)
128 
129  !C
130  !C-- global_node_ID
131  allocate (workai(hecmesh%n_node))
132  do i= 1, hecmesh%n_node
133  workai(i)= hecmesh%global_node_ID(i)
134  enddo
135 
136  deallocate (hecmesh%global_node_ID)
137  allocate (hecmesh%global_node_ID(hecmesh%nn_array))
138  hecmesh%global_node_ID= 0
139  do i= 1, hecmesh%n_node
140  hecmesh%global_node_ID(i)= workai(i)
141  enddo
142  deallocate (workai)
143  !C===
144 
145  !C
146  !C +----------------------+
147  !C | RE-ALLOCATE: element |
148  !C +----------------------+
149  !C===
150 
151  !C
152  !C-- elem_type, section_ID, global_elem_ID
153  allocate (workai(2*hecmesh%n_elem))
154  do i= 1, hecmesh%n_elem
155  workai(2*i-1)= hecmesh%elem_type (i)
156  workai(2*i )= hecmesh%section_ID(i)
157  enddo
158 
159  deallocate (hecmesh%elem_type, hecmesh%section_ID)
160  allocate (hecmesh%elem_type (hecmesh%ne_array))
161  allocate (hecmesh%section_ID(hecmesh%ne_array))
162  hecmesh%elem_type = 0
163  hecmesh%section_ID= 0
164  do i= 1, hecmesh%n_elem
165  hecmesh%elem_type (i)= workai(2*i-1)
166  hecmesh%section_ID(i)= workai(2*i )
167  enddo
168  deallocate (workai)
169 
170  allocate (workai(hecmesh%n_elem))
171  do i= 1, hecmesh%n_elem
172  workai(i)= hecmesh%global_elem_ID(i)
173  enddo
174 
175  deallocate (hecmesh%global_elem_ID)
176  allocate (hecmesh%global_elem_ID(hecmesh%ne_array))
177  hecmesh%global_elem_ID= 0
178  do i= 1, hecmesh%n_elem
179  hecmesh%global_elem_ID(i)= workai(i)
180  enddo
181  deallocate (workai)
182 
183  !C
184  !C-- elem_ID
185  allocate (workai(2*hecmesh%n_elem))
186  do i= 1, hecmesh%n_elem
187  workai(2*i-1)= hecmesh%elem_ID(2*i-1)
188  workai(2*i )= hecmesh%elem_ID(2*i )
189  enddo
190 
191  deallocate (hecmesh%elem_ID)
192  allocate (hecmesh%elem_ID(2*hecmesh%ne_array))
193  hecmesh%elem_ID= 0
194  do i= 1, hecmesh%n_elem
195  hecmesh%elem_ID(2*i-1)= workai(2*i-1)
196  hecmesh%elem_ID(2*i )= workai(2*i )
197  enddo
198  deallocate (workai)
199 
200  !C
201  !C-- elem_node_index
202  allocate (workai(hecmesh%n_elem))
203  do i= 1, hecmesh%n_elem
204  workai(i)= hecmesh%elem_node_index(i)
205  enddo
206 
207  deallocate (hecmesh%elem_node_index)
208  allocate (hecmesh%elem_node_index(0:hecmesh%ne_array))
209  hecmesh%elem_node_index= 0
210  do i= 1, hecmesh%n_elem
211  hecmesh%elem_node_index (i)= workai(i)
212  enddo
213  deallocate (workai)
214 
215  !C
216  !C-- elem_node_item
217  nnn= hecmesh%elem_node_index(hecmesh%n_elem)
218  allocate (workai(nnn))
219  do i= 1, nnn
220  workai(i)= hecmesh%elem_node_item(i)
221  enddo
222 
223  deallocate (hecmesh%elem_node_item)
224  allocate (hecmesh%elem_node_item(6*hecmesh%ne_array))
225  hecmesh%elem_node_item= 0
226  do i= 1, nnn
227  hecmesh%elem_node_item (i)= workai(i)
228  enddo
229  deallocate (workai)
230 
231  !C
232  !C-- elem_mat_ID_index
233  allocate (workai(hecmesh%n_elem))
234  do i= 1, hecmesh%n_elem
235  workai(i)= hecmesh%elem_mat_ID_index(i)
236  enddo
237 
238  deallocate (hecmesh%elem_mat_ID_index)
239  allocate (hecmesh%elem_mat_ID_index(0:hecmesh%ne_array))
240  hecmesh%elem_mat_ID_index= 0
241  do i= 1, ne_array
242  hecmesh%elem_mat_ID_index (i)= i
243  enddo
244  deallocate (workai)
245 
246  !C
247  !C-- elem_mat_ID_item
248  nnn= hecmesh%n_elem
249  allocate (workai(nnn))
250  do i= 1, nnn
251  workai(i)= hecmesh%elem_mat_ID_item(i)
252  enddo
253 
254  deallocate (hecmesh%elem_mat_ID_item)
255  allocate (hecmesh%elem_mat_ID_item(hecmesh%ne_array*nnn/hecmesh%n_elem))
256  hecmesh%elem_mat_ID_item= 0
257  do i= 1, nnn
258  hecmesh%elem_mat_ID_item (i)= workai(i)
259  enddo
260  deallocate (workai)
261  !C===
262 
263  if (hecmesh%hecmw_flag_adapt.eq.1) then
264  !C
265  !C +--------------------+
266  !C | RE-ALLOCATE: adapt |
267  !C +--------------------+
268  !C===
269 
270  !C
271  !C-- when_i_was
272  allocate (workai(hecmesh%n_elem))
273  do i= 1, hecmesh%n_elem
274  workai(i)= hecmesh%when_i_was_refined_elem(i)
275  enddo
276 
277  deallocate (hecmesh%when_i_was_refined_elem)
278  allocate (hecmesh%when_i_was_refined_elem(hecmesh%ne_array))
279  hecmesh%when_i_was_refined_elem= 0
280  do i= 1, hecmesh%n_elem
281  hecmesh%when_i_was_refined_elem(i)= workai(i)
282  enddo
283  deallocate (workai)
284 
285  allocate (workai(hecmesh%n_node))
286  do i= 1, hecmesh%n_node
287  workai(i)= hecmesh%when_i_was_refined_node(i)
288  enddo
289 
290  deallocate (hecmesh%when_i_was_refined_node)
291  allocate (hecmesh%when_i_was_refined_node(hecmesh%nn_array))
292  hecmesh%when_i_was_refined_node= 0
293  do i= 1, hecmesh%n_node
294  hecmesh%when_i_was_refined_node(i)= workai(i)
295  enddo
296  deallocate (workai)
297 
298  !C
299  !C-- adapt_parent, parent_type, type, level
300 
301  allocate (workai(5*hecmesh%n_elem))
302  do i= 1, hecmesh%n_elem
303  workai(5*i-4)= hecmesh%adapt_parent (2*i-1)
304  workai(5*i-3)= hecmesh%adapt_parent (2*i )
305  workai(5*i-2)= hecmesh%adapt_parent_type( i)
306  workai(5*i-1)= hecmesh%adapt_type ( i)
307  workai(4*i )= hecmesh%adapt_level ( i)
308  enddo
309 
310  deallocate (hecmesh%adapt_parent, hecmesh%adapt_parent_type)
311  deallocate (hecmesh%adapt_type , hecmesh%adapt_level )
312 
313  allocate (hecmesh%adapt_parent (2*hecmesh%ne_array))
314  allocate (hecmesh%adapt_parent_type( hecmesh%ne_array))
315  allocate (hecmesh%adapt_type ( hecmesh%ne_array))
316  allocate (hecmesh%adapt_level ( hecmesh%ne_array))
317  hecmesh%adapt_parent = 0
318  hecmesh%adapt_parent_type= 0
319  hecmesh%adapt_type = 0
320  hecmesh%adapt_level = 0
321 
322  do i= 1, hecmesh%n_elem
323  hecmesh%adapt_parent (2*i-1)= workai(5*i-4)
324  hecmesh%adapt_parent (2*i )= workai(5*i-3)
325  hecmesh%adapt_parent_type( i )= workai(5*i-2)
326  hecmesh%adapt_type ( i )= workai(5*i-1)
327  hecmesh%adapt_level ( i )= workai(5*i )
328  enddo
329  deallocate (workai)
330 
331  !C
332  !C-- adapt_children_index
333  allocate (workai(hecmesh%n_elem))
334  do i= 1, hecmesh%n_elem
335  workai(i)= hecmesh%adapt_children_index(i)
336  enddo
337 
338  deallocate (hecmesh%adapt_children_index)
339  allocate (hecmesh%adapt_children_index(0:hecmesh%ne_array))
340  hecmesh%adapt_children_index= 0
341  do i= 1, hecmesh%n_elem
342  hecmesh%adapt_children_index(i)= workai(i)
343  enddo
344  deallocate (workai)
345 
346  !C
347  !C-- adapt_children_item
348  nnn= hecmesh%adapt_children_index(hecmesh%n_elem)
349  allocate (workai(2*nnn))
350  do i= 1, nnn
351  workai(2*i-1)= hecmesh%adapt_children_item(2*i-1)
352  workai(2*i )= hecmesh%adapt_children_item(2*i )
353  enddo
354 
355  deallocate (hecmesh%adapt_children_item)
356  allocate (hecmesh%adapt_children_item(2*8*hecmesh%ne_array))
357  hecmesh%adapt_children_item= 0
358  do i= 1, nnn
359  hecmesh%adapt_children_item(2*i-1)= workai(2*i-1)
360  hecmesh%adapt_children_item(2*i )= workai(2*i )
361  enddo
362  deallocate (workai)
363 
364  endif
365 
366  hecmesh%hecmw_flag_adapt= 1
367  !C===
368 
369  if (hecmesh%my_rank.eq.0) write (*,'(/,a)') '#RE-ALLOCATE'
370  !C
371  !C +-------------------+
372  !C | REALLOCATE: group |
373  !C +-------------------+
374  !C===
375 
376  !C
377  !C-- NODE group
378  if (hecmesh%node_group%n_grp.ne.0) then
379  if (hecmesh%node_group%grp_index(hecmesh%node_group%n_grp).ne.0) then
380  nnn= hecmesh%node_group%grp_index(hecmesh%node_group%n_grp)
381  allocate (workai(nnn))
382  do i= 1, nnn
383  workai(i)= hecmesh%node_group%grp_item(i)
384  enddo
385 
386  deallocate (hecmesh%node_group%grp_item)
387  allocate (hecmesh%node_group%grp_item(hecmesh%nx_array))
388  hecmesh%node_group%grp_item= 0
389  do i= 1, nnn
390  hecmesh%node_group%grp_item(i)= workai(i)
391  enddo
392  deallocate (workai)
393  endif
394  endif
395 
396  !C
397  !C-- ELEMENT group
398  if (hecmesh%elem_group%n_grp.ne.0) then
399  if (hecmesh%elem_group%grp_index(hecmesh%elem_group%n_grp).ne.0) then
400  nnn= hecmesh%elem_group%grp_index(hecmesh%elem_group%n_grp)
401  allocate (workai(nnn))
402  do i= 1, nnn
403  workai(i)= hecmesh%elem_group%grp_item(i)
404  enddo
405 
406  deallocate (hecmesh%elem_group%grp_item)
407  allocate (hecmesh%elem_group%grp_item(hecmesh%nx_array))
408  hecmesh%elem_group%grp_item= 0
409  do i= 1, nnn
410  hecmesh%elem_group%grp_item(i)= workai(i)
411  enddo
412 
413  deallocate (workai)
414  endif
415  endif
416 
417  !C
418  !C-- SURFACE group
419  if (hecmesh%surf_group%n_grp.ne.0) then
420  if (hecmesh%surf_group%grp_index(hecmesh%surf_group%n_grp).ne.0) then
421  nnn= hecmesh%surf_group%grp_index(hecmesh%surf_group%n_grp)
422  allocate (workai(2*nnn))
423  do i= 1, nnn
424  workai(2*i-1)= hecmesh%surf_group%grp_item(2*i-1)
425  workai(2*i )= hecmesh%surf_group%grp_item(2*i )
426  enddo
427 
428  deallocate (hecmesh%surf_group%grp_item)
429  allocate (hecmesh%surf_group%grp_item(2*hecmesh%nx_array))
430  hecmesh%surf_group%grp_item= 0
431  do i= 1, nnn
432  hecmesh%surf_group%grp_item(2*i-1)= workai(2*i-1)
433  hecmesh%surf_group%grp_item(2*i )= workai(2*i )
434  enddo
435  deallocate (workai)
436  endif
437  endif
438  !C===
439 
440  if (hecmesh%my_rank.eq.0) write (*,'(a)') '#EDGE-INFO'
441  !C
442  !C +------------------+
443  !C | EDGE information |
444  !C +------------------+
445  !C===
446  ne= max(hecmesh%n_node, hecmesh%n_elem)
447  100 continue
448 
449  allocate(hecmesh%adapt_edge_node(2*ne))
450  hecmesh%adapt_edge_node= 0
451  hecmesh%n_adapt_edge = 0
452 
453  do icel= 1, hecmesh%n_elem
454  if (hecmesh%adapt_type(icel).eq.0) then
455  ityp= hecmesh%elem_type(icel)
456  !C
457  !C-- 3D : tetrahedron
458  if (ityp.eq.341) then
459  is = hecmesh%elem_node_index(icel-1)
460  in1= hecmesh%elem_node_item (is+1)
461  in2= hecmesh%elem_node_item (is+2)
462  in3= hecmesh%elem_node_item (is+3)
463  in4= hecmesh%elem_node_item (is+4)
464 
465  call hecmw_adapt_edge_info (hecmesh, in1,in2, iedge, 0)
466  call hecmw_adapt_edge_info (hecmesh, in1,in3, iedge, 0)
467  call hecmw_adapt_edge_info (hecmesh, in1,in4, iedge, 0)
468  call hecmw_adapt_edge_info (hecmesh, in2,in3, iedge, 0)
469  call hecmw_adapt_edge_info (hecmesh, in3,in4, iedge, 0)
470  call hecmw_adapt_edge_info (hecmesh, in4,in2, iedge, 0)
471  endif
472 
473  !C
474  !C-- 3D : prisms
475  if (ityp.eq.351) then
476  is = hecmesh%elem_node_index(icel-1)
477  in1= hecmesh%elem_node_item (is+1)
478  in2= hecmesh%elem_node_item (is+2)
479  in3= hecmesh%elem_node_item (is+3)
480  in4= hecmesh%elem_node_item (is+4)
481  in5= hecmesh%elem_node_item (is+5)
482  in6= hecmesh%elem_node_item (is+6)
483 
484  call hecmw_adapt_edge_info (hecmesh, in1,in2, iedge, 0)
485  call hecmw_adapt_edge_info (hecmesh, in2,in3, iedge, 0)
486  call hecmw_adapt_edge_info (hecmesh, in3,in1, iedge, 0)
487  call hecmw_adapt_edge_info (hecmesh, in4,in5, iedge, 0)
488  call hecmw_adapt_edge_info (hecmesh, in5,in6, iedge, 0)
489  call hecmw_adapt_edge_info (hecmesh, in6,in4, iedge, 0)
490  call hecmw_adapt_edge_info (hecmesh, in1,in4, iedge, 0)
491  call hecmw_adapt_edge_info (hecmesh, in2,in5, iedge, 0)
492  call hecmw_adapt_edge_info (hecmesh, in3,in6, iedge, 0)
493  endif
494 
495  if (hecmesh%n_adapt_edge.ge.ne-6 .and. icel.lt.hecmesh%n_elem) then
496  iii= hecmesh%n_elem/icel + 1
497  ne = iii * ne + 1
498  deallocate(hecmesh%adapt_edge_node)
499 
500  goto 100
501  endif
502 
503  endif
504  enddo
505 
506  call mpi_barrier (hecmesh%MPI_COMM, ierr)
507 
508  allocate(hecmesh%adapt_IWK(hecmesh%n_adapt_edge))
509  hecmesh%adapt_IWK= 0
510 
511  !C===
512 
513  hecmesh%n_adapt_elem_341= 0
514  hecmesh%n_adapt_elem_351= 0
515 
516  do icel= 1, hecmesh%n_elem
517  ityp= hecmesh%elem_type(icel)
518  if (ityp.eq.341) then
519  hecmesh%n_adapt_elem_341= hecmesh%n_adapt_elem_341 + 1
520  endif
521  if (ityp.eq.351) then
522  hecmesh%n_adapt_elem_351= hecmesh%n_adapt_elem_351 + 1
523  endif
524  enddo
525 
526 end subroutine hecmw_adapt_allocate
527 
hecmw_adapt_error_exit
subroutine hecmw_adapt_error_exit(hecMESH, IFLAG)
Adaptive Mesh Refinement.
Definition: hecmw_adapt_error_exit.f90:8
hecmw_util
I/O and Utility.
Definition: hecmw_util_f.F90:7
hecmw_util::kreal
integer(kind=4), parameter kreal
Definition: hecmw_util_f.F90:16
hecmw_adapt_allocate
subroutine hecmw_adapt_allocate(hecMESH)
Adaptive Mesh Refinement.
Definition: hecmw_adapt_allocate.f90:14
hecmw_adapt_edge_info
subroutine hecmw_adapt_edge_info(hecMESH, nod1, nod2, iedge, NFLAG)
Adaptive Mesh Refinement.
Definition: hecmw_adapt_edge_info.f90:13