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

Go to the source code of this file.

Functions/Subroutines

subroutine c_ixfloc (numel, ixsf, ixqf, ixtgf, nsvois, nqvois, ntgvois, proc, iparg, cep, cel, ale_connectivity, ee_connect_l, ixs, ixq, ixtg, nodlocal, numels_l, numelq_l, numeltg_l, multi_fvm, id_global_vois, indx_s, indx_q, indx_tg, face_elm_s, face_elm_q, face_elm_tg, face_vois, ishadow)

Function/Subroutine Documentation

◆ c_ixfloc()

subroutine c_ixfloc ( integer numel,
integer, dimension(nixs,nsvois) ixsf,
integer, dimension(nixq,nqvois) ixqf,
integer, dimension(nixtg,ntgvois) ixtgf,
integer nsvois,
integer nqvois,
integer ntgvois,
integer proc,
integer, dimension(nparg,*) iparg,
integer, dimension(*) cep,
integer, dimension(*) cel,
type(t_ale_connectivity), intent(inout) ale_connectivity,
type(t_connectivity_ext1), intent(inout) ee_connect_l,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) nodlocal,
integer numels_l,
integer numelq_l,
integer numeltg_l,
type(multi_fvm_struct) multi_fvm,
integer, dimension(*), intent(out) id_global_vois,
integer, dimension(*), intent(in) indx_s,
integer, dimension(*), intent(in) indx_q,
integer, dimension(*), intent(in) indx_tg,
integer, dimension(6*numels,*), intent(in) face_elm_s,
integer, dimension(4*numelq,*), intent(in) face_elm_q,
integer, dimension(3*numeltg,*), intent(in) face_elm_tg,
integer, dimension(*), intent(out) face_vois,
logical, intent(in) ishadow )
Parameters
[in]ishadowshadowing option for detonators (Eikonal equation solver)

