FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_adapt_edge_info.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_INFO
10!C***
11
12subroutine hecmw_adapt_edge_info (hecMESH, nod1, nod2, iedge, NFLAG)
13 use hecmw_util
14
15 integer(kind=4), save :: INITflag, nbuckets
16 integer(kind=4), dimension(:), allocatable, save :: ieaddrs
17
18 data initflag/0/
19 type (hecmwST_local_mesh) :: hecMESH
20
21 !C
22 !C-- init.
23 if (initflag.eq.0) then
24 initflag= 1
25 nbuckets= 2*max(hecmesh%n_elem,hecmesh%n_node)
26 allocate (ieaddrs(-nbuckets:+nbuckets))
27 ieaddrs= 0
28 endif
29
30 !C
31 !C NFALG= 0 : CREATE NEW EDGEs
32 !C NFLAG= 1 : REFER the EDGE INFORMATION
33 !C NFLAG= 2 : DEALLOCATE ieaddrs
34 !C
35
36 if (nflag.eq.2) then
37 initflag = 0
38 deallocate( ieaddrs )
39 return
40 endif
41
42 iedge= 0
43
44 nn1 = mod(nod1, nbuckets) * mod(nod2, nbuckets)
45 iarg= mod( nn1, nbuckets)
46
47 if (nflag.eq.0) then
48 if (ieaddrs(iarg).gt.hecmesh%n_adapt_edge) then
49 ieaddrs(iarg)= 0
50 endif
51 endif
52
53 50 continue
54
55
56 !C
57 !C-- NEW EDGE
58
59 if (ieaddrs(iarg).eq.0) then
60 hecmesh%n_adapt_edge= hecmesh%n_adapt_edge + 1
61 iedge= hecmesh%n_adapt_edge
62 hecmesh%adapt_edge_node (2*iedge-1)= nod1
63 hecmesh%adapt_edge_node (2*iedge )= nod2
64
65 ! if (iarg.gt.nbuckets) write (*,*) nod1,nod2,iarg
66 ieaddrs(iarg)= hecmesh%n_adapt_edge
67 return
68 else
69
70 ! if (iarg.gt.nbuckets) write (*,*) nod1,nod2,iarg
71 iedge= ieaddrs(iarg)
72 in1= hecmesh%adapt_edge_node (2*iedge-1)
73 in2= hecmesh%adapt_edge_node (2*iedge )
74
75 !C
76 !C-- EXISTING EDGE
77 if (in1.eq.nod1 .and. in2.eq.nod2 .or. &
78 & in1.eq.nod2 .and. in2.eq.nod1) return
79
80 incr= 1
81 ioldadd= iarg
82 100 continue
83 inewadd= mod(ioldadd + incr**3, nbuckets)
84
85 if (inewadd .eq. ioldadd) then
86 icount= icount+ 1
87 ioldadd= ioldadd + 1
88 inewadd= ioldadd
89 endif
90
91 if (nflag .eq. 0) then
92 if (ieaddrs(inewadd).gt.hecmesh%n_adapt_edge) then
93 ieaddrs(inewadd)= 0
94 goto 50
95 endif
96 endif
97
98 if (ieaddrs(inewadd) .ne. 0) then
99 iedge= ieaddrs(inewadd)
100 in1= hecmesh%adapt_edge_node (2*iedge-1)
101 in2= hecmesh%adapt_edge_node (2*iedge )
102 !C
103 !C-- EXISTING EDGE
104 if (in1.eq.nod1 .and. in2.eq.nod2 .or. &
105 & in1.eq.nod2 .and. in2.eq.nod1) return
106 incr= incr + 1
107 go to 100
108
109 else
110 !C
111 !C-- NEW EDGE
112 hecmesh%n_adapt_edge= hecmesh%n_adapt_edge + 1
113 iedge= hecmesh%n_adapt_edge
114 hecmesh%adapt_edge_node (2*iedge-1)= nod1
115 hecmesh%adapt_edge_node (2*iedge )= nod2
116
117 ! if (inewadd.gt.nbuckets) write (*,*) nod1,nod2,inewadd
118 ieaddrs(inewadd)= iedge
119 return
120 endif
121 endif
122
123 return
124end
125
126
subroutine hecmw_adapt_edge_info(hecmesh, nod1, nod2, iedge, nflag)
Adaptive Mesh Refinement.
I/O and Utility.
Definition: hecmw_util_f.F90:7