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

Go to the source code of this file.

Functions/Subroutines

subroutine prepare_split_i25e2e (nspmd, intbuf_tab, ipari, intercep)
subroutine local_edge_numbering (nedge, nrtm, nspmd, ledge, cep_seg, local_id_seg, cep_edge, local_id_edg)

Function/Subroutine Documentation

◆ local_edge_numbering()

subroutine local_edge_numbering ( integer, intent(in) nedge,
integer, intent(in) nrtm,
integer, intent(in) nspmd,
integer, dimension(nledge,nedge), intent(inout) ledge,
integer, dimension(nrtm), intent(in) cep_seg,
integer, dimension(nrtm), intent(inout) local_id_seg,
integer, dimension(nedge), intent(inout) cep_edge,
integer, dimension(nedge), intent(inout) local_id_edg )

Definition at line 234 of file prepare_split_i25e2e.F.

240C-----------------------------------------------
241C I m p l i c i t T y p e s
242C-----------------------------------------------
243#include "implicit_f.inc"
244C-----------------------------------------------
245C C o m m o n B l o c k s
246C-----------------------------------------------
247#include "param_c.inc"
248C-----------------------------------------------
249C D u m m y A r g u m e n t s
250C-----------------------------------------------
251 INTEGER, INTENT(IN) :: NEDGE,NRTM,NSPMD
252 INTEGER, INTENT(INOUT) :: LEDGE(NLEDGE,NEDGE)
253 INTEGER, INTENT(IN) :: CEP_SEG(NRTM) !starts at 1
254 INTEGER, INTENT(INOUT) :: LOCAL_ID_SEG(NRTM)
255 INTEGER, INTENT(INOUT) :: CEP_EDGE(NEDGE)
256 INTEGER, INTENT(INOUT) :: LOCAL_ID_EDG(NEDGE)
257C-----------------------------------------------
258C L o c a l V a r i a b l e s
259C-----------------------------------------------
260 INTEGER :: NRTM_LOCAL(NSPMD)
261 INTEGER :: NB_FREE_EDGES(NSPMD)
262 INTEGER :: NB_INTERNAL_EDGES(NSPMD)
263 INTEGER :: NB_BOUNDARY_EDGES_LOCAL(NSPMD) ! boundary edges treated by current domain
264 INTEGER :: NB_BOUNDARY_EDGES_REMOTE(NSPMD) ! boundary edges treated by the other domain
265 INTEGER :: EDGE_LOCAL(NSPMD)
266 INTEGER :: ISPMD
267 INTEGER :: I,E1,E2,K1,K2,K
268C-----------------------------------------------
269 nrtm_local(1:nspmd) = 0
270 edge_local(1:nspmd) = 0
271 nb_free_edges(1:nspmd) = 0
272 nb_internal_edges(1:nspmd) = 0
273 nb_boundary_edges_local(1:nspmd) = 0
274 nb_boundary_edges_remote(1:nspmd) = 0
275
276 cep_edge(1:nedge) = -1
277C FREE EDGES
278 DO i=1, nedge
279 e1=ledge(1,i)
280 e2=ledge(3,i)
281 IF(e2 == 0) THEN
282 ispmd = cep_seg(e1)
283 nb_free_edges(ispmd) = nb_free_edges(ispmd) + 1
284 edge_local(ispmd) = edge_local(ispmd) + 1
285 cep_edge(i) = ispmd - 1
286 local_id_edg(i) = edge_local(ispmd)
287 assert(ledge(9,i) == 0)
288 ledge(9,i) = ispmd - 1
289 ledge(10,i) = local_id_edg(i)
290 END IF
291 ENDDO
292
293C INTERNAL EDGES
294 DO i=1, nedge
295 e1=ledge(1,i)
296 e2=ledge(3,i)
297 ispmd = cep_seg(e1)
298 IF(e2 > 0 ) THEN ! edge not boundary
299 IF(ispmd /= cep_seg(e2)) cycle ! edge not internal
300 nb_internal_edges(ispmd) = nb_internal_edges(ispmd) + 1
301 edge_local(ispmd) = edge_local(ispmd) + 1
302 cep_edge(i) = ispmd - 1
303 local_id_edg(i) = edge_local(ispmd)
304 assert(ledge(9,i) == 0)
305 ledge(9,i) = ispmd - 1
306 ledge(10,i) = local_id_edg(i)
307 END IF
308 ENDDO
309
310C BOUNDARY EDGE LOCAL
311 DO i=1, nedge
312 e1=ledge(1,i)
313 e2=ledge(3,i)
314 ispmd = cep_seg(e1)
315 IF(e2 > 0 ) THEN ! edge not boundary
316 IF(ispmd == cep_seg(e2)) cycle ! edge internal
317 nb_boundary_edges_local(ispmd) = nb_boundary_edges_local(ispmd) + 1
318 edge_local(ispmd) = edge_local(ispmd) +1
319 cep_edge(i) = ispmd - 1
320 local_id_edg(i) = edge_local(ispmd)
321 assert(ledge(9,i) == 0)
322 ledge(9,i) = ispmd - 1
323 ledge(10,i) = local_id_edg(i)
324 END IF
325 ENDDO
326
327
328 DO i = 1,nedge
329 assert(cep_edge(i) >= 0)
330 ENDDO
331C compute local id of segment
332 DO k = 1,nrtm
333 ispmd = cep_seg(k) ! starts at 1
334 nrtm_local(ispmd) = nrtm_local(ispmd) + 1
335 local_id_seg(k) = -nrtm_local(ispmd)
336 ENDDO
337
338C Debug print
339C DO ISPMD = 1,NSPMD
340C write(6,*) ISPMD,"free=",NB_FREE_EDGES(ispmd)
341C write(6,*) ISPMD,"INTERNAL=",NB_INTERNAL_EDGES(ispmd)
342C write(6,*) ISPMD,"BOUNDARY=",NB_BOUNDARY_EDGES_LOCAL(ispmd)
343C ENDDO
344C =============
345

