FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
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
13subroutine 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
526end subroutine hecmw_adapt_allocate
527
subroutine hecmw_adapt_allocate(hecmesh)
Adaptive Mesh Refinement.
subroutine hecmw_adapt_edge_info(hecmesh, nod1, nod2, iedge, nflag)
Adaptive Mesh Refinement.
subroutine hecmw_adapt_error_exit(hecmesh, iflag)
Adaptive Mesh Refinement.
I/O and Utility.
Definition: hecmw_util_f.F90:7
integer(kind=4), parameter kreal