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

Go to the source code of this file.

Functions/Subroutines

subroutine c_front (proc, nbddacc, nbddkin, nbddnrb, npby, nrbykin_l, ljoint, nbddncj, ibvel, nbddnrbm, iadll, lll, nlagf_l, front_rm, nrbymk_l, nbddnrbym, sdd_r2r_elem, addcsrect, csrect, nbddnort, nbddnor_max, nbccnor, nbccfr25, nbddedgt, nbddedg_max, nrtmx25, ipari, intbuf_tab, intercep, nodglob, nodlocal, numnod_l, nloc_dmg)

Function/Subroutine Documentation

◆ c_front()

subroutine c_front ( integer proc,
integer nbddacc,
integer nbddkin,
integer nbddnrb,
integer, dimension(nnpby,*) npby,
integer nrbykin_l,
integer, dimension(*) ljoint,
integer nbddncj,
integer, dimension(nbvelp,*) ibvel,
integer nbddnrbm,
integer, dimension(*) iadll,
integer, dimension(*) lll,
integer nlagf_l,
integer, dimension(nrbym,*) front_rm,
integer nrbymk_l,
integer nbddnrbym,
integer sdd_r2r_elem,
integer, dimension(*) addcsrect,
integer, dimension(*) csrect,
integer nbddnort,
integer nbddnor_max,
integer nbccnor,
integer nbccfr25,
integer nbddedgt,
integer nbddedg_max,
integer nrtmx25,
integer, dimension(npari,*) ipari,
type(intbuf_struct_), dimension(*) intbuf_tab,
type(intersurfp), dimension(3,ninter) intercep,
integer, dimension(numnod_l), intent(in) nodglob,
integer, dimension(numnod), intent(in) nodlocal,
integer, intent(in) numnod_l,
type (nlocal_str_), intent(in), target nloc_dmg )

