OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
find_edge_inter.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| find_edge_inter ../engine/source/interfaces/interf/find_edge_inter.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| element_mod ../common_source/modules/elements/element_mod.F90
30!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
31!|| shooting_node_mod ../engine/share/modules/shooting_node_mod.F90
32!||====================================================================
33 SUBROUTINE find_edge_inter( ITAB,SHOOT_STRUCT,IXS,IXS10,
34 1 IXC,IXTG,IXQ,IXT,IXP,
35 2 IXR,GEO,NGROUP,IGROUPS,IPARG )
36!$COMMENT
37! FIND_EDGE_INTER description
38! this routine finds the edge id and the interfaces id of a list of deleted elements
39! FIND_EDGE_INTER organization
40! loop over the deleted element:
41! intersection of the edge list for the x nodes of the element --> give the edge id where
42! the nodes are defined
43! intersection of the proc list for the x nodes of the element --> give the proc id where
44! the nodes are defined
45!$ENDCOMMENT
46 USE intbufdef_mod
47 USE shooting_node_mod
48 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "task_c.inc"
57#include "com04_c.inc"
58#include "param_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER, DIMENSION(NIXS,NUMELS),TARGET, INTENT(in) :: IXS ! solid array
63 INTEGER, DIMENSION(6,NUMELS10),TARGET, INTENT(in) :: IXS10 ! tetra10 array
64 INTEGER, DIMENSION(NIXC,NUMELC),TARGET, INTENT(in) :: IXC ! shell array
65 INTEGER, DIMENSION(NIXTG,NUMELTG),TARGET, INTENT(in) :: IXTG! triangle array
66 INTEGER, DIMENSION(NIXQ,NUMELQ),TARGET, INTENT(in) :: IXQ! quad array
67 INTEGER, DIMENSION(NIXT,NUMELT),TARGET, INTENT(in) :: IXT! truss array
68 INTEGER, DIMENSION(NIXP,NUMELP),TARGET, INTENT(in) :: IXP! beam array
69 INTEGER, DIMENSION(NIXR,NUMELR),TARGET, INTENT(in) :: IXR! spring array
70 INTEGER, DIMENSION(NUMNOD), INTENT(in) :: ITAB ! array to convert local id to global id
71 my_real, DIMENSION(NPROPG,NUMGEO), INTENT(in) :: geo
72 INTEGER, INTENT(in) :: NGROUP !< size of iparg
73 INTEGER, DIMENSION(NUMELS), INTENT(in) :: IGROUPS !< array to point to the element group
74 INTEGER, DIMENSION(NPARG,NGROUP), INTENT(in) :: IPARG !< element group data
75 TYPE(shooting_node_type), INTENT(inout) :: SHOOT_STRUCT ! structure for shooting node algo
76
77! INTEGER, DIMENSION(SIZE_SEC_NODE), INTENT(in) :: INTER_SEC_NODE,SEC_NODE_ID ! list of interface of the nodes & ID of secondary nodes in each interface
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER :: I,J,K,N,IJK
82 INTEGER :: NODE_ID,NODE_ID_1,NODE_ID_2,ELEM_ID
83 INTEGER :: OFFSET_SOLID,OFFSET_QUAD,OFFSET_SHELL,OFFSET_TRUSS
84 INTEGER :: OFFSET_BEAM,OFFSET_SPRING,OFFSET_TRIANGLE,OFFSET_UR
85 INTEGER, DIMENSION(2,12), TARGET :: EDGES_SOL ! definition of edge for solid
86 INTEGER, DIMENSION(2,6), TARGET :: EDGES_TETRA4 ! definition of edge for tetra4
87 INTEGER, DIMENSION(2,9), TARGET :: EDGES_PENTA6 ! definition of edge for penta6
88 INTEGER, DIMENSION(2,24), TARGET :: EDGES_TETRA10 ! definition of edge for tetra10
89 INTEGER, DIMENSION(2,4), TARGET :: EDGES_SHELL ! definition of edge for shell/quad
90 INTEGER, DIMENSION(2,3), TARGET :: EDGES_TRI ! definition of edge for triangle & spring type12
91 INTEGER, DIMENSION(2,1), TARGET :: EDGES_2DELM ! definition of edge for 2d element : truss/beam/spring
92 INTEGER, DIMENSION(2,2), TARGET :: EDGES_SPRING_TYP12 ! definition of edge spring type 12
93 INTEGER,DIMENSION(:,:), POINTER :: POINTER_EDGE,IX,IX_TETRA10
94
95 LOGICAL :: NO_EDGE,DO_COMPUTATION
96 INTEGER :: SHIFT,SHIFT_ELM,OLD_SIZE
97 INTEGER :: EDGE_NUMBER
98 INTEGER :: NB_PROC_1,NB_PROC_2,NODE_EDGE_NB,SEVERAL_PROC,SEVERAL_EDGE
99 INTEGER :: NB_RESULT_INTERSECT,NB_RESULT_INTERSECT_2,NB_EDGE_1,NB_EDGE_2
100 INTEGER :: NB_RESULT_INTERSECT_3
101 INTEGER, DIMENSION(:), ALLOCATABLE :: RESULT_INTERSECT,INTERSECT_1,INTERSECT_2
102 INTEGER, DIMENSION(:), ALLOCATABLE :: RESULT_INTERSECT_2,INTERSECT_3,INTERSECT_4
103 INTEGER, DIMENSION(:), ALLOCATABLE :: RESULT_INTERSECT_3
104 INTEGER, DIMENSION(:), ALLOCATABLE :: TMP_ARRAY
105 INTEGER, DIMENSION(4) :: LOCAL_NODE
106 INTEGER :: GROUP_NUMBER
107 INTEGER :: KIND_SOLID
108C-----------------------------------------------
109 edges_shell(1:2,1) = (/1,2/)
110 edges_shell(1:2,2) = (/2,3/)
111 edges_shell(1:2,3) = (/3,4/)
112 edges_shell(1:2,4) = (/4,1/)
113
114 edges_tri(1:2,1) = (/1,2/)
115 edges_tri(1:2,2) = (/2,3/)
116 edges_tri(1:2,3) = (/3,1/)
117
118 edges_spring_typ12(1:2,1) = (/1,2/)
119 edges_spring_typ12(1:2,2) = (/2,3/)
120
121 edges_2delm(1:2,1) = (/1,2/)
122
123 edges_tetra4(1:2,1) = (/2,3/)
124 edges_tetra4(1:2,2) = (/3,6/)
125 edges_tetra4(1:2,3) = (/2,6/)
126 edges_tetra4(1:2,4) = (/2,5/)
127 edges_tetra4(1:2,5) = (/3,5/)
128 edges_tetra4(1:2,6) = (/6,5/)
129
130 edges_penta6(1:2,1) = (/1,2/)
131 edges_penta6(1:2,2) = (/2,3/)
132 edges_penta6(1:2,3) = (/3,1/)
133 edges_penta6(1:2,4) = (/2,6/)
134 edges_penta6(1:2,5) = (/6,5/)
135 edges_penta6(1:2,6) = (/5,1/)
136 edges_penta6(1:2,7) = (/3,7/)
137 edges_penta6(1:2,8) = (/7,6/)
138 edges_penta6(1:2,9) = (/7,5/)
139
140 edges_sol(1:2,1) = (/1,2/)
141 edges_sol(1:2,2) = (/2,3/)
142 edges_sol(1:2,3) = (/3,4/)
143 edges_sol(1:2,4) = (/4,1/)
144 edges_sol(1:2,5) = (/2,6/)
145 edges_sol(1:2,6) = (/6,5/)
146 edges_sol(1:2,7) = (/5,1/)
147 edges_sol(1:2,8) = (/3,7/)
148 edges_sol(1:2,9) = (/7,6/)
149 edges_sol(1:2,10) = (/4,8/)
150 edges_sol(1:2,11) = (/8,7/)
151 edges_sol(1:2,12) = (/5,8/)
152
153 edges_tetra10(1:2,1) = (/1,11/)
154 edges_tetra10(1:2,2) = (/11,14/)
155 edges_tetra10(1:2,3) = (/14,1 /)
156 edges_tetra10(1:2,4) = (/ 3,11/)
157 edges_tetra10(1:2,5) = (/11,15/)
158 edges_tetra10(1:2,6) = (/15,3 /)
159 edges_tetra10(1:2,7) = (/ 5,14/)
160 edges_tetra10(1:2,8) = (/14,15/)
161 edges_tetra10(1:2,9) = (/15,5 /)
162 edges_tetra10(1:2,10) = (/ 1,13/)
163 edges_tetra10(1:2,11) = (/13,14/)
164 edges_tetra10(1:2,12) = (/ 6,13/)
165 edges_tetra10(1:2,13) = (/13,16/)
166 edges_tetra10(1:2,14) = (/16,6 /)
167 edges_tetra10(1:2,15) = (/14,16/)
168 edges_tetra10(1:2,16) = (/16,5 /)
169 edges_tetra10(1:2,17) = (/11,12/)
170 edges_tetra10(1:2,18) = (/12,3 /)
171 edges_tetra10(1:2,19) = (/ 6,12/)
172 edges_tetra10(1:2,20) = (/12,13/)
173 edges_tetra10(1:2,21) = (/11,13/)
174 edges_tetra10(1:2,22) = (/12,15/)
175 edges_tetra10(1:2,23) = (/12,16/)
176 edges_tetra10(1:2,24) = (/15,16/)
177
178 ! --------------------------
179 offset_solid = 0
180 offset_quad=offset_solid+numels
181 offset_shell=offset_quad+numelq
182 offset_truss=offset_shell+numelc
183 offset_beam=offset_truss+numelt
184 offset_spring=offset_beam+numelp
185 offset_triangle=offset_spring+numelr
186 offset_ur=offset_triangle+numeltg
187 ! --------------------------
188
189 ! --------------------------
190 ! allocation of SAVE_EDGE : index of deactivated edge
191 shoot_struct%S_SAVE_M_EDGE = 2*shoot_struct%S_GLOBAL_ELEM_INDEX ! size of SAVE_EDGE array
192 ALLOCATE( shoot_struct%SAVE_M_EDGE( shoot_struct%S_SAVE_M_EDGE ) )
193 shoot_struct%S_SAVE_S_EDGE = 2*shoot_struct%S_GLOBAL_ELEM_INDEX ! size of SAVE_EDGE array
194 ALLOCATE( shoot_struct%SAVE_S_EDGE( shoot_struct%S_SAVE_S_EDGE ) )
195
196 shoot_struct%SAVE_M_EDGE_NB = 0 ! number of deactivated edge : main nodes
197 shoot_struct%SAVE_S_EDGE_NB = 0 ! number of deactivated edge : main nodes
198 shoot_struct%SAVE_M_EDGE( 1:shoot_struct%S_SAVE_M_EDGE ) = 0
199 shoot_struct%SAVE_S_EDGE( 1:shoot_struct%S_SAVE_S_EDGE ) = 0
200 ! --------------------------
201 ! allocation of SAVE_PROC : index of processor with the 4 nodes + 4 node ids
202 shoot_struct%S_SAVE_PROC_EDGE = 3*shoot_struct%S_GLOBAL_ELEM_INDEX ! size of SAVE_PROC array
203
204 ALLOCATE( shoot_struct%SAVE_PROC_EDGE( shoot_struct%S_SAVE_PROC_EDGE ) )
205 shoot_struct%SAVE_PROC_NB_EDGE = 0 ! number of processor + 2 nodes of deactivated edges
206 shoot_struct%SAVE_PROC_EDGE( 1:shoot_struct%S_SAVE_PROC_EDGE ) = 0
207 ! --------------------------
208 ! working array : edge
209 ALLOCATE( result_intersect( shoot_struct%MAX_EDGE_NB ) )
210 ALLOCATE( result_intersect_3( shoot_struct%MAX_EDGE_NB ) )
211 ALLOCATE( intersect_1( shoot_struct%MAX_EDGE_NB ) )
212 ALLOCATE( intersect_2( shoot_struct%MAX_EDGE_NB ) )
213 ! working array : processor
214 ALLOCATE( result_intersect_2( shoot_struct%MAX_PROC_NB ) )
215 ALLOCATE( intersect_3( shoot_struct%MAX_PROC_NB ) )
216 ALLOCATE( intersect_4( shoot_struct%MAX_PROC_NB ) )
217
218 node_edge_nb = 2 ! number of node per edge
219 ! --------------------------
220 DO i=1,shoot_struct%S_GLOBAL_ELEM_INDEX
221 elem_id = shoot_struct%GLOBAL_ELEM_INDEX(i) ! get the id of the deleted element
222 do_computation = .true.
223 ! ----------------------
224 kind_solid = 0
225 ix_tetra10 => null()
226 IF(elem_id<=numels8) THEN
227 ! solid element : 8 nodes --> 12 edges
228 ! o----o
229 ! /+ /|
230 ! o-+--o |
231 ! | o++|+o
232 ! |+ |/
233 ! o----o
234 ! penta element : 6 nodes --> 9 edges
235 ! o
236 ! /+\
237 ! o+ \
238 ! /\o++/o
239 ! /+ \ /
240 ! o----o
241 ! tetra4 element : 4 nodes --> 6 edges
242 ! o
243 ! /+\
244 ! / + \
245 ! / + \
246 ! / o \
247 ! / + + \
248 ! o-----------o
249 group_number = igroups(elem_id)
250 kind_solid = iparg(28,group_number)
251 ! -------------
252 ! tetra4
253 IF(kind_solid==4) THEN
254 edge_number = 6 ! number of edge
255 pointer_edge => edges_tetra4(1:2,1:6)
256 ! -------------
257 ! penta6
258 ELSEIF(kind_solid==6) THEN
259 edge_number = 9 ! number of edge
260 pointer_edge => edges_penta6(1:2,1:9)
261 ! -------------
262 ! solid8
263 ELSE
264 kind_solid = 8
265 edge_number = 12 ! number of edge
266 pointer_edge => edges_sol(1:2,1:12)
267 ENDIF
268 ! -------------
269 ix => ixs(1:nixs,1:numels)
270 shift_elm = offset_solid
271 ELSEIF(elem_id<=numels8+numels10) THEN
272 ! solid element : tetra10 --> 10 surfaces
273 ! 4 internal surfaces per "real surfaces"
274 ! tetra4 --> tetra10
275 ! 3d view 2d view (draw a tetra10 with 3d view is really hard :) )
276 ! o o
277 ! /+\ / \
278 ! / + \ / \
279 ! / + \ o-----o
280 ! / o \ / \ / \
281 ! / + + \ / \ / \
282 ! o-----------o o---- o ----o
283 edge_number = 24 ! number of edge
284 ix => ixs(1:nixs,1:numels)
285 ix_tetra10 => ixs10(1:6,1:numels10)
286 pointer_edge => edges_tetra10(1:2,1:24)
287 shift_elm = numels8
288 ELSEIF(elem_id<=numels) THEN
289 ! other solid element : at least 8 nodes --> 12 edges
290 ! o----o
291 ! /| /|
292 ! o----o |
293 ! | o--|-o
294 ! |/ |/
295 ! o----o
296 edge_number = 12 ! number of edge
297 ix => ixs(1:nixs,1:numels)
298 pointer_edge => edges_sol(1:2,1:12)
299 shift_elm = offset_solid
300 ELSEIF(elem_id<=offset_shell) THEN
301 ! quad element
302 ! 4 nodes / 4 edges
303 ! o----o
304 ! | |
305 ! | |
306 ! o----o
307 edge_number = 4 ! number of edges
308 ix => ixq(1:nixq,1:numelq)
309 pointer_edge => edges_shell(1:2,1:4)
310 shift_elm = offset_quad
311 do_computation = .false.
312 ELSEIF(elem_id<=offset_truss) THEN
313 ! shell element
314 ! 4 nodes / 4 edges
315 ! o----o
316 ! | |
317 ! | |
318 ! o----o
319 edge_number = 4 ! number of edges
320 ix => ixc(1:nixc,1:numelc)
321 pointer_edge => edges_shell(1:2,1:4)
322 shift_elm = offset_shell
323 ELSEIF(elem_id<=offset_beam) THEN
324 ! truss
325 ! 2 nodes / 1 edges
326 ! o----o
327 edge_number = 1 ! number of edges
328 ix => ixt(1:nixt,1:numelt)
329 pointer_edge => edges_2delm(1:2,1:1)
330 shift_elm = offset_truss
331 ELSEIF(elem_id<=offset_spring) THEN
332 ! beam element
333 ! 2 nodes / 1 edges
334 ! o----o
335 edge_number = 1 ! number of edges
336 ix => ixp(1:nixp,1:numelp)
337 pointer_edge => edges_2delm(1:2,1:1)
338 shift_elm = offset_beam
339 ELSEIF(elem_id<=offset_triangle) THEN
340 ! spring element
341 ! 2 nodes / 1 edges
342 ! o----o
343 edge_number = 1 ! number of edges
344 ix => ixr(1:nixr,1:numelr)
345 pointer_edge => edges_2delm(1:2,1:1)
346 shift_elm = offset_spring
347 IF(nint(geo(12,ixr(1,elem_id-shift_elm)))==12) THEN
348 ! spring element type 12 :
349 ! 3 nodes / 2 edges
350 ! o--o--o
351 edge_number = 2 ! number of edges
352 pointer_edge => edges_spring_typ12(1:2,1:2)
353 ENDIF
354 ELSEIF(elem_id<=offset_ur) THEN
355 ! triangle element
356 ! 3 nodes / 3 edges
357 ! o
358 ! / \
359 ! / \
360 ! o-----o
361 edge_number = 3 ! number of surface
362 ix => ixtg(1:nixtg,1:numeltg)
363 pointer_edge => edges_tri(1:2,1:3)
364 shift_elm = offset_triangle
365 ELSE
366 ! user element
367 do_computation = .false.
368 ENDIF
369 ! ----------------------
370 IF(do_computation) THEN
371 ! ----------------------
372 ! loop over the edges of the element
373 DO k=1,edge_number
374 several_proc = 0
375 several_edge = 0
376 no_edge = .false.
377 ! ------------------
378 ! MAIN NODE
379 ! Initialization of edge/proc for the first node
380 n = pointer_edge(1,k) ! get the node of the edge
381 IF(n<10) THEN
382 node_id = ix(n+1,elem_id-shift_elm) ! get the node ID
383 ELSE
384 node_id = ix_tetra10(n-10,elem_id-shift_elm) ! get the node ID
385 ENDIF
386 node_id_1 = node_id
387 local_node(1) = node_id
388 nb_edge_1 = shoot_struct%SHIFT_M_NODE_EDGE(node_id+1) - shoot_struct%SHIFT_M_NODE_EDGE(node_id) ! get the number of edge of the node
389 shift = shoot_struct%SHIFT_M_NODE_EDGE(node_id)
390 intersect_1(1:nb_edge_1) = shoot_struct%M_NODE_EDGE( shift+1:shift+nb_edge_1 )
391 ! processor init
392 nb_proc_1 = shoot_struct%SHIFT_M_NODE_PROC(node_id+1) - shoot_struct%SHIFT_M_NODE_PROC(node_id) ! get the number of processor of the node
393 shift = shoot_struct%SHIFT_M_NODE_PROC(node_id)
394 intersect_3(1:nb_proc_1) = shoot_struct%M_NODE_PROC( shift+1:shift+nb_proc_1 )
395 ! ------------------
396 ! Initialization of edge/proc for the second node
397 n = pointer_edge(2,k) ! get the node of the edge
398 IF(n<10) THEN
399 node_id = ix(n+1,elem_id-shift_elm) ! get the node ID
400 ELSE
401 node_id = ix_tetra10(n-10,elem_id-shift_elm) ! get the node ID
402 ENDIF
403 node_id_2 = node_id
404 local_node(2) = node_id
405 nb_edge_2 = shoot_struct%SHIFT_M_NODE_EDGE(node_id+1) - shoot_struct%SHIFT_M_NODE_EDGE(node_id) ! get the number of edge of the node
406 shift = shoot_struct%SHIFT_M_NODE_EDGE(node_id)
407 intersect_2(1:nb_edge_2) = shoot_struct%M_NODE_EDGE( shift+1:shift+nb_edge_2 )
408 ! processor init
409 nb_proc_2 = shoot_struct%SHIFT_M_NODE_PROC(node_id+1) - shoot_struct%SHIFT_M_NODE_PROC(node_id) ! get the number of processor of the node
410 shift = shoot_struct%SHIFT_M_NODE_PROC(node_id)
411 intersect_4(1:nb_proc_2) = shoot_struct%M_NODE_PROC( shift+1:shift+nb_proc_2 )
412 ! ------------------
413
414 IF( node_id_1 /= node_id_2 ) THEN
415 ! -----------------------
416 ! intersection of main edge
417 nb_result_intersect = 0
418 IF(nb_edge_1>0.AND.nb_edge_2>0) THEN
419 CALL intersect_2_sorted_sets( intersect_1,nb_edge_1,
420 . intersect_2,nb_edge_2,
421 . result_intersect,nb_result_intersect )
422 ELSE
423 nb_result_intersect = 0
424 ENDIF
425 ! end : intersection of edge
426 ! -----------------------
427
428 ! -----------------------
429 ! intersection of processor
430 IF(nb_proc_1>1.AND.nb_proc_2>1) THEN
431 CALL intersect_2_sorted_sets( intersect_3,nb_proc_1,
432 . intersect_4,nb_proc_2,
433 . result_intersect_2,nb_result_intersect_2 )
434 ELSE
435 nb_result_intersect_2 = 0
436 ENDIF
437 ! end : intersection of processor
438 ! -----------------------
439 ELSE
440 nb_result_intersect = 0
441 nb_result_intersect_2 = 0
442 ENDIF
443
444
445 ! ------------------
446 ! SECONDARY NODE
447 ! Initialization of edge/proc for the first node
448 n = pointer_edge(1,k) ! get the node of the edge
449 IF(n<10) THEN
450 node_id = ix(n+1,elem_id-shift_elm) ! get the node ID
451 ELSE
452 node_id = ix_tetra10(n-10,elem_id-shift_elm) ! get the node ID
453 ENDIF
454 local_node(3) = node_id
455 nb_edge_1 = shoot_struct%SHIFT_S_NODE_EDGE(node_id+1) - shoot_struct%SHIFT_S_NODE_EDGE(node_id) ! get the number of edge of the node
456 shift = shoot_struct%SHIFT_S_NODE_EDGE(node_id)
457 intersect_1(1:nb_edge_1) = shoot_struct%S_NODE_EDGE( shift+1:shift+nb_edge_1 )
458 ! ------------------
459 ! Initialization of edge/proc for the second node
460 n = pointer_edge(2,k) ! get the node of the edge
461 IF(n<10) THEN
462 node_id = ix(n+1,elem_id-shift_elm) ! get the node ID
463 ELSE
464 node_id = ix_tetra10(n-10,elem_id-shift_elm) ! get the node ID
465 ENDIF
466 local_node(4) = node_id
467 nb_edge_2 = shoot_struct%SHIFT_S_NODE_EDGE(node_id+1) - shoot_struct%SHIFT_S_NODE_EDGE(node_id) ! get the number of edge of the node
468 shift = shoot_struct%SHIFT_S_NODE_EDGE(node_id)
469 intersect_2(1:nb_edge_2) = shoot_struct%S_NODE_EDGE( shift+1:shift+nb_edge_2 )
470 ! ------------------
471
472 IF( node_id_1 /= node_id_2 ) THEN
473 ! -----------------------
474 ! intersection of secondary edge
475 nb_result_intersect_3 = 0
476 IF(nb_edge_1>0.AND.nb_edge_2>0) THEN
477 CALL intersect_2_sorted_sets( intersect_1,nb_edge_1,
478 . intersect_2,nb_edge_2,
479 . result_intersect_3,nb_result_intersect_3 )
480 ELSE
481 nb_result_intersect_3 = 0
482 ENDIF
483 ! end : intersection of edge
484 ! -----------------------
485 ELSE
486 nb_result_intersect_3 = 0
487 ENDIF
488
489 IF(nb_result_intersect>0) THEN
490 ! one or several edge on the current processor
491 ! save the edge id
492 IF( shoot_struct%SAVE_M_EDGE_NB+nb_result_intersect>shoot_struct%S_SAVE_M_EDGE) THEN
493 ALLOCATE( tmp_array(shoot_struct%S_SAVE_M_EDGE) )
494 tmp_array(1:shoot_struct%S_SAVE_M_EDGE) = shoot_struct%SAVE_M_EDGE(1:shoot_struct%S_SAVE_M_EDGE)
495
496 DEALLOCATE( shoot_struct%SAVE_M_EDGE )
497 old_size = shoot_struct%S_SAVE_M_EDGE
498 shoot_struct%S_SAVE_M_EDGE = 1.20*(shoot_struct%S_SAVE_M_EDGE+5*nb_result_intersect)
499 ALLOCATE( shoot_struct%SAVE_M_EDGE( shoot_struct%S_SAVE_M_EDGE ) )
500 shoot_struct%SAVE_M_EDGE(1:old_size) = tmp_array(1:old_size)
501 DEALLOCATE( tmp_array )
502 ENDIF
503 DO j=1,nb_result_intersect
504 shoot_struct%SAVE_M_EDGE_NB = shoot_struct%SAVE_M_EDGE_NB + 1
505 shoot_struct%SAVE_M_EDGE( shoot_struct%SAVE_M_EDGE_NB ) = result_intersect(j)
506 ENDDO
507 ENDIF
508
509 IF(nb_result_intersect_2>1) THEN !SEVERAL_PROC==NODE_SURF_NB) THEN
510 ! one or several edge on a remote processor :
511 ! save the remote proc id & the node id
512 ! | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | ...
513 ! pi n1 n2 pj n1 n3 pk n3 n10
514 ! proc id & the 2 nodes
515
516
517 IF( shoot_struct%SAVE_PROC_NB_EDGE+3*(nb_result_intersect_2-1)>
518 . shoot_struct%S_SAVE_PROC_EDGE) THEN
519 ALLOCATE( tmp_array(shoot_struct%S_SAVE_PROC_EDGE) )
520 tmp_array(1:shoot_struct%S_SAVE_PROC_EDGE) =
521 . shoot_struct%SAVE_PROC_EDGE(1:shoot_struct%S_SAVE_PROC_EDGE)
522
523 DEALLOCATE( shoot_struct%SAVE_PROC_EDGE )
524 old_size = shoot_struct%S_SAVE_PROC_EDGE
525 shoot_struct%S_SAVE_PROC_EDGE =
526 . 1.20*(shoot_struct%SAVE_PROC_NB_EDGE+3*(nb_result_intersect_2-1))
527 ALLOCATE( shoot_struct%SAVE_PROC_EDGE( shoot_struct%S_SAVE_PROC_EDGE ) )
528 shoot_struct%SAVE_PROC_EDGE(1:old_size) = tmp_array(1:old_size)
529 DEALLOCATE( tmp_array )
530 ENDIF
531
532 DO j=1,nb_result_intersect_2
533 IF(result_intersect_2(j)/=ispmd+1) THEN
534 shoot_struct%SAVE_PROC_NB_EDGE = shoot_struct%SAVE_PROC_NB_EDGE + 1
535 shoot_struct%SAVE_PROC_EDGE( shoot_struct%SAVE_PROC_NB_EDGE ) = result_intersect_2(j) ! save the remote proc id
536
537 DO ijk=1,2
538 shoot_struct%SAVE_PROC_NB_EDGE =
539 . shoot_struct%SAVE_PROC_NB_EDGE + 1
540 shoot_struct%SAVE_PROC_EDGE( shoot_struct%SAVE_PROC_NB_EDGE ) =
541 . itab(local_node(ijk)) ! convert local id to global id
542 ENDDO
543 ENDIF
544 ENDDO
545 ELSE
546 ! no edge on the current processor or on a remote processor
547 ENDIF
548
549 IF(nb_result_intersect_3>0) THEN
550 ! one or several edge on the current processor
551 ! save the edge id
552
553 IF( shoot_struct%SAVE_S_EDGE_NB+nb_result_intersect_3>
554 . shoot_struct%S_SAVE_S_EDGE) THEN
555 ALLOCATE( tmp_array(shoot_struct%S_SAVE_S_EDGE) )
556 tmp_array(1:shoot_struct%S_SAVE_S_EDGE) = shoot_struct%SAVE_S_EDGE(1:shoot_struct%S_SAVE_S_EDGE)
557
558 DEALLOCATE( shoot_struct%SAVE_S_EDGE )
559 old_size = shoot_struct%S_SAVE_S_EDGE
560 shoot_struct%S_SAVE_S_EDGE = 1.20*(shoot_struct%S_SAVE_S_EDGE+5*nb_result_intersect_3)
561 ALLOCATE( shoot_struct%SAVE_S_EDGE( shoot_struct%S_SAVE_S_EDGE ) )
562 shoot_struct%SAVE_S_EDGE(1:old_size) = tmp_array(1:old_size)
563 DEALLOCATE( tmp_array )
564 ENDIF
565 DO j=1,nb_result_intersect_3
566 shoot_struct%SAVE_S_EDGE_NB = shoot_struct%SAVE_S_EDGE_NB + 1
567 shoot_struct%SAVE_S_EDGE( shoot_struct%SAVE_S_EDGE_NB ) = result_intersect_3(j)
568 ENDDO
569 ENDIF
570 ENDDO
571 ! end : loop over the surfaces of the element
572 ! ----------------------
573 ENDIF
574 ENDDO
575 ! --------------------------
576
577 ! --------------------------
578 ! working array : surface
579 DEALLOCATE( result_intersect )
580 DEALLOCATE( result_intersect_3 )
581 DEALLOCATE( intersect_1 )
582 DEALLOCATE( intersect_2 )
583 ! working array : processor
584 DEALLOCATE( result_intersect_2 )
585 DEALLOCATE( intersect_3 )
586 DEALLOCATE( intersect_4 )
587 ! --------------------------
588
589 RETURN
590 END SUBROUTINE find_edge_inter
my_real
#define my_real
Definition cppsort.cpp:32
find_edge_inter
subroutine find_edge_inter(itab, shoot_struct, ixs, ixs10, ixc, ixtg, ixq, ixt, ixp, ixr, geo, ngroup, igroups, iparg)
Definition find_edge_inter.F:36