OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ale_connectivity_mod.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!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
25!||--- called by ------------------------------------------------------
26!|| a4conv3 ../engine/source/ale/ale3d/a4conv3.F
27!|| a4flux3 ../engine/source/ale/ale3d/a4flux3.F
28!|| aconv2 ../engine/source/ale/ale2d/aconv2.F
29!|| aconv3 ../engine/source/ale/ale3d/aconv3.F
30!|| aconve ../engine/source/ale/aconve.F
31!|| adiff2 ../engine/source/ale/ale2d/adiff2.F
32!|| adiff3 ../engine/source/ale/ale3d/adiff3.F
33!|| aeturb ../engine/source/ale/turbulence/aeturb.F
34!|| afimp2 ../engine/source/ale/ale2d/afimp2.F
35!|| afimp3 ../engine/source/ale/ale3d/afimp3.F
36!|| aflux0 ../engine/source/ale/aflux0.F
37!|| aflux2 ../engine/source/ale/ale2d/aflux2.F
38!|| aflux3 ../engine/source/ale/ale3d/aflux3.F
39!|| afluxt ../engine/source/ale/ale51/afluxt.F
40!|| agaug3 ../engine/source/ale/agauge.F
41!|| agaug3q ../engine/source/ale/agaug3q.F
42!|| agaug3t ../engine/source/ale/agaug3t.F
43!|| agauge ../engine/source/ale/agauge.F
44!|| agrad0 ../engine/source/ale/agrad0.F
45!|| agrad2 ../engine/source/ale/ale2d/agrad2.F
46!|| agrad3 ../engine/source/ale/ale3d/agrad3.F
47!|| akturb ../engine/source/ale/turbulence/akturb.F
48!|| ale51_antidiff2 ../engine/source/ale/ale51/ale51_antidiff2.F
49!|| ale51_antidiff3 ../engine/source/ale/ale51/ale51_antidiff3.F
50!|| ale51_finish ../engine/source/ale/ale51/ale51_finish.F
51!|| ale51_gradient_reconstruction ../engine/source/ale/alemuscl/ale51_gradient_reconstruction.F
52!|| ale51_gradient_reconstruction2 ../engine/source/ale/alemuscl/ale51_gradient_reconstruction2.F
53!|| ale51_init ../engine/source/ale/ale51/ale51_init.F
54!|| ale51_spmd2 ../engine/source/ale/ale51/ale51_spmd2.F
55!|| ale51_spmd3 ../engine/source/ale/ale51/ale51_spmd3.F
56!|| ale51_upwind2 ../engine/source/ale/ale51/ale51_upwind2.f
57!|| ale51_upwind3 ../engine/source/ale/ale51/ale51_upwind3.F
58!|| aleconv3 ../engine/source/ale/porous/aleconv.F
59!|| aleconve ../engine/source/ale/porous/aleconv.F
60!|| aleflow ../engine/source/ale/porous/aleflow.F
61!|| aleflux ../engine/source/ale/porous/aleflux.F
62!|| alefvm_aflux3 ../engine/source/ale/alefvm/alefvm_aflux3.F
63!|| alefvm_eflux3 ../engine/source/ale/alefvm/alefvm_eflux3.F
64!|| alefvm_main ../engine/source/ale/alefvm/alefvm_main.F
65!|| alefvm_sfint3 ../engine/source/ale/alefvm/alefvm_sfint3.F
66!|| alefvm_tfext ../engine/source/ale/alefvm/alefvm_tfext.F
67!|| alelec ../starter/source/ale/alelec.F
68!|| alemain ../engine/source/ale/alemain.F
69!|| alemuscl_upwind ../engine/source/ale/alemuscl/alemuscl_upwind.F
70!|| alemuscl_upwind2 ../engine/source/ale/alemuscl/alemuscl_upwind2.f
71!|| aleso2 ../starter/source/ale/ale2d/aleso2.F
72!|| aleso2t ../starter/source/ale/ale2d/aleso2t.F
73!|| aleso3 ../starter/source/ale/ale3d/aleso3.F
74!|| alesop ../starter/source/ale/alesop.F
75!|| alethe ../engine/source/ale/alethe.F
76!|| alew ../engine/source/ale/grid/alew.F
77!|| alew1 ../engine/source/ale/grid/alew1.f
78!|| alew5 ../engine/source/ale/grid/alew5.F
79!|| alew6 ../engine/source/ale/grid/alew6.F
80!|| alewdx ../engine/source/ale/grid/alewdx.F
81!|| amulf2 ../engine/source/ale/bimat/amulf2.F
82!|| arezo2 ../engine/source/ale/ale2d/arezo2.F
83!|| arezo3 ../engine/source/ale/ale3d/arezo3.F
84!|| arezon ../engine/source/ale/arezon.F
85!|| atherm ../engine/source/ale/atherm.F
86!|| bconv2 ../engine/source/ale/ale2d/bconv2.F
87!|| bcs_wall_trigger ../engine/source/boundary_conditions/bcs_wall_trigger.F90
88!|| bforc2 ../engine/source/ale/bimat/bforc2.F
89!|| binit2 ../starter/source/ale/bimat/binit2.f
90!|| brezo2 ../engine/source/ale/ale2d/brezo2.F
91!|| brezo2_sig ../engine/source/ale/ale2d/brezo2.F
92!|| build_connectivity ../engine/source/multifluid/connectivity.F
93!|| c_idglob ../starter/source/restart/ddsplit/c_idglob.F
94!|| c_ixfloc ../starter/source/restart/ddsplit/c_ixfloc.F
95!|| c_spmd_ne_connect ../starter/source/ale/spmd_ne_connect.F
96!|| c_vois ../starter/source/restart/ddsplit/c_vois.F
97!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
98!|| dfunc0 ../engine/source/output/anim/generate/dfunc0.F
99!|| dfuncc ../engine/source/output/anim/generate/dfuncc.F
100!|| dfuncs ../engine/source/output/anim/generate/dfunc6.F
101!|| ede112 ../engine/source/ale/euler2d/ede112.F
102!|| eflux2 ../engine/source/ale/euler2d/eflux2.F
103!|| eflux3 ../engine/source/ale/euler3d/eflux3.F
104!|| egrad2 ../engine/source/ale/euler2d/egrad2.F
105!|| egrad3 ../engine/source/ale/euler3d/egrad3.F
106!|| eig ../engine/stub/eig.F
107!|| eig1 ../engine/stub/eig1.F
108!|| eigcond ../engine/stub/eigcond.F
109!|| eigp ../engine/stub/eigp.F
110!|| eikonal_compute_adjacent ../starter/source/initial_conditions/detonation/eikonal_compute_adjacent.F90
111!|| eikonal_fast_marching_method ../starter/source/initial_conditions/detonation/eikonal_fast_marching_method.F90
112!|| eikonal_init_start_list_2d ../starter/source/initial_conditions/detonation/eikonal_init_start_list_2d.F90
113!|| eikonal_solver ../starter/source/initial_conditions/detonation/eikonal_solver.F90
114!|| eporin3 ../starter/source/ale/ale3d/eporin3.F
115!|| findele ../starter/source/boundary_conditions/ebcs/findele.F
116!|| forint ../engine/source/elements/forint.F
117!|| funct_python_update_elements ../engine/source/tools/curve/funct_python_update_elements.F90
118!|| genani ../engine/source/output/anim/generate/genani.F
119!|| genh3d ../engine/source/output/h3d/h3d_results/genh3d.F
120!|| gradient_reconstruction ../engine/source/ale/alemuscl/gradient_reconstruction.F
121!|| gradient_reconstruction2 ../engine/source/ale/alemuscl/gradient_reconstruction2.F
122!|| h3d_nodal_scalar ../engine/source/output/h3d/h3d_results/h3d_nodal_scalar.F
123!|| h3d_quad_scalar ../engine/source/output/h3d/h3d_results/h3d_quad_scalar.F
124!|| h3d_quad_scalar_1 ../engine/source/output/h3d/h3d_results/h3d_quad_scalar_1.F90
125!|| h3d_shell_scalar ../engine/source/output/h3d/h3d_results/h3d_shell_scalar.F
126!|| h3d_shell_scalar_1 ../engine/source/output/h3d/h3d_results/h3d_shell_scalar_1.F
127!|| h3d_solid_scalar ../engine/source/output/h3d/h3d_results/h3d_solid_scalar.F
128!|| h3d_solid_scalar_1 ../engine/source/output/h3d/h3d_results/h3d_solid_scalar_1.F
129!|| i12chk3 ../starter/source/interfaces/inter3d1/i12chk3.F
130!|| i18dst3 ../engine/source/interfaces/int18/i18dst3.F
131!|| i18main_kine_1 ../engine/source/interfaces/int18/i18main_kine.F
132!|| i18main_kine_i ../engine/source/interfaces/int18/i18main_kine.F
133!|| i22buce ../engine/source/interfaces/intsort/i22buce.F
134!|| i22main_tri ../engine/source/interfaces/intsort/i22main_tri.F
135!|| i7mainf ../engine/source/interfaces/int07/i7mainf.F
136!|| ig3dinit3 ../starter/source/elements/ige3d/ig3dinit3.F
137!|| ig3duforc3 ../engine/source/elements/ige3d/ig3duforc3.F
138!|| imp_buck ../engine/source/implicit/imp_buck.F
139!|| iniebcs ../starter/source/boundary_conditions/ebcs/iniebcs.F
140!|| inigrav_load ../starter/source/initial_conditions/inigrav/inigrav_load.F
141!|| inigrav_m51 ../starter/source/initial_conditions/inigrav/inigrav_m51.F
142!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
143!|| inintr ../starter/source/interfaces/interf1/inintr.F
144!|| init_bcs_wall ../starter/source/boundary_conditions/init_bcs_wall.F90
145!|| init_diffusion ../engine/share/modules/diffusion_mod.F
146!|| initia ../starter/source/elements/initia/initia.F
147!|| intfop2 ../engine/source/interfaces/interf/intfop2.F
148!|| inttri ../engine/source/interfaces/intsort/inttri.F
149!|| lectur ../engine/source/input/lectur.F
150!|| m11law ../engine/source/materials/mat/mat011/m11law.F
151!|| m11vs2 ../engine/source/materials/mat/mat011/m11vs2.F
152!|| m11vs3 ../engine/source/materials/mat/mat011/m11vs3.F
153!|| m51init ../starter/source/materials/mat/mat051/m51init.F
154!|| m51vois2 ../engine/source/materials/mat/mat051/m51vois2.F
155!|| m51vois3 ../engine/source/materials/mat/mat051/m51vois3.F
156!|| mat11check ../starter/source/materials/mat/mat011/mat11check.F
157!|| matini ../starter/source/materials/mat_share/matini.F
158!|| mmain ../engine/source/materials/mat_share/mmain.F90
159!|| mulaw ../engine/source/materials/mat_share/mulaw.F90
160!|| multi_connectivity ../starter/source/multifluid/multi_connectivity.F
161!|| multi_fluxes_computation ../engine/source/multifluid/multi_fluxes_computation.F
162!|| multi_muscl_fluxes_computation ../engine/source/multifluid/multi_muscl_fluxes_computation.F
163!|| multi_muscl_gradients ../engine/source/multifluid/multi_muscl_gradients.F
164!|| multi_timeevolution ../engine/source/multifluid/multi_timeevolution.F
165!|| multi_unplug_neighbors ../starter/source/multifluid/multi_unplug_neighbors.F
166!|| multifluid_init2 ../starter/source/multifluid/multifluid_init2.F
167!|| multifluid_init2t ../starter/source/multifluid/multifluid_init2t.F
168!|| multifluid_init3 ../starter/source/multifluid/multifluid_init3.F
169!|| multifluid_init3t ../starter/source/multifluid/multifluid_init3t.F
170!|| nodal_schlieren ../engine/source/output/anim/generate/nodal_schlieren.F
171!|| nrf51ini ../starter/source/materials/mat/mat051/nrf51ini.F
172!|| ns_fvm_diffusion ../engine/source/multifluid/ns_fvm_diffusion.F
173!|| output_schlieren ../engine/source/output/anim/generate/output_schlieren.F
174!|| q4forc2 ../engine/source/elements/solid_2d/quad4/q4forc2.F
175!|| q4init2 ../starter/source/elements/solid_2d/quad4/q4init2.F
176!|| qforc2 ../engine/source/elements/solid_2d/quad/qforc2.F
177!|| qinit2 ../starter/source/elements/solid_2d/quad/qinit2.F
178!|| radioss2 ../engine/source/engine/radioss2.F
179!|| rdresb ../engine/source/output/restart/rdresb.F
180!|| resol ../engine/source/engine/resol.F
181!|| resol_head ../engine/source/engine/resol_head.F
182!|| restalloc ../engine/source/output/restart/arralloc.F
183!|| s10forc3 ../engine/source/elements/solid/solide10/s10forc3.F
184!|| s10init3 ../starter/source/elements/solid/solide10/s10init3.F
185!|| s11defo3 ../engine/source/elements/solid/solide/s11defo3.F
186!|| s11fx3 ../engine/source/elements/solid/solide/s11fx3.F
187!|| s16forc3 ../engine/source/elements/thickshell/solide16/s16forc3.F
188!|| s16init3 ../starter/source/elements/thickshell/solide16/s16init3.F
189!|| s20forc3 ../engine/source/elements/solid/solide20/s20forc3.F
190!|| s20init3 ../starter/source/elements/solid/solide20/s20init3.F
191!|| s4forc3 ../engine/source/elements/solid/solide4/s4forc3.F
192!|| s4init3 ../starter/source/elements/solid/solide4/s4init3.F
193!|| s6cforc3 ../engine/source/elements/thickshell/solide6c/s6cforc3.F
194!|| s6cinit3 ../starter/source/elements/thickshell/solide6c/s6cinit3.F
195!|| s8cforc3 ../engine/source/elements/thickshell/solide8c/s8cforc3.F
196!|| s8cinit3 ../starter/source/elements/thickshell/solide8c/s8cinit3.F
197!|| s8eforc3 ../engine/source/elements/solid/solide8e/s8eforc3.F
198!|| s8forc3 ../engine/source/elements/solid/solide8/s8forc3.f
199!|| s8sforc3 ../engine/source/elements/solid/solide8s/s8sforc3.F
200!|| s8zforc3 ../engine/source/elements/solid/solide8z/s8zforc3.F
201!|| s8zinit3 ../starter/source/elements/solid/solide8z/s8zinit3.F
202!|| scforc3 ../engine/source/elements/thickshell/solidec/scforc3.F
203!|| scinit3 ../starter/source/elements/thickshell/solidec/scinit3.F
204!|| seggetv ../engine/source/interfaces/interf/seggetv.f
205!|| sforc3 ../engine/source/elements/solid/solide/sforc3.F
206!|| sigeps51 ../engine/source/materials/mat/mat051/sigeps51.F90
207!|| sigeps51_boundary_material ../engine/source/materials/mat/mat051/sigeps51_boundary_material.F90
208!|| sinit22_fvm ../engine/source/interfaces/int22/sinit22_fvm.F
209!|| sinit3 ../starter/source/elements/solid/solide/sinit3.F
210!|| sortie_main ../engine/source/output/sortie_main.F
211!|| spinit3 ../starter/source/elements/sph/spinit3.F
212!|| split_cfd_solide ../starter/source/spmd/split_cfd_solide.F
213!|| spmd_exch_inter_18 ../engine/source/mpi/interfaces/spmd_exch_inter_18.F
214!|| spmd_ne_connect ../starter/source/ale/spmd_ne_connect.F
215!|| spstres ../engine/source/elements/sph/spstres.F
216!|| suinit3 ../starter/source/elements/elbuf_init/suinit3.F
217!|| szforc3 ../engine/source/elements/solid/solidez/szforc3.F
218!|| w_front ../starter/source/restart/ddsplit/w_front.F
219!|| w_ing2loc ../starter/source/restart/ddsplit/w_ing2loc.F
220!|| wrcomip ../starter/source/restart/ddsplit/wrcommp.F
221!|| wrrestp ../engine/source/output/restart/wrrestp.F
222!||====================================================================
223 MODULE ale_connectivity_mod
224
225 IMPLICIT NONE
226#include "my_real.inc"
227
228! ************ !
229! Connectivity
230! ************ !
231 TYPE, PUBLIC :: t_connectivity
232 INTEGER, DIMENSION(:), ALLOCATABLE :: iad_connect
233 INTEGER, DIMENSION(:), ALLOCATABLE :: connected
234 INTEGER, DIMENSION(:), ALLOCATABLE :: type
235 END TYPE t_connectivity
236
237! Extended type : + iface
238 TYPE, PUBLIC, EXTENDS(t_connectivity) :: t_connectivity_ext1
239 INTEGER, DIMENSION(:), ALLOCATABLE :: iface2
240 END TYPEt_connectivity_ext1
241
242
243! ****************** !
244! extended local ids !
245! ****************** !
246 TYPE :: t_idglob
247 INTEGER, DIMENSION(:), ALLOCATABLE :: id
248 INTEGER, DIMENSION(:), ALLOCATABLE :: uid
249 END TYPE t_idglob
250
251! **************** !
252! ALE connectivity !
253! **************** !
254 TYPE, PUBLIC :: t_ale_connectivity
255! node-node, node-element, element-element
256 TYPE(t_connectivity) :: nn_connect, ne_connect
257 TYPE(t_connectivity_ext1) :: ee_connect
258 LOGICAL :: has_nn_connect = .false.
259 LOGICAL :: has_ne_connect = .false.
260 LOGICAL :: has_ee_connect = .false.
261 LOGICAL :: has_idglob = .false.
262 LOGICAL :: nale_already_computed = .false.
263 INTEGER, DIMENSION(:), ALLOCATABLE :: nale
264 TYPE(t_idglob) :: idglob
265 CONTAINS
266 PROCEDURE, pass :: ale_connectivity_init
267 PROCEDURE, pass :: ALE_COMPUTE_CONNECTIVITY
268 PROCEDURE, PASS :: ale_compute_ee_connectivity
269 PROCEDURE, pass :: ale_deallocate_connectivity
270 END TYPE t_ale_connectivity
271
272! *********** !
273! Subroutines !
274! *********** !
275 CONTAINS
276
277!||====================================================================
278!|| ale_connectivity_init ../common_source/modules/ale/ale_connectivity_mod.F
279!||--- uses -----------------------------------------------------
280!|| ale_mod ../common_source/modules/ale/ale_mod.F
281!||====================================================================
282 SUBROUTINE ale_connectivity_init(THIS)
283 USE ale_mod
284 IMPLICIT NONE
285 CLASS(t_ale_connectivity), INTENT(INOUT) :: THIS
286#include "com01_c.inc"
287#include "inter18.inc"
288 LOGICAL RESULT
289 result = .false.
290 IF(iale > 0 .AND. ale%GRID%NWALE == 6)result=.true. !/ALE/GRID/VOLUME DEFINED
291 IF(inter18_autoparam == 1)result=.true. !/INTER/TYPE18 WITH FLAG IAUTO SET TO 1
292 IF(inter18_is_variable_gap_defined)result=.true. !/INTER/TYPE18 WITH FLAG IAUTO SET TO 1
293 this%HAS_NE_CONNECT = result
294 result = .false.
295 IF(iale > 0 .AND. ale%GRID%NWALE < 2)result=.true. !/ALE/GRID/DONEA, DISP, SPRING
296 IF(iale > 0 .AND. ale%GRID%NWALE == 7)result=.true. !/ALE/GRID/FLOW-TRACKING
297 IF(iale > 0 .AND. ale%GRID%NWALE == 5)result=.true. !/ALE/GRID/LAPLACIAN
298 this%HAS_NN_CONNECT = result
299 END SUBROUTINE ale_connectivity_init
300
301!||====================================================================
302!|| ale_compute_connectivity ../common_source/modules/ale/ale_connectivity_mod.F
303!||--- calls -----------------------------------------------------
304!|| quicksort_i ../common_source/tools/sort/quicksort.F
305!|| quicksort_i2 ../common_source/tools/sort/quicksort.F
306!||====================================================================
307 SUBROUTINE ale_compute_connectivity(THIS, NUMNOD, NUMELQ, NUMELTG, NUMELS,
308 . NIXQ, NIXTG, NIXS,
309 . IXQ, IXTG, IXS)
310 IMPLICIT NONE
311C-----------------------------------------------
312C D e s c r i p t i o n
313C-----------------------------------------------
314! Comptes Node to Element connectivities, !
315! and Node to Node connectivities for ALE !
316! grid velocity formulations !
317! --------------------------------------- !
318C-----------------------------------------------
319C D u m m y A r g u m e n t s
320C-----------------------------------------------
321 CLASS(t_ale_connectivity), INTENT(INOUT) :: THIS
322 INTEGER, INTENT(IN) :: NUMNOD, NUMELQ, NUMELTG, NUMELS, NIXQ, NIXTG, NIXS
323 INTEGER, DIMENSION(NIXQ, NUMELQ), INTENT(IN) :: IXQ
324 INTEGER, DIMENSION(NIXTG, NUMELTG), INTENT(IN) :: IXTG
325 INTEGER, DIMENSION(NIXS, NUMELS), INTENT(IN) :: IXS
326C-----------------------------------------------
327C L o c a l V a r i a b l e s
328C-----------------------------------------------
329 INTEGER :: II, JJ,KK, NODE_ID, NODE1, NODE2
330 LOGICAL :: DUPLICATE
331 INTEGER, DIMENSION(:), ALLOCATABLE :: ADSKY
332 INTEGER :: IAD1, IAD2, ITMP
333 INTEGER :: MAX_EDGE, NB_EDGE, NB_EDGE_NEW, IEDGE, CUR_POS
334 INTEGER, DIMENSION(:, :), ALLOCATABLE :: EDGES, EDGES_TMP
335 INTEGER, DIMENSION(:), ALLOCATABLE :: IDX
336 INTEGER, DIMENSION(2, 3) :: TRI_EDGE
337 INTEGER, DIMENSION(2, 4) :: QUAD_EDGE
338 INTEGER, DIMENSION(2, 12) :: HEXA_EDGE
339 INTEGER, DIMENSION(2, 6) :: TETRA_EDGE
340 INTEGER, DIMENSION(:), ALLOCATABLE :: NN_NB_CONNECT, NE_NB_CONNECT
341C-----------------------------------------------
342C S o u r c e L i n e s
343C-----------------------------------------------
344! In case we go through this routine a second time
345! node-node connectivity
346 IF (ALLOCATED(this%NN_CONNECT%IAD_CONNECT)) DEALLOCATE(this%NN_CONNECT%IAD_CONNECT)
347 IF (ALLOCATED(this%NN_CONNECT%CONNECTED)) DEALLOCATE(this%NN_CONNECT%CONNECTED)
348! node-element connectivity
349 IF (ALLOCATED(this%NE_CONNECT%IAD_CONNECT)) DEALLOCATE(this%NE_CONNECT%IAD_CONNECT)
350 IF (ALLOCATED(this%NE_CONNECT%CONNECTED)) DEALLOCATE(this%NE_CONNECT%CONNECTED)
351 IF (ALLOCATED(this%NE_CONNECT%TYPE)) DEALLOCATE(this%NE_CONNECT%TYPE)
352
353 ALLOCATE(nn_nb_connect(numnod))
354 nn_nb_connect(1:numnod) = 0
355 ALLOCATE(ne_nb_connect(numnod))
356 ne_nb_connect(1:numnod) = 0
357 max_edge = 12 * numels + 3 * numeltg + 4 * numelq
358 ALLOCATE(edges(2, max_edge))
359 nb_edge = 0
360 node_id = 0
361
362 tri_edge(1, 1) = 1
363 tri_edge(2, 1) = 2
364 tri_edge(1, 2) = 2
365 tri_edge(2, 2) = 3
366 tri_edge(1, 3) = 3
367 tri_edge(2, 3) = 1
368
369 quad_edge(1, 1) = 1
370 quad_edge(2, 1) = 2
371 quad_edge(1, 2) = 2
372 quad_edge(2, 2) = 3
373 quad_edge(1, 3) = 3
374 quad_edge(2, 3) = 4
375 quad_edge(1, 4) = 4
376 quad_edge(2, 4) = 1
377
378 hexa_edge(1, 1) = 1
379 hexa_edge(2, 1) = 2
380 hexa_edge(1, 2) = 2
381 hexa_edge(2, 2) = 3
382 hexa_edge(1, 3) = 3
383 hexa_edge(2, 3) = 4
384 hexa_edge(1, 4) = 4
385 hexa_edge(2, 4) = 1
386 hexa_edge(1, 5) = 5
387 hexa_edge(2, 5) = 6
388 hexa_edge(1, 6) = 6
389 hexa_edge(2, 6) = 7
390 hexa_edge(1, 7) = 7
391 hexa_edge(2, 7) = 8
392 hexa_edge(1, 8) = 8
393 hexa_edge(2, 8) = 5
394 hexa_edge(1, 9) = 1
395 hexa_edge(2, 9) = 5
396 hexa_edge(1, 10) = 2
397 hexa_edge(2, 10) = 6
398 hexa_edge(1, 11) = 3
399 hexa_edge(2, 11) = 7
400 hexa_edge(1, 12) = 4
401 hexa_edge(2, 12) = 8
402
403 tetra_edge(1, 1) = 1
404 tetra_edge(2, 1) = 3
405 tetra_edge(1, 2) = 3
406 tetra_edge(2, 2) = 6
407 tetra_edge(1, 3) = 6
408 tetra_edge(2, 3) = 1
409 tetra_edge(1, 4) = 1
410 tetra_edge(2, 4) = 5
411 tetra_edge(1, 5) = 3
412 tetra_edge(2, 5) = 5
413 tetra_edge(1, 6) = 6
414 tetra_edge(2, 6) = 5
415
416! 2D elements
417! /TRIA
418 DO ii = 1, numeltg
419 DO jj = 1, 3
420 node_id = ixtg(1 + jj, ii)
421 ne_nb_connect(node_id) = ne_nb_connect(node_id) + 1
422 ENDDO
423 !edges
424 DO iedge = 1, 3
425 node1 = ixtg(1 + tri_edge(1, iedge), ii)
426 node2 = ixtg(1 + tri_edge(2, iedge), ii)
427 nb_edge = nb_edge + 1
428 edges(1, nb_edge) = node1
429 edges(2, nb_edge) = node2
430 ENDDO
431 ENDDO
432! /QUAD
433 DO ii = 1, numelq
434 DO jj = 1, 4
435 node_id = ixq(1 + jj, ii)
436 ne_nb_connect(node_id) = ne_nb_connect(node_id) + 1
437 ENDDO
438 !edges
439 DO iedge = 1, 4
440 node1 = ixq(1 + quad_edge(1, iedge), ii)
441 node2 = ixq(1 + quad_edge(2, iedge), ii)
442 nb_edge = nb_edge + 1
443 edges(1, nb_edge) = node1
444 edges(2, nb_edge) = node2
445 ENDDO
446 ENDDO
447! 3D elements
448 DO ii = 1, numels
449 IF (ixs(2, ii) == ixs(3, ii) .AND. ixs(4, ii) == ixs(5, ii) .AND.
450 . ixs(6, ii) == ixs(9, ii) .AND. ixs(7, ii) == ixs(8, ii)) THEN
451! TETRA
452 node_id = ixs(2, ii)
453 ne_nb_connect(node_id) = ne_nb_connect(node_id) + 1
454 node_id = ixs(4, ii)
455 ne_nb_connect(node_id) = ne_nb_connect(node_id) + 1
456 node_id = ixs(7, ii)
457 ne_nb_connect(node_id) = ne_nb_connect(node_id) + 1
458 node_id = ixs(6, ii)
459 ne_nb_connect(node_id) = ne_nb_connect(node_id) + 1
460 !edges
461 DO iedge = 1, 6
462 node1 = ixs(1 + tetra_edge(1, iedge), ii)
463 node2 = ixs(1 + tetra_edge(2, iedge), ii)
464 nb_edge = nb_edge + 1
465 edges(1, nb_edge) = node1
466 edges(2, nb_edge) = node2
467 ENDDO
468 ELSE
469! BRICKS
470 DO jj = 1, 8
471 node_id = ixs(1 + jj, ii)
472 duplicate = .false.
473 DO kk = 1, jj-1
474 IF(node_id == ixs(1 + kk, ii)) duplicate = .true.
475 ENDDO
476 IF(.NOT. duplicate) ne_nb_connect(node_id) = ne_nb_connect(node_id) + 1
477 ENDDO
478! edges
479 DO iedge = 1, 12
480 node1 = ixs(1 + hexa_edge(1, iedge), ii)
481 node2 = ixs(1 + hexa_edge(2, iedge), ii)
482 IF(node1 /= node2)THEN
483 nb_edge = nb_edge + 1
484 edges(1, nb_edge) = node1
485 edges(2, nb_edge) = node2
486 ENDIF
487 ENDDO
488 ENDIF
489 ENDDO
490
491 DO ii = 1, nb_edge
492 IF (edges(1, ii) > edges(2, ii)) THEN
493 itmp = edges(1, ii)
494 edges(1, ii) = edges(2, ii)
495 edges(2, ii) = itmp
496 ENDIF
497 ENDDO
498
499
500! Indirection tab
501 ALLOCATE(this%NE_CONNECT%IAD_CONNECT(numnod + 1))
502 this%NE_CONNECT%IAD_CONNECT(1) = 1
503 DO ii = 2, numnod + 1
504 this%NE_CONNECT%IAD_CONNECT(ii) = this%NE_CONNECT%IAD_CONNECT(ii - 1) + ne_nb_connect(ii - 1)
505 ENDDO
506
507 ALLOCATE(adsky(numnod))
508 DO ii = 1, numnod
509 adsky(ii) = this%NE_CONNECT%IAD_CONNECT(ii)
510 ENDDO
511! Connectivities
512 ALLOCATE(this%NE_CONNECT%CONNECTED(this%NE_CONNECT%IAD_CONNECT(numnod + 1)))
513 this%NE_CONNECT%CONNECTED(:) = 0
514 ALLOCATE(this%NE_CONNECT%TYPE(this%NE_CONNECT%IAD_CONNECT(numnod + 1)))
515 this%NE_CONNECT%TYPE(:) = 0
516
517! 2D elements
518! /TRIA
519 DO ii = 1, numeltg
520 DO jj = 1, 3
521 node_id = ixtg(1 + jj, ii)
522 this%NE_CONNECT%CONNECTED(adsky(node_id)) = ii
523 this%NE_CONNECT%TYPE(adsky(node_id)) = 3
524 adsky(node_id) = adsky(node_id) + 1
525 ENDDO
526 ENDDO
527! /QUAD
528 DO ii = 1, numelq
529 DO jj = 1, 4
530 node_id = ixq(1 + jj, ii)
531 this%NE_CONNECT%CONNECTED(adsky(node_id)) = ii
532 this%NE_CONNECT%TYPE(adsky(node_id)) = 2
533 adsky(node_id) = adsky(node_id) + 1
534 ENDDO
535 ENDDO
536
537! 3D elements
538 DO ii = 1, numels
539 IF (ixs(2, ii) == ixs(3, ii) .AND. ixs(4, ii) == ixs(5, ii) .AND.
540 . ixs(6, ii) == ixs(9, ii) .AND. ixs(7, ii) == ixs(8, ii)) THEN
541! TETRA
542 node_id = ixs(2, ii)
543 this%NE_CONNECT%CONNECTED(adsky(node_id)) = ii
544 this%NE_CONNECT%TYPE(adsky(node_id)) = 1
545 adsky(node_id) = adsky(node_id) + 1
546 node_id = ixs(4, ii)
547 this%NE_CONNECT%CONNECTED(adsky(node_id)) = ii
548 this%NE_CONNECT%TYPE(adsky(node_id)) = 1
549 adsky(node_id) = adsky(node_id) + 1
550 node_id = ixs(7, ii)
551 this%NE_CONNECT%CONNECTED(adsky(node_id)) = ii
552 this%NE_CONNECT%TYPE(adsky(node_id)) = 1
553 adsky(node_id) = adsky(node_id) + 1
554 node_id = ixs(6, ii)
555 this%NE_CONNECT%CONNECTED(adsky(node_id)) = ii
556 this%NE_CONNECT%TYPE(adsky(node_id)) = 1
557 adsky(node_id) = adsky(node_id) + 1
558 ELSE
559! BRICKS
560 DO jj = 1, 8
561 node_id = ixs(1 + jj, ii)
562 duplicate = .false. !degenerated solids: duplicated node IDS
563 DO kk = 1, jj-1
564 IF(node_id == ixs(1 + kk, ii)) duplicate = .true.
565 ENDDO
566 IF(.NOT. duplicate) THEN
567 this%NE_CONNECT%CONNECTED(adsky(node_id)) = ii
568 this%NE_CONNECT%TYPE(adsky(node_id)) = 1
569 adsky(node_id) = adsky(node_id) + 1
570 ENDIF
571 ENDDO
572 ENDIF
573 ENDDO
574
575 ALLOCATE(idx(nb_edge), edges_tmp(2, nb_edge))
576 DO ii = 1, nb_edge
577 idx(ii) = ii
578 edges_tmp(1, ii) = edges(1, ii)
579 edges_tmp(2, ii) = edges(2, ii)
580 ENDDO
581 CALL quicksort_i2(edges_tmp(1, :), idx, 1, nb_edge)
582 DO ii = 1, nb_edge
583 edges_tmp(1, ii) = edges(1, idx(ii))
584 edges_tmp(2, ii) = edges(2, idx(ii))
585 ENDDO
586
587 nb_edge_new = 0
588 ii = 1
589 DO WHILE (ii < nb_edge)
590 cur_pos = ii
591 iad1 = 1
592 DO WHILE (edges_tmp(1, ii + iad1) == edges_tmp(1, ii))
593 IF (ii + iad1 == nb_edge) THEN
594 EXIT
595 ENDIF
596 iad1 = iad1 + 1
597 ENDDO
598 IF (iad1 == 1) THEN
599 nb_edge_new = nb_edge_new + 1
600 edges(1, nb_edge_new) = edges_tmp(1, ii)
601 edges(2, nb_edge_new) = edges_tmp(2, ii)
602 ii = ii + 1
603 ELSE
604 CALL quicksort_i(edges_tmp(2, ii : ii + iad1 - 1), 1, iad1)
605 node1 = edges_tmp(1, ii)
606 node2 = edges_tmp(2, ii)
607 nb_edge_new = nb_edge_new + 1
608 edges(1, nb_edge_new) = node1
609 edges(2, nb_edge_new) = node2
610 DO iad2 = 0, iad1 - 1
611 IF (edges_tmp(2, ii + iad2) /= node2) THEN
612 nb_edge_new = nb_edge_new + 1
613 node2 = edges_tmp(2, ii + iad2)
614 edges(1, nb_edge_new) = node1
615 edges(2, nb_edge_new) = node2
616 ENDIF
617 ENDDO
618 ii = ii + iad1
619 ENDIF
620 ENDDO
621
622! node node connectivity
623 DO ii = 1, nb_edge_new
624 nn_nb_connect(edges(1, ii)) = nn_nb_connect(edges(1, ii)) + 1
625 nn_nb_connect(edges(2, ii)) = nn_nb_connect(edges(2, ii)) + 1
626 ENDDO
627 ne_nb_connect(node_id) = ne_nb_connect(node_id) + 1
628! indirection tab
629 ALLOCATE(this%NN_CONNECT%IAD_CONNECT(numnod + 1))
630 this%NN_CONNECT%IAD_CONNECT(1) = 1
631 DO ii = 2, numnod + 1
632 this%NN_CONNECT%IAD_CONNECT(ii) = this%NN_CONNECT%IAD_CONNECT(ii - 1) + nn_nb_connect(ii - 1)
633 ENDDO
634
635 DO ii = 1, numnod
636 adsky(ii) = this%NN_CONNECT%IAD_CONNECT(ii)
637 ENDDO
638 ALLOCATE(this%NN_CONNECT%CONNECTED(this%NN_CONNECT%IAD_CONNECT(numnod + 1)))
639 this%NN_CONNECT%CONNECTED(:) = 0
640 DO ii = 1, nb_edge_new
641 node1 = edges(1, ii)
642 node2 = edges(2, ii)
643 this%NN_CONNECT%CONNECTED(adsky(node1)) = node2
644 this%NN_CONNECT%CONNECTED(adsky(node2)) = node1
645 adsky(node1) = adsky(node1) + 1
646 adsky(node2) = adsky(node2) + 1
647 ENDDO
648
649 DEALLOCATE(adsky, edges, idx, edges_tmp, nn_nb_connect, ne_nb_connect)
650 END SUBROUTINE ale_compute_connectivity
651
652!||====================================================================
653!|| ale_deallocate_connectivity ../common_source/modules/ale/ale_connectivity_mod.F
654!||====================================================================
655 SUBROUTINE ale_deallocate_connectivity(THIS)
656 IMPLICIT NONE
657 CLASS(t_ale_connectivity), INTENT(INOUT) :: THIS
658
659 IF (ALLOCATED(this%NE_CONNECT%CONNECTED)) DEALLOCATE(this%NE_CONNECT%CONNECTED)
660 IF (ALLOCATED(this%NE_CONNECT%IAD_CONNECT)) DEALLOCATE(this%NE_CONNECT%IAD_CONNECT)
661 IF (ALLOCATED(this%NN_CONNECT%CONNECTED)) DEALLOCATE(this%NN_CONNECT%CONNECTED)
662 IF (ALLOCATED(this%NN_CONNECT%IAD_CONNECT)) DEALLOCATE(this%NN_CONNECT%IAD_CONNECT)
663 IF (ALLOCATED(this%NALE)) DEALLOCATE(this%NALE)
664
665 END SUBROUTINE ale_deallocate_connectivity
666
667!||====================================================================
668!|| ale_compute_ee_connectivity ../common_source/modules/ale/ale_connectivity_mod.F
669!||--- calls -----------------------------------------------------
670!||====================================================================
671 SUBROUTINE ale_compute_ee_connectivity(THIS, PM, IGEO,
672 . NPROPGI,NUMGEO, NPROPM, NUMMAT, NUMNOD, NUMELQ, NUMELTG, NUMELS, N2D,
673 . IALE, IEULER, ITHERM, IALELAG, ISHADOW,
674 . NIXQ, NIXTG, NIXS,
675 . IXQ, IXTG, IXS)
676 IMPLICIT NONE
677C-----------------------------------------------
678C D e s c r i p t i o n
679C-----------------------------------------------
680! Computes Element to Element connectivities !
681! for ALE, and EULER computations !
682! --------------------------------------- !
683C-----------------------------------------------
684C D u m m y A r g u m e n t s
685C-----------------------------------------------
686 CLASS(t_ale_connectivity), INTENT(INOUT) :: THIS
687 INTEGER, INTENT(IN) :: NUMNOD, NUMELQ, NUMELTG, NUMELS, NPROPGI
688 INTEGER, INTENT(IN) :: NIXQ, NIXTG, NIXS, N2D, IALE, IEULER, ITHERM, IALELAG, NPROPM, NUMMAT,NUMGEO
689 MY_REAL, DIMENSION(NPROPM, NUMMAT), INTENT(IN) :: PM
690 INTEGER, DIMENSION(NIXQ, NUMELQ), INTENT(IN) :: IXQ
691 INTEGER, DIMENSION(NIXTG, NUMELTG), INTENT(IN) :: IXTG
692 INTEGER, DIMENSION(NIXS, NUMELS), INTENT(IN) :: IXS
693 INTEGER, DIMENSION(NPROPGI, NUMGEO), INTENT(IN) :: IGEO
694 LOGICAL,INTENT(IN) :: ISHADOW !< shadowing option for detonators (Eikonal equation solver)
695C-----------------------------------------------
696C L o c a l V a r i a b l e s
697C-----------------------------------------------
698 INTEGER :: II, JJ,KK, NODE_ID, INODE
699 LOGICAL :: DUPLICATE
700 INTEGER, DIMENSION(:), ALLOCATABLE :: ADSKY
701 INTEGER :: IAD1, ITMP, IAD
702 INTEGER, DIMENSION(:), ALLOCATABLE :: IAD_CONNECT, NE_NB_CONNECT, CONNECTED, TYPE, EE_NB_CONNECT,ITAG
703 INTEGER(8) :: VEC_PTR1
704 INTEGER :: JAL_FROM_MAT, JAL_FROM_PROP, JAL, JALT, MLW, IMID, TMP, COUNT, JTHE, JSHADOW
705 INTEGER, DIMENSION(4), TARGET :: TETRA_NODES
706 INTEGER, DIMENSION(6, 4), TARGET :: HEXA_FACE
707 INTEGER, DIMENSION(6, 3), TARGET :: TETRA_FACE
708 INTEGER, DIMENSION(4, 2), TARGET :: QUAD_FACE
709 INTEGER, DIMENSION(3, 2), TARGET :: TRI_FACE
710 INTEGER, DIMENSION(:, :), POINTER :: ELEM_FACE, ELEM_FACE2
711 INTEGER :: KFACE, KFACE2, NFACE, NFACE_NODE, NFACE2, NFACE_NODE2
712 INTEGER NN(4)
713 LOGICAL SKIP_FACE
714C-----------------------------------------------
715C B e g i n n i n g o f S u b r o u t i n e
716C-----------------------------------------------
717 IF (iale + ieuler + ialelag +itherm == 0 .AND. .NOT.ishadow) THEN
718 RETURN
719 ENDIF
720! List of nodes of interest for tetra
721 tetra_nodes(1) = 2
722 tetra_nodes(2) = 4
723 tetra_nodes(3) = 7
724 tetra_nodes(4) = 6
725! Faces for each element
726! hexa
727 hexa_face(1, 1) = 1
728 hexa_face(1, 2) = 2
729 hexa_face(1, 3) = 3
730 hexa_face(1, 4) = 4
731 hexa_face(2, 1) = 3
732 hexa_face(2, 2) = 4
733 hexa_face(2, 3) = 8
734 hexa_face(2, 4) = 7
735 hexa_face(3, 1) = 5
736 hexa_face(3, 2) = 6
737 hexa_face(3, 3) = 7
738 hexa_face(3, 4) = 8
739 hexa_face(4, 1) = 1
740 hexa_face(4, 2) = 2
741 hexa_face(4, 3) = 6
742 hexa_face(4, 4) = 5
743 hexa_face(5, 1) = 2
744 hexa_face(5, 2) = 3
745 hexa_face(5, 3) = 7
746 hexa_face(5, 4) = 6
747 hexa_face(6, 1) = 1
748 hexa_face(6, 2) = 4
749 hexa_face(6, 3) = 8
750 hexa_face(6, 4) = 5
751! tetra
752 tetra_face(1, 1) = -1
753 tetra_face(1, 2) = -1
754 tetra_face(1, 3) = -1
755 tetra_face(2, 1) = 5
756 tetra_face(2, 2) = 6
757 tetra_face(2, 3) = 3
758 tetra_face(3, 1) = -1
759 tetra_face(3, 2) = -1
760 tetra_face(3, 3) = -1
761 tetra_face(4, 1) = 5
762 tetra_face(4, 2) = 1
763 tetra_face(4, 3) = 6
764 tetra_face(5, 1) = 1
765 tetra_face(5, 2) = 3
766 tetra_face(5, 3) = 6
767 tetra_face(6, 1) = 5
768 tetra_face(6, 2) = 3
769 tetra_face(6, 3) = 1
770! quad
771 quad_face(1, 1) = 1
772 quad_face(1, 2) = 2
773 quad_face(2, 1) = 2
774 quad_face(2, 2) = 3
775 quad_face(3, 1) = 3
776 quad_face(3, 2) = 4
777 quad_face(4, 1) = 4
778 quad_face(4, 2) = 1
779! tria
780 tri_face(1, 1) = 1
781 tri_face(1, 2) = 2
782 tri_face(2, 1) = 2
783 tri_face(2, 2) = 3
784 tri_face(3, 1) = 3
785 tri_face(3, 2) = 1
786 IF (.NOT. this%NALE_ALREADY_COMPUTED) THEN
787! Marking ALE nodes
788 IF (ALLOCATED(this%NALE)) DEALLOCATE(this%NALE)
789 ALLOCATE(this%NALE(numnod))
790 this%NALE(1:numnod) = 0
791 ENDIF
792! element-element connectivity
793 IF (ALLOCATED(this%EE_CONNECT%IAD_CONNECT)) DEALLOCATE(this%EE_CONNECT%IAD_CONNECT)
794 IF (ALLOCATED(this%EE_CONNECT%CONNECTED)) DEALLOCATE(this%EE_CONNECT%CONNECTED)
795 IF (ALLOCATED(this%EE_CONNECT%TYPE)) DEALLOCATE(this%EE_CONNECT%TYPE)
796 IF (ALLOCATED(this%EE_CONNECT%IFACE2)) DEALLOCATE(this%EE_CONNECT%IFACE2)
797
798! Node element connectivity
799 ALLOCATE(ne_nb_connect(numnod))
800 ne_nb_connect(1:numnod) = 0
801
802! 2D elements
803! /TRIA
804 IF(n2d > 0)THEN
805 DO ii = 1, numeltg
806! ale : jal = 1, euler : jal = 2
807 jal_from_mat = nint(pm(72, iabs(ixtg(1, ii))))
808 jal_from_prop = igeo(62, iabs(ixtg(5, ii)))
809 jal = max(jal_from_mat, jal_from_prop)
810 jthe = nint(pm(71, iabs(ixtg(1, ii))))
811 jshadow = nint(pm(96, iabs(ixtg(1, ii))))
812 jalt = jal + jthe + jshadow
813 imid = iabs(ixtg(1, ii))
814 IF (jalt == 0) cycle
815 mlw = nint(pm(19,imid))
816 DO jj = 1, 3
817 node_id = ixtg(1 + jj, ii)
818 ne_nb_connect(node_id) = ne_nb_connect(node_id) + 1
819 IF (.NOT. this%NALE_ALREADY_COMPUTED) THEN
820 this%NALE(node_id) = max(this%NALE(node_id), jal)
821 IF (mlw == 151) THEN
822 IF (this%NALE(node_id) == 1 .OR. this%NALE(node_id) == 2) this%NALE(node_id) = 150 + this%NALE(node_id)
823 ENDIF
824 ENDIF
825 ENDDO
826 ENDDO
827 ENDIF
828
829! /QUAD
830 DO ii = 1, numelq
831! ale : jal = 1, euler : jal = 2
832 jal_from_mat = nint(pm(72, iabs(ixq(1, ii))))
833 jal_from_prop = igeo(62,iabs(ixq(6, ii)))
834 jal = max(jal_from_mat, jal_from_prop)
835 jthe = nint(pm(71, iabs(ixq(1, ii))))
836 jshadow = nint(pm(96, iabs(ixq(1, ii))))
837 jalt = jal + jthe + jshadow
838 imid = iabs(ixq(1, ii))
839 IF (jalt == 0) cycle
840 mlw = nint(pm(19,imid))
841 DO jj = 1, 4
842 node_id = ixq(1 + jj, ii)
843 ne_nb_connect(node_id) = ne_nb_connect(node_id) + 1
844 IF (.NOT. this%NALE_ALREADY_COMPUTED) THEN
845 this%NALE(node_id) = max(this%NALE(node_id), jal)
846 IF (mlw == 151) THEN
847 IF (this%NALE(node_id) == 1 .OR. this%NALE(node_id) == 2) this%NALE(node_id) = 150 + this%NALE(node_id)
848 ENDIF
849 ENDIF
850 ENDDO
851 ENDDO
852
853! 3D elements
854 DO ii = 1, numels
855 jal_from_mat = nint(pm(72, iabs(ixs(1, ii))))
856 jal_from_prop = igeo(62, iabs(ixs(10, ii)))
857 jal = max(jal_from_mat, jal_from_prop)
858 jthe = nint(pm(71, iabs(ixs(1, ii))))
859 jshadow = nint(pm(96, iabs(ixs(1, ii))))
860 jalt = jal + jthe + jshadow
861 imid = iabs(ixs(1, ii))
862 IF (jalt == 0) cycle
863 mlw = nint(pm(19,imid))
864 IF (ixs(2, ii) == ixs(3, ii) .AND. ixs(4, ii) == ixs(5, ii) .AND.
865 . ixs(6, ii) == ixs(9, ii) .AND. ixs(7, ii) == ixs(8, ii)) THEN
866! tetra
867 DO jj = 1, 4
868 node_id = ixs(tetra_nodes(jj), ii)
869 ne_nb_connect(node_id) = ne_nb_connect(node_id) + 1
870 IF (.NOT. this%NALE_ALREADY_COMPUTED) THEN
871 this%NALE(node_id) = max(this%NALE(node_id), jal)
872 IF (mlw == 151) THEN
873 IF (this%NALE(node_id) == 1 .OR. this%NALE(node_id) == 2) this%NALE(node_id) = 150 + this%NALE(node_id)
874 ENDIF
875 ENDIF
876 ENDDO
877 ELSE
878! bricks
879 DO jj = 1, 8
880 node_id = ixs(1 + jj, ii)
881 duplicate = .false.
882 DO kk = 1,jj - 1
883 IF(node_id == ixs(1 + kk, ii)) duplicate = .true.
884 ENDDO
885 IF( .NOT. duplicate) THEN
886 ne_nb_connect(node_id) = ne_nb_connect(node_id) + 1
887 IF (.NOT. this%NALE_ALREADY_COMPUTED) THEN
888 this%NALE(node_id) = max(this%NALE(node_id), jal)
889 IF (mlw == 151) THEN
890 IF (this%NALE(node_id) == 1 .OR. this%NALE(node_id) == 2) this%NALE(node_id) = 150 + this%NALE(node_id)
891 ENDIF
892 ENDIF
893 ENDIF
894 ENDDO
895 ENDIF
896 ENDDO
897
898 this%NALE_ALREADY_COMPUTED = .true.
899
900! Indirection tab
901 ALLOCATE(iad_connect(numnod + 1))
902 iad_connect(1) = 1
903 DO ii = 2, numnod + 1
904 iad_connect(ii) = iad_connect(ii - 1) + ne_nb_connect(ii - 1)
905 ENDDO
906 ALLOCATE(adsky(numnod))
907 DO ii = 1, numnod
908 adsky(ii) = iad_connect(ii)
909 ENDDO
910
911 ALLOCATE(connected(iad_connect(numnod + 1)))
912 connected(:) = 0
913 ALLOCATE(TYPE(iad_connect(numnod + 1)))
914 TYPE(:) = 0
915
916! 2D elements
917! /TRIA
918 IF(n2d > 0)THEN
919 DO ii = 1, numeltg
920 jal_from_mat = nint(pm(72, iabs(ixtg(1, ii))))
921 jal_from_prop = igeo(62,iabs(ixtg(5, ii)))
922 jal = max(jal_from_mat, jal_from_prop)
923 jalt = jal + nint(pm(71, iabs(ixtg(1, ii))) + pm(96, iabs(ixtg(1, ii))))
924 imid = iabs(ixtg(1, ii))
925 IF (jalt == 0) cycle
926 DO jj = 1, 3
927 node_id = ixtg(1 + jj, ii)
928 connected(adsky(node_id)) = ii
929 TYPE(adsky(node_id)) = 3
930 adsky(node_id) = adsky(node_id) + 1
931 ENDDO
932 ENDDO
933 ENDIF
934
935! /QUAD
936 DO ii = 1, numelq
937 jal_from_mat = nint(pm(72, iabs(ixq(1, ii))))
938 jal_from_prop = igeo(62, iabs(ixq(6, ii)) )
939 jal = max(jal_from_mat, jal_from_prop)
940 jalt = jal + nint(pm(71, iabs(ixq(1, ii))) + pm(96, iabs(ixq(1, ii))))
941 imid = iabs(ixq(1, ii))
942 IF (jalt == 0) cycle
943 DO jj = 1, 4
944 node_id = ixq(1 + jj, ii)
945 connected(adsky(node_id)) = ii
946 TYPE(adsky(node_id)) = 2
947 adsky(node_id) = adsky(node_id) + 1
948 ENDDO
949 ENDDO
950
951! 3D elements
952 DO ii = 1, numels
953 jal_from_mat = nint(pm(72, iabs(ixs(1, ii))))
954 jal_from_prop = igeo(62, iabs(ixs(10, ii)) )
955 jal = max(jal_from_mat, jal_from_prop)
956 jalt = jal + nint(pm(71, iabs(ixs(1, ii))) + pm(96, iabs(ixs(1, ii))))
957 imid = iabs(ixs(1, ii))
958 IF (jalt == 0) cycle
959 IF (ixs(2, ii) == ixs(3, ii) .AND. ixs(4, ii) == ixs(5, ii) .AND.
960 . ixs(6, ii) == ixs(9, ii) .AND. ixs(7, ii) == ixs(8, ii)) THEN
961! tetra
962 node_id = ixs(2, ii)
963 connected(adsky(node_id)) = ii
964 TYPE(adsky(node_id)) = 1
965 adsky(node_id) = adsky(node_id) + 1
966 node_id = ixs(4, ii)
967 connected(adsky(node_id)) = ii
968 TYPE(adsky(node_id)) = 1
969 adsky(node_id) = adsky(node_id) + 1
970 node_id = ixs(7, ii)
971 connected(adsky(node_id)) = ii
972 TYPE(adsky(node_id)) = 1
973 adsky(node_id) = adsky(node_id) + 1
974 node_id = ixs(6, ii)
975 connected(adsky(node_id)) = ii
976 TYPE(adsky(node_id)) = 1
977 adsky(node_id) = adsky(node_id) + 1
978 ELSE
979! bricks
980 DO jj = 1, 8
981 node_id = ixs(1 + jj, ii)
982 duplicate = .false.
983 DO kk = 1,jj - 1
984 IF(node_id == ixs(1 + kk, ii)) duplicate = .true.
985 ENDDO
986 IF(.NOT. duplicate) THEN
987 connected(adsky(node_id)) = ii
988 TYPE(adsky(node_id)) = 1
989 adsky(node_id) = adsky(node_id) + 1
990 ENDIF
991 ENDDO
992 ENDIF
993 ENDDO
994
995
996! Counting connected elements
997 IF (n2d == 0) THEN
998 ALLOCATE(this%EE_CONNECT%IAD_CONNECT(numels+1))
999 ALLOCATE(ee_nb_connect(numels))
1000 ELSE
1001 ALLOCATE(this%EE_CONNECT%IAD_CONNECT(numeltg + numelq + 1))
1002 ALLOCATE(ee_nb_connect(numeltg + numelq))
1003 ENDIF
1004 ee_nb_connect(:) = 0
1005
1006 tmp = 0
1007 IF (n2d == 0) THEN
1008! 3D elements
1009 DO ii = 1, numels
1010 jal_from_mat = nint(pm(72, iabs(ixs(1, ii))))
1011 jal_from_prop = igeo(62, iabs(ixs(10, ii)) )
1012 jal = max(jal_from_mat, jal_from_prop)
1013 jalt = jal + nint(pm(71, iabs(ixs(1, ii))) + pm(96, iabs(ixs(1, ii))))
1014 IF (jalt == 0) cycle
1015 IF (ixs(2, ii) == ixs(3, ii) .AND. ixs(4, ii) == ixs(5, ii) .AND.
1016 . ixs(6, ii) == ixs(9, ii) .AND. ixs(7, ii) == ixs(8, ii)) THEN
1017! Tetras
1018 ee_nb_connect(ii) = 6
1019 ELSE
1020! Hexa
1021 ee_nb_connect(ii) = 6
1022 ENDIF
1023 ENDDO
1024 this%EE_CONNECT%IAD_CONNECT(1) = 1
1025 DO ii = 2, numels + 1
1026 this%EE_CONNECT%IAD_CONNECT(ii) = this%EE_CONNECT%IAD_CONNECT(ii - 1) + ee_nb_connect(ii - 1)
1027 ENDDO
1028 tmp = this%EE_CONNECT%IAD_CONNECT(numels + 1)
1029 ELSE
1030! 2D elements
1031! /QUAD
1032 DO ii = 1, numelq
1033 jal_from_mat = nint(pm(72, iabs(ixq(1, ii))))
1034 jal_from_prop = igeo(62, iabs(ixq(6, ii)) )
1035 jal = max(jal_from_mat, jal_from_prop)
1036 jalt = jal + nint(pm(71, iabs(ixq(1, ii))) + pm(96, iabs(ixq(1, ii))))
1037 IF (jalt == 0) cycle
1038 ee_nb_connect(ii) = 4
1039 ENDDO
1040! /TRIA
1041 DO ii = 1, numeltg
1042 jal_from_mat = nint(pm(72, iabs(ixtg(1, ii))))
1043 jal_from_prop = igeo(62, iabs(ixtg(5, ii)) )
1044 jal = max(jal_from_mat, jal_from_prop)
1045 jalt = jal + nint(pm(71, iabs(ixtg(1, ii))) + pm(96, iabs(ixtg(1, ii))))
1046 IF (jalt == 0) cycle
1047 ee_nb_connect(ii) = 3
1048 ENDDO
1049 this%EE_CONNECT%IAD_CONNECT(1) = 1
1050 DO ii = 2, numelq + numeltg + 1
1051 this%EE_CONNECT%IAD_CONNECT(ii) = this%EE_CONNECT%IAD_CONNECT(ii - 1) + ee_nb_connect(ii - 1)
1052 ENDDO
1053 tmp = this%EE_CONNECT%IAD_CONNECT(numelq + numeltg + 1) - 1
1054 ENDIF
1055
1056 ALLOCATE(this%EE_CONNECT%CONNECTED(tmp))
1057 ALLOCATE(this%EE_CONNECT%TYPE(tmp))
1058 ALLOCATE(this%EE_CONNECT%IFACE2(tmp))
1059 this%EE_CONNECT%TYPE(1:tmp) = 0
1060 this%EE_CONNECT%CONNECTED(1:tmp) = 0
1061 this%EE_CONNECT%IFACE2(1:tmp) = 0
1062 CALL intvector_create(vec_ptr1)
1063 ALLOCATE(itag(numnod))
1064 itag(1:numnod) = 0
1065 IF (n2d == 0) THEN
1066 DO ii = 1, numels
1067 jal_from_mat = nint(pm(72, iabs(ixs(1, ii))))
1068 jal_from_prop = igeo(62, iabs(ixs(10, ii)) )
1069 jal = max(jal_from_mat, jal_from_prop)
1070 jalt = jal + nint(pm(71, iabs(ixs(1, ii))) + pm(96, iabs(ixs(1, ii))))
1071 IF (jalt == 0) cycle
1072 iad1 = this%EE_CONNECT%IAD_CONNECT(ii)
1073 IF (ixs(2, ii) == ixs(3, ii) .AND. ixs(4, ii) == ixs(5, ii) .AND.
1074 . ixs(6, ii) == ixs(9, ii) .AND. ixs(7, ii) == ixs(8, ii)) THEN
1075! Tetras
1076 nface = 6
1077 nface_node = 3
1078 count = 3
1079 elem_face => tetra_face
1080 ELSE
1081! Hexa
1082 nface = 6
1083 nface_node = 4
1084 count = 4
1085 elem_face => hexa_face
1086 ENDIF
1087
1088 DO kface = 1, nface
1089 CALL intvector_clear(vec_ptr1)
1090
1091 !skip hexa degenerated face (penta)
1092 skip_face = .false.
1093 IF(nface_node == 4)THEN
1094 DO kk=1,4
1095 nn(kk) = ixs(1 + elem_face(kface, kk), ii)
1096 ENDDO
1097 IF(nn(1)==nn(2) .AND. nn(3)==nn(4)) THEN
1098 skip_face = .true.
1099 ELSEIF(nn(2)==nn(3) .AND. nn(1)==nn(4)) THEN
1100 skip_face = .true.
1101 ENDIF
1102 ENDIF
1103
1104 IF(.NOT. skip_face)THEN
1105 DO inode = 1, nface_node
1106 IF (elem_face(kface, inode) < 0) cycle
1107 node_id = ixs(1 + elem_face(kface, inode), ii)
1108 itag(node_id) = 1
1109 DO iad = iad_connect(node_id), iad_connect(node_id + 1) - 1
1110 IF (connected(iad) /= ii) THEN
1111 CALL intvector_push_back(vec_ptr1, connected(iad))
1112 ENDIF
1113 ENDDO
1114 ENDDO
1115 ENDIF
1116
1117! get the redundant element number
1118 CALL intvector_get_redundant(vec_ptr1, jj, itmp, count)
1119 iad1 = this%EE_CONNECT%IAD_CONNECT(ii)
1120 IF(skip_face) jj = 0 !no connected face (degenerated)
1121 this%EE_CONNECT%CONNECTED(iad1 + kface - 1) = jj
1122 IF (jj > 0) THEN
1123 IF (ixs(2, jj) == ixs(3, jj) .AND. ixs(4, jj) == ixs(5, jj) .AND.
1124 . ixs(6, jj) == ixs(9, jj) .AND. ixs(7, jj) == ixs(8, jj)) THEN
1125! Tetras
1126 nface2 = 6
1127 nface_node2 = 3
1128 elem_face2 => tetra_face
1129 this%EE_CONNECT%TYPE(iad1 + kface - 1) = 1
1130 ELSE
1131! Hexa
1132 nface2 = 6
1133 nface_node2 = 4
1134 elem_face2 => hexa_face
1135 this%EE_CONNECT%TYPE(iad1 + kface - 1) = 0
1136 ENDIF
1137 DO kface2 = 1, nface2
1138 itmp = 1
1139 DO inode = 1, nface_node2
1140 IF (elem_face(kface2, inode) < 0) cycle
1141 itmp = itmp * itag(ixs(1 + elem_face(kface2, inode), jj))
1142 ENDDO
1143 IF (itmp == 1) THEN
1144 this%EE_CONNECT%IFACE2(iad1 + kface - 1) = kface2
1145 EXIT
1146 ENDIF
1147 ENDDO
1148 ENDIF
1149 DO inode = 1, nface_node
1150 IF (elem_face(kface, inode) < 0) cycle
1151 node_id = ixs(1 + elem_face(kface, inode), ii)
1152 itag(node_id) = 0
1153 ENDDO
1154 ENDDO
1155 ENDDO
1156 ELSE
1157! Quad
1158 DO ii = 1, numelq
1159 jal_from_mat = nint(pm(72, iabs(ixq(1, ii))))
1160 jal_from_prop = igeo(62, iabs(ixq(6, ii)) )
1161 jal = max(jal_from_mat, jal_from_prop)
1162 jalt = jal + nint(pm(71, iabs(ixq(1, ii))) + pm(96, iabs(ixq(1, ii))))
1163 IF (jalt == 0) cycle
1164 iad1 = this%EE_CONNECT%IAD_CONNECT(ii)
1165 nface = 4
1166 nface_node = 2
1167 elem_face => quad_face
1168 count = 2
1169 DO kface = 1, nface
1170 CALL intvector_clear(vec_ptr1)
1171 DO inode = 1, nface_node
1172 node_id = ixq(1 + elem_face(kface, inode), ii)
1173 itag(node_id) = 1
1174 DO iad = iad_connect(node_id), iad_connect(node_id + 1) - 1
1175 IF (connected(iad) /= ii) THEN
1176 CALL intvector_push_back(vec_ptr1, connected(iad))
1177 ENDIF
1178 ENDDO
1179 ENDDO
1180! get the redundant element number
1181 CALL intvector_get_redundant(vec_ptr1, jj, itmp, count)
1182 this%EE_CONNECT%CONNECTED(iad1 + kface - 1) = jj
1183 IF (jj > 0) THEN
1184 IF (jj > numelq) THEN
1185 nface2 = 3
1186 nface_node2 = 2
1187 elem_face2 => tri_face
1188 this%EE_CONNECT%TYPE(iad1 + kface - 1) = 3
1189 ELSE
1190 nface2 = 4
1191 nface_node2 = 2
1192 elem_face2 => quad_face
1193 this%EE_CONNECT%TYPE(iad1 + kface - 1) = 2
1194 ENDIF
1195 DO kface2 = 1, nface2
1196 itmp = 1
1197 DO inode = 1, nface_node2
1198 itmp = itmp * itag(ixq(1 + elem_face(kface2, inode), jj))
1199 ENDDO
1200 IF (itmp == 1) THEN
1201 this%EE_CONNECT%IFACE2(iad1 + kface - 1) = kface2
1202 EXIT
1203 ENDIF
1204 ENDDO
1205 ENDIF
1206 DO inode = 1, nface_node
1207 node_id = ixq(1 + elem_face(kface, inode), ii)
1208 itag(node_id) = 0
1209 ENDDO
1210 ENDDO
1211 ENDDO
1212! Tria
1213 DO ii = 1, numeltg
1214 jal_from_mat = nint(pm(72, iabs(ixtg(1, ii))))
1215 jal_from_prop = igeo(62, iabs(ixtg(5, ii)) )
1216 jal = max(jal_from_mat, jal_from_prop)
1217 jalt = jal + nint(pm(71, iabs(ixtg(1, ii))) + pm(96, iabs(ixtg(1, ii))))
1218 IF (jalt == 0) cycle
1219 iad1 = this%EE_CONNECT%IAD_CONNECT(ii)
1220 nface = 3
1221 nface_node = 2
1222 elem_face => tri_face
1223 count = 2
1224 DO kface = 1, nface
1225 CALL intvector_clear(vec_ptr1)
1226 DO inode = 1, nface_node
1227 node_id = ixtg(1 + elem_face(kface, inode), ii)
1228 itag(node_id) = 1
1229 DO iad = iad_connect(node_id), iad_connect(node_id + 1) - 1
1230 IF (connected(iad) /= ii) THEN
1231 CALL intvector_push_back(vec_ptr1, connected(iad))
1232 ENDIF
1233 ENDDO
1234 ENDDO
1235! get the redundant element number
1236 CALL intvector_get_redundant(vec_ptr1, jj, itmp, count)
1237 this%EE_CONNECT%CONNECTED(iad1 + kface - 1) = jj
1238 IF (jj > 0) THEN
1239 IF (jj > numelq) THEN
1240 nface2 = 2
1241 nface_node2 = 2
1242 elem_face2 => tri_face
1243 this%EE_CONNECT%TYPE(iad1 + kface - 1) = 3
1244 ELSE
1245 nface2 = 4
1246 nface_node2 = 3
1247 elem_face2 => quad_face
1248 this%EE_CONNECT%TYPE(iad1 + kface - 1) = 2
1249 ENDIF
1250 DO kface2 = 1, nface2
1251 itmp = 1
1252 DO inode = 1, nface_node2
1253 itmp = itmp * itag(ixtg(1 + elem_face(kface2, inode), jj))
1254 ENDDO
1255 IF (itmp == 1) THEN
1256 this%EE_CONNECT%IFACE2(iad1 + kface - 1) = kface2
1257 EXIT
1258 ENDIF
1259 ENDDO
1260 ENDIF
1261 DO inode = 1, nface_node
1262 node_id = ixtg(1 + elem_face(kface, inode), ii)
1263 itag(node_id) = 0
1264 ENDDO
1265 ENDDO
1266 ENDDO
1267 ENDIF
1268
1269 CALL intvector_delete(vec_ptr1)
1270 IF (ALLOCATED(ee_nb_connect)) DEALLOCATE(ee_nb_connect)
1271 IF (ALLOCATED(itag)) DEALLOCATE(itag)
1272 IF (ALLOCATED(ne_nb_connect)) DEALLOCATE(ne_nb_connect)
1273 IF (ALLOCATED(iad_connect)) DEALLOCATE(iad_connect)
1274 IF (ALLOCATED(adsky)) DEALLOCATE(adsky)
1275 IF (ALLOCATED(connected)) DEALLOCATE(connected)
1276
1277 END SUBROUTINE ale_compute_ee_connectivity
1278C-----------------------------------------------
1279
1280 END MODULE ale_connectivity_mod
ale51_upwind2
subroutine ale51_upwind2(pm, x, ixq, flux, flu1, ale_connect, itrimat, ddvol, qmv, iflg)
Definition ale51_upwind2.F:34
alemuscl_upwind2
subroutine alemuscl_upwind2(flux, ale_connect, x, ixq, flux_vois, n4_vois, itab, nv46, itrimat, segvar)
Definition alemuscl_upwind2.F:36
alew1
subroutine alew1(d, v, w, ale_nn_connect, nale, nodft, nodlt, nbrcvois, nbsdvois, lnrcvois, lnsdvois)
Definition alew1.F:37
binit2
subroutine binit2(elbuf_str, ms, ixq, pm, x, detonators, veul, ale_connectivity, iparg, fill, sigi, bufmat, nel, mat_param, skew, msq, ipart, ipartq, geo, igeo, ipm, nsigs, wma, ptquad, npf, tf, ipargg, iloadp, facload, partsav, v)
Definition binit2.F:48
iface2
integer function iface2(ip, n)
Definition iface.F:84
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
ale_connectivity_mod::ale_connectivity_init
subroutine ale_connectivity_init(this)
Definition ale_connectivity_mod.F:283
ale_connectivity_mod::ale_compute_connectivity
subroutine ale_compute_connectivity(this, numnod, numelq, numeltg, numels, nixq, nixtg, nixs, ixq, ixtg, ixs)
Definition ale_connectivity_mod.F:310
ale_connectivity_mod::ale_deallocate_connectivity
subroutine ale_deallocate_connectivity(this)
Definition ale_connectivity_mod.F:656
ale_connectivity_mod::ale_compute_ee_connectivity
subroutine ale_compute_ee_connectivity(this, pm, igeo, npropgi, numgeo, npropm, nummat, numnod, numelq, numeltg, numels, n2d, iale, ieuler, itherm, ialelag, ishadow, nixq, nixtg, nixs, ixq, ixtg, ixs)
Definition ale_connectivity_mod.F:676
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
quicksort_i
recursive subroutine quicksort_i(a, first, last)
Definition quicksort.F:92
quicksort_i2
recursive subroutine quicksort_i2(a, idx, first, last)
Definition quicksort.F:153
s8forc3
subroutine s8forc3(timers, output, elbuf_str, pm, geo, ixs, x, a, v, ms, veul, fv, ale_connect, iparg, tf, npf, bufmat, partsav, stifn, fsky, iads, offset, iparts, nel, dt2t, neltst, ityptst, ipm, itask, gresav, grth, igrth, mssa, dmels, table, ioutprt, mat_elem, ng, svis, glob_therm, snpc, numgeo, sbufmat, stf, ntable, sensors)
Definition s8forc3.F:64
seggetv
subroutine seggetv(iparg, elbuf_tab, ale_connectivity, itask, segvar)
Definition seggetv.F:41
starter
program starter
Definition starter.F:39
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:254
ale_connectivity_mod::t_connectivity_ext1
Definition ale_connectivity_mod.F:238
ale_connectivity_mod::t_connectivity
Definition ale_connectivity_mod.F:231