FrontISTR 5.2.0
Large-scale structural analysis program with finit element method
Loading...
Searching...
No Matches
hecmw_adapt_new_node.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_NEW_NODE
10!C***
11!C
12!C create NEW NODEs in TETRAHEDRAL REGION
13!C
14subroutine hecmw_adapt_new_node (hecMESH)
15
16 use hecmw_util
18 implicit real*8 (a-h,o-z)
19
20 integer(kind=kint), dimension(:), allocatable :: WR, WS, IW1, IW2
21
22 type (hecmwST_local_mesh) :: hecMESH
23
24 !C
25 !C-- INIT.
26
27 !C
28 !C +----------------+
29 !C | mid-edge POINT |
30 !C +----------------+
31 !C===
32 hecmesh%n_adapt_node_cur= hecmesh%n_node
33 hecmesh%n_adapt_node_old= hecmesh%n_node
34 intcount = hecmesh%nn_internal
35
36 icou= 0
37 do ie= 1, hecmesh%n_adapt_edge
38 n1= hecmesh%adapt_edge_node(2*ie-1)
39 n2= hecmesh%adapt_edge_node(2*ie )
40
41 if ( hecmesh%adapt_iemb(ie) .eq. 1) then
42 hecmesh%n_adapt_node_cur= hecmesh%n_adapt_node_cur + 1
43 if (hecmesh%n_adapt_node_cur.gt.hecmesh%nn_array) then
44 call hecmw_adapt_error_exit (hecmesh, 62)
45 endif
46
47 ieh= hecmesh%adapt_edge_home(ie)
48 nod= hecmesh%n_adapt_node_cur
49
50 hecmesh%node_ID(2*nod)= ieh
51 if (ieh.eq.hecmesh%my_rank) then
52 intcount= intcount + 1
53 hecmesh%adapt_mid_edge(ie)= intcount
54 hecmesh%node_ID(2*nod-1) = intcount
55 else
56 hecmesh%adapt_mid_edge(ie)= nod
57 hecmesh%node_ID (2*nod-1) = nod
58 endif
59
60 hecmesh%when_i_was_refined_node(nod)= hecmesh%n_adapt
61 hecmesh%adapt_IWK(ie) = nod
62
63 if (ieh.eq.hecmesh%my_rank) icou= icou + 1
64
65 hecmesh%node(3*nod-2)= 0.5d0 * ( hecmesh%node(3*n1-2) + &
66 & hecmesh%node(3*n2-2) )
67 hecmesh%node(3*nod-1)= 0.5d0 * ( hecmesh%node(3*n1-1) + &
68 & hecmesh%node(3*n2-1) )
69 hecmesh%node(3*nod )= 0.5d0 * ( hecmesh%node(3*n1 ) + &
70 & hecmesh%node(3*n2 ) )
71 endif
72 enddo
73
74 call mpi_barrier (hecmesh%MPI_COMM,ierr)
75
76 hecmesh%nn_adapt_internal_cur= hecmesh%nn_internal + icou
77 !C===
78
79 !C
80 !C +---------------+
81 !C | GLOBAL node # |
82 !C +---------------+
83 !C===
84
85 !C
86 !C-- OLD/NEW global NODE #
87 nodtotg_old= 0
88 nodtotg_cur= 0
89
90 call mpi_allreduce (hecmesh%nn_internal, nodtotg_old, 1, &
91 & mpi_integer, mpi_sum, hecmesh%MPI_COMM, ierr)
92 call mpi_allreduce (hecmesh%nn_adapt_internal_cur, nodtotg_cur, 1,&
93 & mpi_integer, mpi_sum, hecmesh%MPI_COMM, ierr)
94
95 if (hecmesh%my_rank.eq.0) then
96 write (*,'(" total node number (before)", i8 )') nodtotg_old
97 write (*,'(" total node number (curr. )", i8,/)') nodtotg_cur
98 endif
99
100 hecmesh%n_node = hecmesh%n_adapt_node_cur
101 hecmesh%nn_internal = hecmesh%nn_adapt_internal_cur
102
103 !C
104 !C-- exchange MIDEDG
105 allocate (iw1(hecmesh%n_adapt_edge))
106
107 iw1= hecmesh%adapt_mid_edge
108
109 n1= hecmesh%adapt_import_edge_index(hecmesh%n_neighbor_pe)
110 n2= hecmesh%adapt_export_edge_index(hecmesh%n_neighbor_pe)
111 m = max(n1, n2)
112 allocate (ws(m), wr(m))
113
114 ws= 0
115 wr= 0
117 & ( hecmesh%n_adapt_edge, &
118 & hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, &
119 & hecmesh%adapt_import_edge_index, &
120 & hecmesh%adapt_import_edge_item , &
121 & hecmesh%adapt_export_edge_index, &
122 & hecmesh%adapt_export_edge_item , &
123 & ws, wr, hecmesh%adapt_mid_edge, hecmesh%MPI_COMM, &
124 & hecmesh%my_rank, 1, m)
125 deallocate (ws, wr)
126
127 do ie= 1, hecmesh%n_adapt_edge
128 if (hecmesh%adapt_iemb(ie).eq.1 .and. &
129 & hecmesh%adapt_edge_home(ie).ne.hecmesh%my_rank) then
130 ing= hecmesh%adapt_mid_edge(ie)
131 inl= iw1(ie)
132 hecmesh%node_ID(2*inl )= hecmesh%adapt_edge_home(ie)
133 hecmesh%node_ID(2*inl-1)= ing
134 endif
135 enddo
136
137 do ie= 1, hecmesh%n_adapt_edge
138 if (hecmesh%adapt_iemb(ie).eq.1) then
139 inl= iw1(ie)
140 hecmesh%adapt_mid_edge(ie)= inl
141 endif
142 enddo
143 deallocate (iw1)
144 !C===
145
146 !C
147 !C +-------------+
148 !C | RE-ORDERING |
149 !C +-------------+
150 !C===
151 allocate (iw1(-1:hecmesh%n_neighbor_pe), &
152 & iw2(-1:hecmesh%n_neighbor_pe))
153 allocate (hecmesh%adapt_NEWtoOLD_node(hecmesh%n_node), &
154 & hecmesh%adapt_OLDtoNEW_node(hecmesh%n_node))
155
156 iw1= 0
157 iw2= 0
158 hecmesh%adapt_NEWtoOLD_node= 0
159 hecmesh%adapt_OLDtoNEW_node= 0
160
161 do in= 1, hecmesh%n_node
162 ih = hecmesh%node_ID(2*in)
163 ihr = hecmesh%rev_neighbor_pe(ih)
164 iw1(ihr)= iw1(ihr) + 1
165 enddo
166
167 do neib= 0, hecmesh%n_neighbor_pe
168 iw2(neib)= iw2(neib-1) + iw1(neib)
169 enddo
170
171 iw1= 0
172 do in= 1, hecmesh%n_node
173 ih = hecmesh%node_ID(2*in)
174 ihr = hecmesh%rev_neighbor_pe(ih)
175 iw1(ihr)= iw1(ihr) + 1
176 is = iw2(ihr-1) + iw1(ihr)
177 hecmesh%adapt_OLDtoNEW_node(in)= is
178 hecmesh%adapt_NEWtoOLD_node(is)= in
179 enddo
180 !C===
181
182 deallocate (iw1, iw2)
183
184 return
185end
186
187
188
189
190
191
subroutine hecmw_adapt_error_exit(hecmesh, iflag)
Adaptive Mesh Refinement.
subroutine hecmw_adapt_new_node(hecmesh)
Adaptive Mesh Refinement.
Adaptive Mesh Refinement.
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)
I/O and Utility.
Definition: hecmw_util_f.F90:7