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 32 of file find_edge_inter.F.

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