Definition at line 32 of file c_ixfloc.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE multi_fvm_mod
41 use element_mod , only : nixs,nixq,nixtg
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50#include "com04_c.inc"
51#include "param_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER NSVOIS, NQVOIS, NTGVOIS, PROC, NUMEL,
56 . NUMELS_L,NUMELQ_L,NUMELTG_L,
57 . IXSF(NIXS,NSVOIS) ,IXQF(NIXQ,NQVOIS),IXTGF(NIXTG,NTGVOIS),
58 . IPARG(NPARG,*),CEP(*),CEL(*),
59 . IXS(NIXS,*), IXQ(NIXQ,*), IXTG(NIXTG,*),NODLOCAL(*)
60 INTEGER, DIMENSION(*), INTENT(OUT) :: ID_GLOBAL_VOIS,FACE_VOIS
61 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
62 ! index for id of the remote connected element
63 INTEGER, DIMENSION(*), INTENT(in) :: INDX_S
64 INTEGER, DIMENSION(*), INTENT(in) :: INDX_Q
65 INTEGER, DIMENSION(*), INTENT(in) :: INDX_TG
66 ! id of the remote connected element
67 INTEGER, DIMENSION(6*NUMELS,*), INTENT(in) :: FACE_ELM_S
68 INTEGER, DIMENSION(4*NUMELQ,*), INTENT(in) :: FACE_ELM_Q
69 INTEGER, DIMENSION(3*NUMELTG,*), INTENT(in) :: FACE_ELM_TG
70 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
71 TYPE(t_connectivity_ext1), INTENT(INOUT) :: ee_connect_l
72 LOGICAL, INTENT(IN) :: ISHADOW !< shadowing option for detonators (Eikonal equation solver)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER I, J, K, NG, IFS, IFQ, IFTG,IE_LOC, IV_LOC
77 INTEGER JTUR,JTHE,ITY,IE,NFT,NEL,IV,PROC2,NFT_LOC,IAD1, LGTH, IAD2
78 INTEGER NUMEL_L, TMP, IALEUL
79 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGE, nb_connect_l
80 LOGICAL IS_HEXA,IS_QUAD,IS_TRIA
81C-----------------------------------------------
82C S o u r c e L i n e s
83C-----------------------------------------------
84! Number of local elements
85 numel_l = 0
86 DO ng = 1, ngroup
87 IF (iparg(32, ng) == proc) THEN
88 nel = iparg(2, ng)
89 numel_l = numel_l + nel
90 ENDIF
91 ENDDO
92 ALLOCATE(ee_connect_l%iad_connect(numel_l + 1))
93 ee_connect_l%iad_connect(1:numel_l + 1) = 0
94 ALLOCATE(nb_connect_l(numel_l))
95 nb_connect_l(1:numel_l) = 0
96
97! Counting elements connected to local elements
98 nft_loc = 0
99 DO ng = 1, ngroup
100 IF (iparg(32, ng) == proc) THEN
101 nel = iparg(2, ng)
102 nft = iparg(3, ng)
103 ialeul = iparg(7, ng) + iparg(11, ng)
104 ity = iparg(5,ng)
105 is_hexa=.false.
106 is_quad=.false.
107 is_tria=.false.
108 IF(ity == 1)is_hexa=.true.
109 IF(ity == 2)is_quad=.true.
110 IF(ity == 7 .AND. n2d > 0)is_tria=.true.
111 IF(is_hexa .OR. is_quad .OR. is_tria)THEN !skip shell, sh3n, and other elem types
112 IF (ialeul /= 0 .OR. ishadow) THEN
113 DO i = 1, nel
114 ! Index of the element
115 ie = i + nft
116 ! Local index of the element
117 ie_loc = i + nft_loc
118 ! Number of neighbors
119 lgth = ale_connectivity%ee_connect%iad_connect(ie+1)-ale_connectivity%ee_connect%iad_connect(ie)
120 nb_connect_l(ie_loc) = lgth
121 ENDDO
122 ENDIF
123 ENDIF
124 nft_loc = nft_loc + nel
125 ENDIF
126 ENDDO
127 ee_connect_l%iad_connect(1) = 1
128 DO i = 2, numel_l + 1
129 ee_connect_l%iad_connect(i) = ee_connect_l%iad_connect(i - 1) + nb_connect_l(i - 1)
130 ENDDO
131 tmp = ee_connect_l%iad_connect(numel_l + 1) - 1
132 ALLOCATE(ee_connect_l%connected(tmp)) ; ee_connect_l%connected(1:tmp) = 0
133 ALLOCATE(ee_connect_l%type(tmp)) ; ee_connect_l%type(1:tmp) = 0
134 ALLOCATE(ee_connect_l%iface2(tmp)) ; ee_connect_l%iface2(1:tmp) = 0
135C
136 ALLOCATE(tage(numel))
137 DO i = 1, numel
138 tage(i) = 0
139 ENDDO
140 ifs = 0
141 ifq = 0
142 iftg = 0
143 nft_loc = 0
144C
145 DO ng=1,ngroup
146 jtur=iparg(12,ng)
147 jthe=iparg(13,ng)
148 IF(iparg(32,ng)==proc) THEN
149 nel = iparg(2,ng)
150 nft = iparg(3,ng)
151 ity = iparg(5,ng)
152C 3D
153 IF(ity==1) THEN
154 DO i = 1, nel
155 ie = i+nft
156 ie_loc = i+nft_loc
157 iad1 = ale_connectivity%ee_connect%iad_connect(ie)
158 lgth = ale_connectivity%ee_connect%iad_connect(ie+1)-ale_connectivity%ee_connect%iad_connect(ie)
159 tage(ie) = cel(ie)
160C IVOIS
161 DO j = 1, lgth
162 iv = ale_connectivity%ee_connect%connected(iad1 + j - 1)
163 iad2 = ee_connect_l%iad_connect(ie_loc) + j - 1
164 IF (iv>0) THEN
165 proc2 = cep(iv)
166 iv_loc = cel(iv)
167 IF(proc2/=proc) THEN
168C boundary element
169 IF(tage(iv)==0) THEN
170 ifs = ifs + 1
171 tage(iv) = numels_l+ifs
172C recopie IXS + chgt no local des noeuds
173 DO k = 1,1
174 ixsf(k,ifs) = ixs(k,iv)
175 ENDDO
176 DO k = 2,9
177 ixsf(k,ifs) = nodlocal(ixs(k,iv))
178 ENDDO
179 DO k = 10,nixs
180 ixsf(k,ifs) = ixs(k,iv)
181 ENDDO
182 ENDIF
183C ivois
184 ee_connect_l%connected(iad2) = tage(iv)
185
186 id_global_vois( (ie_loc-1)*6+j ) = ixs(nixs,iv) ! not on the current proc
187 DO k=1,indx_s(ie)
188 IF( ixs(nixs,iv)==face_elm_s(6*(ie-1)+k,2) ) THEN
189 face_vois( (ie_loc-1)*6+j ) = face_elm_s(6*(ie-1)+k,1) ! not on the current proc
190 ENDIF
191 ENDDO
192 ELSE
193C element interne
194 ee_connect_l%connected(iad2) = iv_loc
195 id_global_vois( (ie_loc-1)*6+j ) = ixs(nixs,iv) ! on the current proc
196 ENDIF
197 ELSE
198 ee_connect_l%connected(iad2) = iv
199 id_global_vois( (ie_loc-1)*6+j ) = 0 ! no neighbor
200 ENDIF
201 ee_connect_l%type(iad2) = ale_connectivity%ee_connect%type(iad1 + j - 1)
202 ee_connect_l%iface2(iad2) = ale_connectivity%ee_connect%iface2(iad1 + j - 1)
203 ENDDO
204 ENDDO
205 nft_loc = nft_loc + nel
206 ELSEIF(ity==2) THEN
207C 2D
208 DO i = 1, nel
209 ie = i+nft
210 ie_loc = i+nft_loc
211 iad1 = ale_connectivity%ee_connect%iad_connect(ie)
212 lgth = ale_connectivity%ee_connect%iad_connect(ie+1)-ale_connectivity%ee_connect%iad_connect(ie)
213 tage(ie) = cel(ie)
214C IVOIS
215 DO j = 1, lgth
216 iv = ale_connectivity%ee_connect%connected(iad1 + j - 1)
217 iad2 = ee_connect_l%iad_connect(ie_loc) + j - 1
218 IF (iv>0) THEN
219 proc2 = cep(iv)
220 iv_loc = cel(iv)
221 IF(proc2/=proc) THEN
222C boundary element
223 IF(tage(iv)==0) THEN
224 ifq = ifq + 1
225 tage(iv) = numelq_l+ifq
226C recopie IXQ + chgt no local des noeuds
227 DO k = 1,1
228 ixqf(k,ifq) = ixq(k,iv)
229 ENDDO
230 DO k = 2,5
231 ixqf(k,ifq) = nodlocal(ixq(k,iv))
232 ENDDO
233 DO k = 6,nixq
234 ixqf(k,ifq) = ixq(k,iv)
235 ENDDO
236 ENDIF
237C ivois
238 ee_connect_l%connected(iad2) = tage(iv)
239 id_global_vois( (ie_loc-1)*4+j ) = ixq(nixq,iv)
240 DO k=1,indx_q(ie)
241 IF( ixq(nixq,iv)==face_elm_q(4*(ie-1)+k,2) ) THEN
242 face_vois( (ie_loc-1)*4+j ) = face_elm_q(4*(ie-1)+k,1) ! not on the current proc
243 ENDIF
244 ENDDO
245 ELSE
246C element interne
247 ee_connect_l%connected(iad2) = iv_loc
248 id_global_vois( (ie_loc-1)*4+j ) = ixq(nixq,iv)
249 ENDIF
250 ELSE
251 ee_connect_l%connected(iad2) = iv
252 id_global_vois( (ie_loc-1)*4+j ) = 0
253 ENDIF
254 ee_connect_l%type(iad2) = ale_connectivity%ee_connect%type(iad1 + j - 1)
255 ee_connect_l%iface2(iad2) = ale_connectivity%ee_connect%iface2(iad1 + j - 1)
256 ENDDO
257 ENDDO
258 nft_loc = nft_loc + nel
259 ELSEIF(ity == 7 .AND. (n2d /= 0 .AND. multi_fvm%IS_USED)) THEN
260C 2D
261 DO i = 1, nel
262 ie = i+nft
263 ie_loc = i+nft_loc
264 iad1 = ale_connectivity%ee_connect%iad_connect(ie)
265 lgth = ale_connectivity%ee_connect%iad_connect(ie+1)-ale_connectivity%ee_connect%iad_connect(ie)
266 tage(ie) = cel(ie)
267C IVOIS
268 DO j = 1, 3
269 iv = ale_connectivity%ee_connect%connected(iad1 + j - 1)
270 iad2 = ee_connect_l%iad_connect(ie_loc) + j - 1
271 IF (iv>0) THEN
272 proc2 = cep(iv)
273 iv_loc = cel(iv)
274 IF(proc2/=proc) THEN
275C boundary element
276 IF(tage(iv)==0) THEN
277 iftg = iftg + 1
278 tage(iv) = numeltg_l+iftg
279C recopie IXQ + chgt no local des noeuds
280 DO k = 1,1
281 ixtgf(k,iftg) = ixtg(k,iv)
282 ENDDO
283 DO k = 2,4
284 ixtgf(k,iftg) = nodlocal(ixtg(k,iv))
285 ENDDO
286 DO k = 5,nixtg
287 ixtgf(k,iftg) = ixtg(k,iv)
288 ENDDO
289 ENDIF
290C ivois
291 ee_connect_l%connected(iad2) = tage(iv)
292 id_global_vois( (ie_loc-1)*3+j ) = ixtg(nixtg,iv)
293
294 DO k=1,indx_tg(ie)
295 IF( ixtg(nixtg,iv)==face_elm_tg(3*(ie-1)+k,2) ) THEN
296 face_vois( (ie_loc-1)*3+j ) = face_elm_tg(3*(ie-1)+k,1) ! not on the current proc
297 ENDIF
298 ENDDO
299
300 ELSE
301C element interne
302 ee_connect_l%connected(iad2) = iv_loc
303 id_global_vois( (ie_loc-1)*3+j ) = ixtg(nixtg,iv)
304 ENDIF
305 ELSE
306 ee_connect_l%connected(iad2) = iv
307 id_global_vois( (ie_loc-1)*3+j ) = 0
308 ENDIF
309 ee_connect_l%type(iad2) = ale_connectivity%ee_connect%type(iad1 + j - 1)
310 ee_connect_l%iface2(iad2) = ale_connectivity%ee_connect%iface2(iad1 + j - 1)
311 ENDDO
312 ENDDO
313 nft_loc = nft_loc + nel
314 ENDIF
315 ENDIF
316 ENDDO
317 DEALLOCATE(tage)
318 DEALLOCATE(nb_connect_l)
319 RETURN