OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
c_front.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/.
23C
24!||====================================================================
25!|| c_front ../starter/source/restart/ddsplit/c_front.F
26!||--- called by ------------------------------------------------------
27!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
28!||--- calls -----------------------------------------------------
29!|| c_ifront ../starter/source/spmd/node/ddtools.F
30!|| nlocal ../starter/source/spmd/node/ddtools.F
31!||--- uses -----------------------------------------------------
32!|| front_mod ../starter/share/modules1/front_mod.F
33!||====================================================================
34 SUBROUTINE c_front(PROC ,NBDDACC,NBDDKIN,NBDDNRB,
35 2 NPBY ,NRBYKIN_L,LJOINT ,NBDDNCJ,IBVEL ,
36 3 NBDDNRBM ,IADLL ,LLL ,NLAGF_L,FRONT_RM,
37 4 NRBYMK_L ,NBDDNRBYM,
38 5 SDD_R2R_ELEM,ADDCSRECT,CSRECT,NBDDNORT,NBDDNOR_MAX,
39 6 NBCCNOR,NBCCFR25,NBDDEDGT ,NBDDEDG_MAX,NRTMX25 ,
40 7 IPARI ,INTBUF_TAB,INTERCEP,NODGLOB ,NODLOCAL ,
41 8 NUMNOD_L,NLOC_DMG)
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
411 END
c_front
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)
Definition c_front.F:42
c_ifront
subroutine c_ifront(n, cpt)
Definition ddtools.F:205
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