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!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
30!|| shooting_node_mod ../engine/share/modules/shooting_node_mod.F
31!||====================================================================
32 SUBROUTINE find_edge_inter( ITAB,SHOOT_STRUCT,IXS,IXS10,
33 1 IXC,IXTG,IXQ,IXT,IXP,
34 2 IXR,GEO,NGROUP,IGROUPS,IPARG )
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
588 END SUBROUTINE find_edge_inter
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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:35
id
initmumps id
Definition multiplerhs_example.m:4
shooting_node_mod
Definition shooting_node_mod.F:46
shooting_node_mod::shooting_node_type
Definition shooting_node_mod.F:83