Definition at line 34 of file c_front.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE front_mod
46 USE intbufdef_mod
47 USE user_windows_mod
48 USE nlocal_reg_mod
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com01_c.inc"
57#include "com04_c.inc"
58#include "param_c.inc"
59#include "lagmult.inc"
60#include "r2r_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER PROC, NBDDACC, NBDDKIN, NBDDNRB,NRBYKIN_L, NBDDNCJ,
65 . NBDDNRBM, NLAGF_L,NRBYMK_L ,NBDDNRBYM, NBDDNORT,
66 . NBDDNOR_MAX, NBCCNOR, NBCCFR25, NBDDEDGT,NBDDEDG_MAX,NRTMX25,
67 . NPBY(NNPBY,*), LJOINT(*),
68 . IBVEL(NBVELP,*) , IADLL(*), LLL(*),FRONT_RM(NRBYM,*),
69 . SDD_R2R_ELEM,
70 . ADDCSRECT(*), CSRECT(*), IPARI(NPARI,*)
71 INTEGER, INTENT(IN) :: NUMNOD_L
72 INTEGER, DIMENSION(NUMNOD_L), INTENT(IN) :: NODGLOB
73 INTEGER, DIMENSION(NUMNOD), INTENT(IN) :: NODLOCAL
74 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
75 TYPE(INTERSURFP) :: INTERCEP(3,NINTER)
76 TYPE (NLOCAL_STR_), TARGET, INTENT(IN) :: NLOC_DMG
77! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
78! NODGLOB : integer, dimension=NUMNOD_L
79! gives the global ID of a local element
80! NODGLOB( local_id) = global_id
81! NODLOCAL : integer, dimension=NUMNOD
82! gives the local ID of a global element
83! NODLOCAL( global_id) = local_id
84! --> used here to avoid NLOCAL call (the NLOCAL perf is bad)
85! NODLOCAL /= 0 if the element is on the current domain/processor
86! and =0 if the element is not on the current domain
87! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
88C-----------------------------------------------
89C F u n c t i o n
90C-----------------------------------------------
91 INTEGER NLOCAL
92 EXTERNAL nlocal
93C-----------------------------------------------
94C L o c a l V a r i a b l e s
95C-----------------------------------------------
96 INTEGER I, P, N, M, NSN, K, J,
97 . IC, IK0, IKN, IK,
98 . IFRLAG(NSPMD),CPT,
99 . NADMSR, NADMSR_L, NI, NTY, NI25, NBDDNOR, NRTM, ISHIFT,
100 . N1, N2, N3, N4, ISBOUND,
101 . NRTM_L, NBDDEDG, II, NB
102 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG_SM, TAG_MS, ITAG
103 INTEGER TAGP(NSPMD)
104! ------------------------------------------------------------
105! allocate 1d array
106 ALLOCATE( itag(numnod) )
107! ------------------------------
108C
109C Frontiere domdec pure
110C
111 nbddacc = 0
112 nbddkin = 0
113 cpt = 0
114
115 DO ii = 1,numnod_l
116 i = nodglob(ii)
117 CALL c_ifront(i,cpt)
118 !returns in CPT the number of procs on which node I is sticked
119 IF(flagkin(i)==0)THEN
120 !FLAGKIN array identities boundary nodes with kinematic constraints
121 !(FLAGKIN(N)=1 <=> old FRONT TAG=10)
122 !FLAGKIN(N) can be set to one only for first SPMD domain
123 !Add CPT-1 in order to don't take into account current proc himself
124 nbddacc = nbddacc + (cpt - 1)
125 ELSE
126 IF(proc/=1)THEN
127 !add only one time when PROC ne 1 and FLAGKIN(I)=1
128 nbddkin = nbddkin + 1
129 !do not count proc itself and proc 1
130 nbddacc = nbddacc + (cpt - 2)
131 ELSE
132 !Add CPT-1 in order to don't take into account current proc himself
133 nbddkin = nbddkin + (cpt - 1)
134 ENDIF
135 ENDIF
136 ENDDO
137C
138C Frontiere Multidomaines
139C
140 sdd_r2r_elem = 0
141 IF ((nsubdom>0).AND.(iddom==0)) THEN
142 IF (nloc_dmg%IMOD > 0) THEN
143 sdd_r2r_elem = 4*(nbddkin + nbddacc)
144 ELSE
145 sdd_r2r_elem = 2*(nbddkin + nbddacc)
146 ENDIF
147 ENDIF
148C
149C Frontiere RBY (main nodes)
150C
151 nbddnrb = 0
152 nrbykin_l = 0
153 DO n = 1, nrbykin
154 m=npby(1,n)
155 IF(nodlocal(m)/=0.AND.nodlocal(m)<=numnod_l)THEN
156 nrbykin_l = nrbykin_l + 1
157 DO p = 1, nspmd
158 IF(p/=proc) THEN
159 IF(nlocal(m,p)==1) THEN
160 nbddnrb = nbddnrb + 1
161 ENDIF
162 ENDIF
163 ENDDO
164 ENDIF
165 ENDDO
166C
167C Frontiere Cyl. JOINT (proc0)
168C
169 nbddncj = 0
170 k = 1
171 DO n = 1, njoint
172 nsn=ljoint(k)
173 DO j = 1, nsn
174 m = ljoint(k+j)
175 IF(proc/=1) THEN
176C proc <> 0, frontiere si noeud sur le proc
177 IF(nodlocal(m)/=0.AND.nodlocal(m)<=numnod_l)THEN
178 nbddncj = nbddncj + 1
179 END IF
180 ELSE
181C proc = 0, recherche des autres procs ayant le noeud
182 DO p = 2, nspmd
183 IF(nlocal(m,p)==1) THEN
184 nbddncj = nbddncj + 1
185 ENDIF
186 END DO
187 END IF
188 END DO
189 k = k + nsn + 1
190 END DO
191C
192C Frontiere RBY MOU (main nodes)
193C
194 nbddnrbm = 0
195 DO n = 1, nibvel
196 m=ibvel(4,n)
197 IF(nodlocal(m)/=0.AND.nodlocal(m)<=numnod_l)THEN
198 DO p = 1, nspmd
199 IF(p/=proc) THEN
200 IF(nlocal(m,p)==1) THEN
201 nbddnrbm = nbddnrbm + 1
202 ENDIF
203 ENDIF
204 ENDDO
205 ENDIF
206 ENDDO
207C
208C Frontiere Rigid material (effectif main nodes)
209C
210 nbddnrbym = 0
211 nrbymk_l = 0
212 DO n = 1, nrbym
213 IF(mod(front_rm(n,proc),10)==1)THEN
214 nrbymk_l = nrbymk_l + 1
215 DO p = 1, nspmd
216 IF(p/=proc) THEN
217 IF(mod(front_rm(n,p),10)==1) THEN
218 nbddnrbym = nbddnrbym + 1
219 ENDIF
220 ENDIF
221 ENDDO
222 ENDIF
223 ENDDO
224C
225C Frontiere LAG MULT
226C
227 IF(lag_ncf>0) THEN
228 DO n = 1, numnod
229 itag(n) = 0
230 END DO
231 DO p = 1, nspmd
232 ifrlag(p) = 0
233 END DO
234 DO ic = 1, lag_ncf
235 ik0 = iadll(ic)
236 ikn = iadll(ic+1)-1
237 DO ik = ik0,ikn
238 n = lll(ik)
239 IF(itag(n)==0) THEN
240 itag(n) = 1
241 DO p = 1, nspmd
242 IF(nlocal(n,p)==1)THEN
243 ifrlag(p) = ifrlag(p) + 1
244 GOTO 100
245 END IF
246 END DO
247 100 CONTINUE
248 END IF
249 END DO
250 END DO
251 nlagf_l = ifrlag(proc)
252 END IF
253! ------------------------------
254! deallocate 1d array
255 DEALLOCATE( itag )
256! ------------------------------
257C ---------------------
258C Interfaces TYPE25, Max nb of frontiers wrt vertices overall interfaces
259C ---------------------
260 nbccfr25 = 0
261 nbccnor = 0
262
263 nbddnor_max = 0
264 nbddnort = 0
265 IF(ninter25/=0)THEN
266
267 ni25=0
268 ishift = 0
269
270 DO ni=1,ninter
271 nty=ipari(7,ni)
272 IF(nty/=25) cycle
273
274 nbddnor = 0
275
276 ni25=ni25+1
277
278 nrtm =ipari(4,ni)
279 nadmsr=ipari(67,ni)
280
281 ALLOCATE(tag_sm(nadmsr),tag_ms(nadmsr))
282 tag_sm(1:nadmsr)=0
283
284 nadmsr_l=0
285 DO k=1,nrtm
286 n1 = intbuf_tab(ni)%ADMSR(4*(k-1)+1)
287 n2 = intbuf_tab(ni)%ADMSR(4*(k-1)+2)
288 n3 = intbuf_tab(ni)%ADMSR(4*(k-1)+3)
289 n4 = intbuf_tab(ni)%ADMSR(4*(k-1)+4)
290 IF(intercep(1,ni)%P(k)==proc)THEN
291 IF(tag_sm(n1)==0)THEN
292 nadmsr_l=nadmsr_l+1
293 tag_sm(n1)=nadmsr_l
294 END IF
295 IF(tag_sm(n2)==0)THEN
296 nadmsr_l=nadmsr_l+1
297 tag_sm(n2)=nadmsr_l
298 END IF
299 IF(tag_sm(n3)==0)THEN
300 nadmsr_l=nadmsr_l+1
301 tag_sm(n3)=nadmsr_l
302 END IF
303 IF(tag_sm(n4)==0)THEN
304 nadmsr_l=nadmsr_l+1
305 tag_sm(n4)=nadmsr_l
306 END IF
307 ENDIF
308 ENDDO
309
310 DO i = 1, nadmsr
311 k = tag_sm(i)
312 IF(k/=0)THEN
313 tag_ms(k)=i
314 END IF
315 END DO
316 DO i = 1, nadmsr_l
317 n = tag_ms(i) + ishift
318 isbound=0
319 tagp(1:nspmd)=0
320 nb = 0
321 DO j = addcsrect(n), addcsrect(n+1)-1
322 k = csrect(j)
323 p = intercep(1,ni)%P(k)
324 nb = nb+1
325 IF(p /= proc.AND.tagp(p)==0) THEN
326 nbddnor = nbddnor + 1
327 isbound = 1
328 tagp(p) = 1
329 ENDIF
330 ENDDO
331 nbccfr25 = nbccfr25 + nb*isbound
332 nbccnor = nbccnor + nb
333 ENDDO
334 ishift=ishift+nadmsr
335
336 nbddnor_max = max(nbddnor_max,nbddnor)
337 nbddnort = nbddnort+nbddnor
338
339
340 DEALLOCATE(tag_sm, tag_ms)
341
342 END DO
343
344 END IF ! NINTER25/=0
345
346C ---------------------
347C Interfaces TYPE25, Max nb of frontiers wrt edges overall interfaces
348C ---------------------
349 nbddedg_max = 0
350 nbddedgt = 0
351
352 nrtmx25=0
353 IF(ninter25/=0)THEN
354
355 ni25=0
356
357 DO ni=1,ninter
358 nty=ipari(7,ni)
359 IF(nty/=25) cycle
360
361 nbddedg = 0
362
363 ni25=ni25+1
364
365 nrtm =ipari(4,ni)
366
367 ALLOCATE(tag_sm(nrtm),tag_ms(nrtm))
368 tag_sm(1:nrtm)=0
369
370 nrtm_l=0
371 DO k=1,nrtm
372 IF(intercep(1,ni)%P(k)==proc)THEN
373 nrtm_l=nrtm_l+1
374 tag_sm(k)=nrtm_l
375 ENDIF
376 ENDDO
377
378 nrtmx25 = max(nrtmx25,nrtm_l)
379
380 DO i = 1, nrtm
381 k = tag_sm(i)
382 IF(k/=0)THEN
383 tag_ms(k)=i
384 END IF
385 END DO
386
387 DO i = 1, nrtm_l
388 n = tag_ms(i)
389
390 DO j = 1,4
391 k = intbuf_tab(ni)%MVOISIN(4*(n-1)+j)
392 IF(k/=0)THEN
393 p = intercep(1,ni)%P(k)
394 IF(p /= proc) THEN
395 nbddedg = nbddedg + 1
396 ENDIF
397 ENDIF
398 ENDDO
399 ENDDO
400
401 nbddedg_max = max(nbddedg_max,nbddedg)
402 nbddedgt = nbddedgt+nbddedg
403
404 DEALLOCATE(tag_sm,tag_ms)
405
406 END DO
407
408 END IF ! NINTER25/=0
409C
410 RETURN
c_ifront
subroutine c_ifront(n, cpt)
Definition ddtools.F:205
nlocal
integer function nlocal(n, p)
Definition ddtools.F:349
max
#define max(a, b)
Definition macros.h:21
front_mod
Definition front_mod.F:84
front_mod::flagkin
integer, dimension(:), allocatable flagkin
Definition front_mod.F:105
nlocal_reg_mod
Definition nlocal_reg_mod.F:117
user_windows_mod
Definition user_windows_mod.F:48