OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
find_edge_inter.F File Reference
#include "implicit_f.inc"
#include "task_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine find_edge_inter (itab, shoot_struct, ixs, ixs10, ixc, ixtg, ixq, ixt, ixp, ixr, geo, ngroup, igroups, iparg)

Function/Subroutine Documentation

◆ find_edge_inter()

subroutine find_edge_inter ( integer, dimension(numnod), intent(in) itab,
type(shooting_node_type), intent(inout) shoot_struct,
integer, dimension(nixs,numels), intent(in), target ixs,
integer, dimension(6,numels10), intent(in), target ixs10,
integer, dimension(nixc,numelc), intent(in), target ixc,
integer, dimension(nixtg,numeltg), intent(in), target ixtg,
integer, dimension(nixq,numelq), intent(in), target ixq,
integer, dimension(nixt,numelt), intent(in), target ixt,
integer, dimension(nixp,numelp), intent(in), target ixp,
integer, dimension(nixr,numelr), intent(in), target ixr,
intent(in) geo,
integer, intent(in) ngroup,
integer, dimension(numels), intent(in) igroups,
integer, dimension(nparg,ngroup), intent(in) iparg )
Parameters
[in]ngroupsize of iparg
[in]igroupsarray to point to the element group
[in]ipargelement group data

Definition at line 33 of file find_edge_inter.F.

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
my_real
#define my_real
Definition cppsort.cpp:32