◆ prepare_split_i25e2e()

subroutine prepare_split_i25e2e ( integer, intent(in) nspmd,
type(intbuf_struct_), dimension(*), intent(inout) intbuf_tab,
integer, dimension(npari,*), intent(in) ipari,
type(intersurfp), dimension(3,ninter), intent(in) intercep )

Definition at line 35 of file prepare_split_i25e2e.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE message_mod
40 USE intbufdef_mod
41 USE i25_fie_mod
42 USE front_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "assert.inc"
51#include "param_c.inc"
52#include "com04_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER, INTENT(IN) :: NSPMD
57 INTEGER, INTENT(IN) :: IPARI(NPARI,*)
58 TYPE(INTERSURFP), INTENT(IN) :: INTERCEP(3,NINTER)
59 TYPE(INTBUF_STRUCT_),INTENT(INOUT) :: INTBUF_TAB(*)
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER :: IEDGE
64 INTEGER :: ISPMD
65 INTEGER :: NEDGE
66 INTEGER :: NIN
67 INTEGER :: I,J,K, NRTM, NTY, CS,CM
68 INTEGER :: SH_EDGE,SOL_EDGE
69 INTEGER, DIMENSION(:), ALLOCATABLE :: CEP_EDGE,CEPM
70 INTEGER, DIMENSION(:), ALLOCATABLE :: LOCAL_ID_EDG
71 INTEGER, DIMENSION(:), ALLOCATABLE :: LOCAL_ID_SEG
72 INTEGER, DIMENSION(:), ALLOCATABLE :: LOCAL_ID
73C C++ interface
74 INTEGER :: nbCand, nbCandE2E, nbCandE2S, sizeM
75 INTEGER, DIMENSION(:), ALLOCATABLE :: CANDS,CANDM
76 INTEGER, DIMENSION(:), ALLOCATABLE :: localIdx
77 INTEGER, DIMENSION(:,:), ALLOCATABLE :: secondaryRemoteCount
78 INTEGER :: LOCAL_CAND_COUNT(NSPMD)
79C-----------------------------------------------
80 ALLOCATE(i25_split_cand(ninter,nspmd))
81 ALLOCATE(i25_fie(ninter,nspmd))
82
83 DO nin = 1,ninter
84 nty=ipari(7,nin)
85 iedge = ipari(58,nin)
86 sol_edge =iedge/10 ! solids
87 sh_edge =iedge-10*sol_edge ! shells
88C WRITE(6,*) NIN,NTY,IEDGE
89 IF(nty/=25 .OR. iedge==0) cycle
90 nedge = ipari(68,nin)
91 nrtm = ipari(4,nin)
92 ALLOCATE(cep_edge(nedge)) !saved also temporarily in LEDGE
93 ALLOCATE(local_id_edg(nedge))
94 ALLOCATE(local_id_seg(nrtm))
95 CALL local_edge_numbering(nedge,nrtm,nspmd,
96 . intbuf_tab(nin)%LEDGE,
97 . intercep(1,nin)%P, ! = CEP_SEG
98 . local_id_seg,
99 . cep_edge,
100 . local_id_edg)
101
102 nbcande2e = intbuf_tab(nin)%I_STOK_E(1)
103 nbcande2s = intbuf_tab(nin)%I_STOK_E(2)
104
105
106 nbcand = nbcande2e + nbcande2s
107 ALLOCATE(localidx(nbcand))
108 ALLOCATE(secondaryremotecount(nspmd,nspmd))
109 ALLOCATE(candm(nbcand))
110 ALLOCATE(cands(nbcand))
111 ALLOCATE(cepm(nedge+nrtm))
112 ALLOCATE(local_id(nedge+nrtm))
113 local_id(1:nedge) = local_id_edg(1:nedge)
114 local_id(nedge+1:nedge+nrtm) = local_id_seg(1:nrtm)
115
116 sizem = nedge + nrtm
117 candm(1:nbcande2e) = intbuf_tab(nin)%CANDM_E2E(1:nbcande2e)
118 cands(1:nbcande2e) = intbuf_tab(nin)%CANDS_E2E(1:nbcande2e)
119 candm(nbcande2e+1:nbcand) = nedge + intbuf_tab(nin)%CANDM_E2S(1:nbcande2s)
120 cands(nbcande2e+1:nbcand) = intbuf_tab(nin)%CANDS_E2S(1:nbcande2s)
121 cepm(1:nedge) = cep_edge(1:nedge)
122 cepm(nedge+1:nedge+nrtm) = intercep(1,nin)%P(1:nrtm) - 1
123
124 CALL cpp_count_candidates(nbcand,
125 . sizem, !sizeM,
126 . cepm,!CepM
127 . local_id, !localIdM,
128 . candm, !candM,
129 . nedge, !sizeS,
130 . cep_edge, !cepS,
131 . local_id_edg, ! localIdS,
132 . cands, !candS
133 . nspmd,
134 . secondaryremotecount,
135 . localidx)
136
137 DO i = 1,nspmd
138 i25_fie(nin,i)%NEDGE_TOT = 0
139 ALLOCATE(i25_fie(nin,i)%NEDGE(nspmd))
140 i25_fie(nin,i)%NEDGE(1:nspmd) = 0
141 DO j = 1,nspmd
142 i25_fie(nin,i)%NEDGE(j) = i25_fie(nin,i)%NEDGE(j) + secondaryremotecount(j,i)
143 i25_fie(nin,i)%NEDGE_TOT = i25_fie(nin,i)%NEDGE_TOT + secondaryremotecount(j,i)
144 ENDDO
145 ALLOCATE(i25_fie(nin,i)%ID(i25_fie(nin,i)%NEDGE_TOT))
146 i25_fie(nin,i)%ID(1:i25_fie(nin,i)%NEDGE_TOT) = -666
147C WRITE(6,*) I,"NEDGE_TOT=",I25_FIE(NIN,I)%NEDGE_TOT
148 ENDDO
149C E2E
150 local_cand_count(1:nspmd) = 0
151 DO i = 1, nbcande2e
152 cm = cepm(intbuf_tab(nin)%CANDM_E2E(i)) + 1
153 local_cand_count(cm) = 1 + local_cand_count(cm)
154 ENDDO
155 DO i = 1, nspmd
156 i25_split_cand(nin,i)%NB_CAND_E2E = local_cand_count(i)
157C WRITE(6,*) "SPLIT_CAND size",I-1,LOCAL_CAND_COUNT(I)
158 ALLOCATE(i25_split_cand(nin,i)%CANDM_E2E(local_cand_count(i)))
159 ALLOCATE(i25_split_cand(nin,i)%CANDS_E2E(local_cand_count(i)))
160 ALLOCATE(i25_split_cand(nin,i)%ID_E2E(local_cand_count(i)))
161 local_cand_count(i) = 0
162 ENDDO
163 DO i = 1, nbcande2e
164 j = cepm(intbuf_tab(nin)%CANDM_E2E(i)) + 1 ! domain
165 local_cand_count(j) = 1 + local_cand_count(j)
166 k = local_cand_count(j)
167 i25_split_cand(nin,j)%CANDS_E2E(k) = cands(i)
168 assert(candm(i) > 0)
169 i25_split_cand(nin,j)%CANDM_E2E(k) = candm(i)
170 i25_split_cand(nin,j)%ID_E2E(k) = i
171 IF(cands(i) < 0) THEN !remote
172 i25_fie(nin,j)%ID(abs(cands(i))) = localidx(i)
173 assert(localidx(i) > 0)
174 ENDIF
175C WRITE(6,"(I10,A,2I10,A,I10)") J," has E candidate ",
176C . localIdx(I),INTBUF_TAB(NIN)%CANDS_E2E(I)," on ",CEP_EDGE(INTBUF_TAB(NIN)%CANDS_E2E(I))+1
177 ENDDO
178
179C E2S
180 local_cand_count(1:nspmd) = 0
181 DO i = 1, nbcande2s
182 cm = cepm(intbuf_tab(nin)%CANDM_E2S(i) + nedge ) + 1
183 local_cand_count(cm) = 1 + local_cand_count(cm)
184 ENDDO
185 DO i = 1, nspmd
186 i25_split_cand(nin,i)%NB_CAND_E2S = local_cand_count(i)
187 ALLOCATE(i25_split_cand(nin,i)%CANDM_E2S(local_cand_count(i)))
188 ALLOCATE(i25_split_cand(nin,i)%CANDS_E2S(local_cand_count(i)))
189 ALLOCATE(i25_split_cand(nin,i)%ID_E2S(local_cand_count(i)))
190 local_cand_count(i) = 0
191 ENDDO
192 DO i = 1, nbcande2s
193 j = cepm(intbuf_tab(nin)%CANDM_E2S(i) + nedge) + 1 ! domain
194 local_cand_count(j) = 1 + local_cand_count(j)
195 k = local_cand_count(j)
196C ASSERT(CANDM(I+nbCandE2E) < 0)
197 i25_split_cand(nin,j)%CANDS_E2S(k) = cands(i+nbcande2e)
198 i25_split_cand(nin,j)%CANDM_E2S(k) = candm(i+nbcande2e)-nedge
199 i25_split_cand(nin,j)%ID_E2S(k) = i
200 IF(cands(i+nbcande2e) < 0) THEN !remote
201 i25_fie(nin,j)%ID(abs(cands(i+nbcande2e))) = localidx(i+nbcande2e)
202 assert(localidx(i+nbcande2e) > 0 )
203 ENDIF
204C WRITE(6,"(I10,A,2I10,A,I10)") J," has S candidate ",
205C . localIdx(I),INTBUF_TAB(NIN)%CANDS_E2S(I)," on ",CEP_EDGE(INTBUF_TAB(NIN)%CANDS_E2S(I))+1
206 ENDDO
207
208CC ==debug print
209C DO J = 1,NSPMD
210C DO I = 1, I25_FIE(NIN,J)%NEDGE_TOT
211C IF(I25_FIE(NIN,J)%ID(I) < 0) WRITE(6,*) J,"FIE(",I,")=",I25_FIE(NIN,J)%ID(I)
212C ENDDO
213C ENDDO
214CC ==========
215
216 DEALLOCATE(candm)
217 DEALLOCATE(cands)
218 DEALLOCATE(localidx)
219 DEALLOCATE(secondaryremotecount)
220 DEALLOCATE(cepm)
221 DEALLOCATE(cep_edge)
222 DEALLOCATE(local_id_seg)
223 DEALLOCATE(local_id_edg)
224 DEALLOCATE(local_id)
225
226 ENDDO
cpp_count_candidates
void cpp_count_candidates(int *nbCand, int *sizeM, int *cepM, int *localIdM, int *candM, int *sizeS, int *cepS, int *localIdS, int *candS, int *nspmd, int *secondaryRemoteCount, int *localIdx)
Definition cpp_split_tool.cpp:77
front_mod
Definition front_mod.F:84
i25_fie_mod
Definition i25_fie_mod.F:30
i25_fie_mod::i25_fie
type(i25_fie_), dimension(:,:), allocatable i25_fie
Definition i25_fie_mod.F:54
i25_fie_mod::i25_split_cand
type(i25_cand_), dimension(:,:), allocatable i25_split_cand
Definition i25_fie_mod.F:53
message_mod
Definition message_mod.F:1249
local_edge_numbering
subroutine local_edge_numbering(nedge, nrtm, nspmd, ledge, cep_seg, local_id_seg, cep_edge, local_id_edg)
Definition prepare_split_i25e2e.F:240