OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ipari_l_ini.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!|| ipari_l_ini ../starter/source/restart/ddsplit/ipari_l_ini.F
25!||--- called by ------------------------------------------------------
26!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
27!||--- calls -----------------------------------------------------
28!|| nlocal ../starter/source/spmd/node/ddtools.F
29!|| secnd_surface_on_domain ../starter/source/interfaces/inter3d1/i24setnodes.F
30!||--- uses -----------------------------------------------------
31!|| front_mod ../starter/share/modules1/front_mod.f
32!||====================================================================
33 SUBROUTINE ipari_l_ini(IPARI ,PROC ,NUMNOD_L,
34 + NBDDI2M ,I2NSN_L,PROBINT,IMAXIMP_L,NBI18_L ,
35 + NSKYI18_L,NSNT_L ,NMNT_L ,NSNT2_L ,NMNT2_L ,
36 + CEP ,IGRBRIC,IPARI_L ,
37 + NODLOCAL ,I2NSN25_L,INTERCEP, INTBUF_TAB,NUMNOR_L,
38 + I24MAXNSNE, MULTI_FVM,TAG,INDEX0,NINDEX0)
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE front_mod
43 USE intbufdef_mod
44 USE multi_fvm_mod
45 USE groupdef_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "com01_c.inc"
54#include "com04_c.inc"
55#include "param_c.inc"
56#include "inter22.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER PROC, NUMNOD_L,
61 . NBDDI2M, I2NSN_L, IMAXIMP_L, NBI18_L, NSKYI18_L,
62 . IPARI(NPARI,*), CEP(*),
63 . NSNT_L,NMNT_L,NSNT2_L,NMNT2_L,
64 . IPARI_L(NPARI,NINTER),NODLOCAL(*),I2NSN25_L,
65 . numnor_l,i24maxnsne
66c INTER22
67 INTEGER NBRIC_L, ISU1, NBRIC
68 INTEGER,INTENT(INOUT) :: NINDEX0
69 INTEGER, DIMENSION(*),INTENT(INOUT) :: INDEX0,TAG
70c
71 my_real
72 . probint
73C-----------------------------------------------
74 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
75C-----------------------------------------------
76 TYPE(intersurfp) :: INTERCEP(3,NINTER)
77
78 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
79 TYPE(multi_fvm_struct), INTENT(IN) :: MULTI_FVM
80C-----------------------------------------------
81C F u n c t i o n
82C-----------------------------------------------
83 INTEGER NLOCAL
84 EXTERNAL nlocal
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER NI, NP, ITY, NRTS, NRTM, NSN, NMN,NMT,NMT_L,
89 . nlins, nlinm,nlinsa,nlinma,nsne, nmne, nln, nln_l,
90 . i_stok_l, nsn_l, nmn_l, nrtm_l, nrts_l, nlins_l,
91 . nlinm_l, nsne_l, nmne_l, n1l, n2l, n3l, n4l, nl,
92 . nir, n, l, k, jj, m, n1, n2, n3, n4, kk, p, e, i, j,
93 . inacti,l24add,l24add_l,
94 . multimp, igap, ifq, iform, iok, iedge, nconte, multimpe, multimps,
95 . i_stok, ncont, nisub, nisubs_l, nisubm_l,nisubs, nisubm, nisube_l,
96 . ie, ign, ige, nad, ead,nuvar,ilev,intth,ncont1,ncont2,
97 . mtyp,nsnr,icurv,nrtm0,nrtm_sh,nrtm_sh_l,
98 . ii_stok,ii_stok_l,nremnode_l,flagremnode,
99 . kd_l(50),jd_l(50),kfi_l,jfi_l,nlinsa_l,nlinma_l,i22len1,
100 . nrtse,nrtse_l,nsn0,nadmsr,nadmsr_l,se1,nn,
101 . nrtm_fe,nrts_fe, nsn_fe ,nmn_fe ,nremnor_l,
102 . nedge, nedge_l, ii_stok_e, ii_stok_el, k1, k2,
103 . intnitsche, my_node,nremnode_e2s_l,
104 . nsn_ige,siz,nremnode_edg_l,em1,em2,es1,es2,ik,km1,km2,ks1,ks2
105 INTEGER, DIMENSION(:),ALLOCATABLE :: TAGE, TAGE2
106 INTEGER, DIMENSION(:),ALLOCATABLE :: TAGI2,TAGG
107 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG_SM
108 LOGICAL :: IS_LOCAL
109
110 my_real
111 . rcont
112 INTEGER SECND_SURFACE_ON_DOMAIN
113 EXTERNAL secnd_surface_on_domain
114C-----------------------------------------------
115! IF (MULTI_FVM%IS_USED) THEN
116! ALLOCATE(TAG(NUMELS + NUMNOD))
117! ALLOCATE(INDEX0(NUMELS + NUMNOD))
118! TAG(1:NUMELS + NUMNOD) = 0
119! ELSE
120! ALLOCATE(TAG(NUMNOD+I24MAXNSNE))
121! ALLOCATE(INDEX0(NUMNOD+I24MAXNSNE))
122! TAG(1:NUMNOD+I24MAXNSNE) = 0
123! ENDIF
124 ALLOCATE(tagi2(numnod))
125 ALLOCATE(tagg(numnod))
126C-----------------------------------------------
127C Construction de IPARI_L - recopie initiale
128C-----------------------------------------------
129 ipari_l(1:npari,1:ninter)=ipari(1:npari,1:ninter)
130C-----------------------------------------------
131C decompte nb total main nodes et noeuds main int 2 frontieres
132 nbddi2m = 0
133 i2nsn_l = 0
134C decompte nb total noeuds secnd int 2 penalty
135 i2nsn25_l = 0
136C decompte impact interface type 7, 10, 11
137 imaximp_l = 0
138C
139 nbi18_l = 0
140 nskyi18_l = 0
141
142C tag noeud interface I2
143 DO i = 1, numnod
144 tagi2(i) = 0
145 END DO
146C
147 numnor_l = 0
148 DO ni=1,ninter
149 nindex0 = 0
150C
151 ity = ipari(7,ni)
152 IF(ity/=2.AND.ity/=7.AND.ity/=8.AND.ity/=9.AND.
153 . ity/=10.AND.ity/=11.AND.
154 . (ity/=17.OR.ipari(33,ni)/=0).AND.ity/=20.AND.
155 . ity/=21.AND.ity/=22.AND.ity/=23.AND.ity/=24.AND.
156 . ity/=25)THEN
157! *********************************
158C calcul IMAXIMP_L suivant interface
159 IF(ity==3) THEN
160 nsn = ipari(5,ni)
161 nmn = ipari(6,ni)
162 imaximp_l = imaximp_l + 2*nint((nmn+nsn)/probint)
163 ELSEIF(ity==5.OR.ity==6) THEN
164 nsn = ipari(5,ni)
165 imaximp_l = imaximp_l + 2*nint(nsn/probint)
166 ELSEIF(ity==14) THEN
167 nsn = ipari(5,ni)
168 imaximp_l = imaximp_l + 2*nint(nsn/probint/5)
169 ELSEIF(ity==15) THEN
170 nrts = ipari(3,ni)
171 imaximp_l = imaximp_l + 2*nint(nrts*4/probint/5)
172 END IF
173 ELSEIF (ity==2) THEN
174! *********************************
175 nrts = ipari(3,ni)
176 nrtm = ipari(4,ni)
177 nsn = ipari(5,ni)
178 nmn = ipari(6,ni)
179 ilev = ipari(20,ni)
180
181 ALLOCATE(tage(nrtm))
182 DO i = 1, nrtm
183 tage(i) = 0
184 ENDDO
185C calcul nombre de noeuds secnds locaux
186 nsn_l = 0
187 DO k=1,nsn
188 my_node = intbuf_tab(ni)%NSV(k)
189 IF( nodlocal(my_node)/=0.AND.nodlocal(my_node)<=numnod_l ) THEN
190 nsn_l = nsn_l + 1
191 l = intbuf_tab(ni)%IRTLM(k)
192 tage(l) = 1
193 DO p = 1, proc
194 IF(nlocal(intbuf_tab(ni)%NSV(k),p)==1) GO TO 102
195 ENDDO
196 i2nsn_l = i2nsn_l + 1
197 102 CONTINUE
198 ENDIF
199 END DO
200 ipari_l(5,ni) = nsn_l
201 nmn_l = 0
202C calcul nombre total secnd penalty
203 IF (ilev == 25 .or. ilev == 26 .or. ilev == 27 .or. ilev == 28) THEN
204 DO k=1,nsn
205 my_node = intbuf_tab(ni)%NSV(k)
206 IF( nodlocal(my_node)/=0.AND.nodlocal(my_node)<=numnod_l ) THEN
207 i2nsn25_l = i2nsn25_l + 1
208 ENDIF
209 END DO
210 END IF
211C calcul des mains independant des facettes pour resolution pb de cumul p/off
212 DO k = 1, nmn
213 my_node = intbuf_tab(ni)%MSR(k)
214 IF( nodlocal(my_node)/=0.AND.nodlocal(my_node)<=numnod_l ) THEN
215 nmn_l = nmn_l + 1
216 IF(tagi2(intbuf_tab(ni)%MSR(k))==0) THEN
217C decompte des frontieres de main nodes
218 DO p = 1, nspmd
219 IF(nlocal(intbuf_tab(ni)%MSR(k),p)==1)THEN
220 nbddi2m = nbddi2m + 1
221 END IF
222 END DO
223C on ne se compte pas soi-meme
224 nbddi2m = nbddi2m - 1
225C pour ne pas prendre en compte 2 fois des noeuds main d'interfaces differentes ds les frontieres
226 tagi2(intbuf_tab(ni)%MSR(k)) = 1
227 END IF
228 ENDIF
229 END DO
230 ipari_l(6,ni) = nmn_l
231C
232 nrtm_l = 0
233 DO i = 1, nrtm
234 IF(tage(i)==1) nrtm_l = nrtm_l + 1
235 ENDDO
236 ipari_l(4,ni) = nrtm_l
237C
238 DEALLOCATE(tage)
239C
240 nsnt2_l = nsnt2_l + nsn_l
241 nmnt2_l = nmnt2_l + nmn_l
242C Idel2 : allocation j23 et j24
243 ilev = ipari(20,ni)
244 IF (ilev==10 .OR. ilev==11 .OR. ilev==12) THEN
245 nuvar = ipari(35,ni)
246 ELSEIF (ilev==20 .OR. ilev==21 .OR. ilev==22) THEN
247 nuvar = ipari(35,ni)
248 ENDIF
249C-------------------------
250C IPARI_L Interface type 2
251C-------------------------
252 ipari_l(4,ni) = nrtm_l
253 ipari_l(5,ni) = nsn_l
254 ipari_l(6,ni) = nmn_l
255C
256 ELSEIF(ity==7.OR.ity==8.OR.ity==10.OR.
257 . ity==22.OR.ity==23.OR.ity==24.OR.
258 . ity==25) THEN
259! *********************************
260C
261 nrts = ipari(3,ni)
262 nrtm = ipari(4,ni)
263 nrtm_fe = ipari(74,ni)
264 nsn = ipari(5,ni)
265 nsn_fe = ipari(78,ni)
266 nsn_ige= ipari(77,ni)
267 nmn = ipari(6,ni)
268 nmn_fe = ipari(80,ni)
269 nmt = ipari(9,ni)
270 igap = ipari(21,ni)
271 inacti = ipari(22,ni)
272 multimp= ipari(23,ni)
273 iform = ipari(30,ni)
274 ifq = ipari(31,ni)
275 nisub = ipari(36,ni)
276 icurv = ipari(39,ni)
277 intth = ipari(47,ni)
278 iedge = ipari(58,ni)
279 l24add = ipari(59,ni)
280 nrtse = ipari(52,ni)
281 nsne = ipari(55,ni)
282 nadmsr = ipari(67,ni)
283 nedge = ipari(68,ni)
284 intnitsche = ipari(86,ni)
285 multimpe = ipari(87,ni)
286 multimps = ipari(89,ni)
287 IF (ity == 24) THEN
288 nsn0 = nsn - nsne
289 ELSEIF (ity == 7) THEN
290 nsn0 = nsn - nsn_ige
291 ELSE
292 nsn0 = nsn
293 ENDIF
294C
295 flagremnode = ipari(63,ni)
296C
297 nrtm_l = 0
298 nmn_l = 0
299 nsn_l = 0
300 nsne_l = 0
301 nremnode_l = 0
302 nadmsr_l = 0
303 nedge_l = 0
304 nremnor_l = 0
305 nrts_l = 0
306 nconte = 0
307 nremnode_edg_l = 0
308 nremnode_e2s_l = 0
309
310C
311 IF(ity/=7) THEN
312 nrtm_fe = nrtm
313 nsn_fe = nsn
314 nmn_fe = nmn
315 ENDIF
316C
317 ALLOCATE(tage(nrtm))
318C
319 DO k=1,nrtm
320C TAGE flag servant pour inacti
321 tage(k) = 0
322 IF(intercep(1,ni)%P(k)==proc+1)THEN
323 n1 = intbuf_tab(ni)%IRECTM(4*(k-1)+1)
324 n2 = intbuf_tab(ni)%IRECTM(4*(k-1)+2)
325 n3 = intbuf_tab(ni)%IRECTM(4*(k-1)+3)
326 n4 = intbuf_tab(ni)%IRECTM(4*(k-1)+4)
327 IF(ity == 8) THEN
328 !conversion from main surface number
329 ! to global number
330 n1 = intbuf_tab(ni)%MSR(n1)
331 n2 = intbuf_tab(ni)%MSR(n2)
332 n3 = intbuf_tab(ni)%MSR(n3)
333 n4 = intbuf_tab(ni)%MSR(n4)
334 ENDIF
335c IF(NI==1) THEN
336c WRITE(600+PROC,*) NI,K,INTERCEP(1,NI)%P(K),PROC+1
337c WRITE(600+PROC,*) N1,N2,N3,N4 ,NMN_L,NRTM_L
338c ENDIF
339 nrtm_l = nrtm_l + 1
340 tage(k) = nrtm_l
341 IF (tag(n1)==0) THEN
342 nmn_l = nmn_l + 1
343 tag(n1) = 1
344 ENDIF
345 IF (tag(n2)==0) THEN
346 nmn_l = nmn_l + 1
347 tag(n2) = 1
348 ENDIF
349 IF (tag(n3)==0) THEN
350 nmn_l = nmn_l + 1
351 tag(n3) = 1
352 ENDIF
353 IF (tag(n4)==0) THEN
354 nmn_l = nmn_l + 1
355 tag(n4) = 1
356 ENDIF
357 IF (flagremnode == 2) nremnode_l = nremnode_l +
358 . intbuf_tab(ni)%KREMNODE(k+1)-intbuf_tab(ni)%KREMNODE(k)
359 ENDIF
360 ENDDO
361C
362 DO k=1,nrtm
363 IF(intercep(1,ni)%P(k)==proc+1)THEN
364 n1 = intbuf_tab(ni)%IRECTM(4*(k-1)+1)
365 n2 = intbuf_tab(ni)%IRECTM(4*(k-1)+2)
366 n3 = intbuf_tab(ni)%IRECTM(4*(k-1)+3)
367 n4 = intbuf_tab(ni)%IRECTM(4*(k-1)+4)
368 IF(ity == 8) THEN
369 n1 = intbuf_tab(ni)%MSR(n1)
370 n2 = intbuf_tab(ni)%MSR(n2)
371 n3 = intbuf_tab(ni)%MSR(n3)
372 n4 = intbuf_tab(ni)%MSR(n4)
373 ENDIF
374 tag(n1) = 0
375 tag(n2) = 0
376 tag(n3) = 0
377 tag(n4) = 0
378 ENDIF
379 ENDDO
380C
381 nindex0 = 0
382 IF (multi_fvm%IS_USED .AND. inacti == 7) THEN
383C Interface type 18 for law151
384 DO k = 1, nsn0
385 n = intbuf_tab(ni)%NSV(k)
386 IF (cep(n) == proc .AND. tag(n) == 0) THEN
387 nsn_l = nsn_l + 1
388 tag(n) = 1
389 nindex0= nindex0 + 1
390 index0(nindex0) = n
391 IF (flagremnode == 2.AND.ity==25) THEN
392 l = intbuf_tab(ni)%KREMNOR(k+1)-intbuf_tab(ni)%KREMNOR(k)
393 nremnor_l = nremnor_l + l
394 ENDIF
395 ENDIF
396 ENDDO
397 ELSE
398 DO k=1,nsn0
399 n = intbuf_tab(ni)%NSV(k)
400 IF(tag(n)==0) THEN
401 IF(nodlocal(n)/=0.AND.nodlocal(n)<=numnod_l) THEN
402 nsn_l = nsn_l + 1
403 tag(n) = 1
404 nindex0= nindex0 + 1
405 index0(nindex0) = n
406 IF (flagremnode == 2.AND.ity==25) THEN
407 l = intbuf_tab(ni)%KREMNOR(k+1)-intbuf_tab(ni)%KREMNOR(k)
408 nremnor_l = nremnor_l + l
409 ENDIF
410 ENDIF
411 ENDIF
412 END DO
413 DO k=nsn0+1,nsn0 + nsn_ige ! specifique aux surfaces IGEO
414 n = intbuf_tab(ni)%NSV(k)
415 IF(tag(n)==0) THEN
416 nsn_l = nsn_l + 1
417 tag(n) = 1
418 nindex0= nindex0 + 1
419 index0(nindex0) = n
420 ENDIF
421 END DO
422 ENDIF
423
424#include "vectorize.inc"
425 DO k=1,nindex0
426 tag(index0(k)) = 0
427 ENDDO
428 nindex0= 0
429C
430C candidats initiaux pour inacti=5 ou restart type 10
431 ii_stok = intbuf_tab(ni)%I_STOK(1)
432 ii_stok_l = 0
433 IF(ity==23.OR.
434 * inacti==5.OR.inacti==6.OR.inacti==7.OR.ifq/=0.OR.
435 * (ity==24.AND.inacti==-1).OR.
436 * (ity==25.AND.(inacti==-1.OR.inacti==5))) THEN
437C traitement pour eviter bug si ts les noeuds secnd stfn == zero
438 iok=0
439 DO k = 1, ii_stok
440 n = intbuf_tab(ni)%CAND_N(k)
441 IF(intbuf_tab(ni)%STFNS(n)/=zero)iok=1
442 ENDDO
443 IF(iok==0)THEN
444 intbuf_tab(ni)%I_STOK(1)=0
445 ii_stok = 0
446 END IF
447 ii_stok_l = 0
448 DO k = 1, ii_stok
449 e = intbuf_tab(ni)%CAND_E(k)
450 IF (tage(e)/=0) THEN
451 n = intbuf_tab(ni)%CAND_N(k)
452 ii_stok_l = ii_stok_l + 1
453 ENDIF
454 ENDDO
455C
456C Reperage des candidats se trouvant sur des procs distants
457C
458
459 nsnr = 0
460 nindex0 = 0
461 IF (multi_fvm%IS_USED .AND. inacti == 7) THEN
462C Interface type 18 for law151
463 DO k = 1, ii_stok
464 e = intbuf_tab(ni)%CAND_E(k)
465 IF (tage(e)/=0) THEN
466 n = intbuf_tab(ni)%CAND_N(k)
467 IF(tag(n)==0) THEN
468 tag(n) = 1
469 nindex0= nindex0 + 1
470 index0(nindex0) = n
471 IF(intbuf_tab(ni)%NSV(n)<=numels)THEN
472 IF(cep(intbuf_tab(ni)%NSV(n)) /= proc) THEN
473 nsnr = nsnr + 1
474 END IF
475 ELSE
476 nn = intbuf_tab(ni)%NSV(n)-numels
477 se1 = intbuf_tab(ni)%IS2SE(2*(nn-1)+1)
478 IF(intercep(2,ni)%P(se1)/=(proc+1))THEN
479 nsnr = nsnr + 1
480 ENDIF
481 END IF !(INTBUF_TAB(NI)%NSV(N)<=NUMNOD)THEN
482 END IF
483 ENDIF
484 ENDDO
485 ELSE
486 DO k = 1, ii_stok
487 e = intbuf_tab(ni)%CAND_E(k)
488 IF (tage(e)/=0) THEN
489 n = intbuf_tab(ni)%CAND_N(k)
490 IF(tag(n)==0) THEN
491 tag(n) = 1
492 nindex0= nindex0 + 1
493 index0(nindex0) = n
494 IF(intbuf_tab(ni)%NSV(n)<=numnod)THEN
495 my_node = intbuf_tab(ni)%NSV(n)
496 IF( nodlocal(my_node)==0.OR.nodlocal(my_node)>numnod_l ) THEN
497 nsnr = nsnr + 1
498 END IF
499 ELSE
500 nn = intbuf_tab(ni)%NSV(n)-numnod
501 se1 = intbuf_tab(ni)%IS2SE(2*(nn-1)+1)
502 IF(intercep(2,ni)%P(se1)/=(proc+1))THEN
503 nsnr = nsnr + 1
504 ENDIF
505 END IF !(INTBUF_TAB(NI)%NSV(N)<=NUMNOD)THEN
506 END IF
507 ENDIF
508 ENDDO
509 ENDIF
510#include "vectorize.inc"
511 DO k=1,nindex0
512 tag(index0(k)) = 0
513 ENDDO
514 nindex0= 0
515
516 ENDIF
517C
518 IF(nisub>0) THEN
519 nisubs_l = 0
520 IF (multi_fvm%IS_USED .AND. inacti == 7) THEN
521C Interface type 18 for law151
522 DO k=1,nsn_fe
523 n = intbuf_tab(ni)%NSV(k)
524 IF (n >numels) cycle
525 IF(cep(n) == proc) THEN
526 nisubs_l = nisubs_l + intbuf_tab(ni)%ADDSUBS(1+k) -
527 . intbuf_tab(ni)%ADDSUBS(k)
528 END IF
529 END DO
530 ELSE
531 DO k=1,nsn_fe
532 n = intbuf_tab(ni)%NSV(k)
533 IF(n<=numnod)THEN
534 IF( nodlocal(n)/=0.AND.nodlocal(n)<=numnod_l ) THEN
535 nisubs_l = nisubs_l + intbuf_tab(ni)%ADDSUBS(1+k) -
536 . intbuf_tab(ni)%ADDSUBS(k)
537 END IF
538 ELSE
539 nn = n-numnod
540 se1 = intbuf_tab(ni)%IS2SE(2*(nn-1)+1)
541 IF(intercep(2,ni)%P(se1)==(proc+1))THEN
542 nisubs_l = nisubs_l + intbuf_tab(ni)%ADDSUBS(1+k) -
543 . intbuf_tab(ni)%ADDSUBS(k)
544 ENDIF
545 END IF !(INTBUF_TAB(NI)%NSV(N)<=NUMNOD)THEN
546 END DO
547 ENDIF
548C
549 nisubm_l = 0
550 DO k=1,nrtm_fe
551 IF (tage(k)/=0) THEN
552 nisubm_l = nisubm_l + intbuf_tab(ni)%ADDSUBM(1+k) -
553 . intbuf_tab(ni)%ADDSUBM(k)
554 END IF
555 END DO
556 END IF
557C
558 IF(nmn/=0) THEN
559C NCONT = NSN*NMN_L/NMN
560 rcont = nmn_l
561 rcont = rcont/nmn
562 ncont = nint(nsn0*rcont)
563 IF(nmn_l>0.AND.nsn>0) ncont = max(ncont,1)
564
565 IF(ncont > 0 .AND.ii_stok_l > multimp*ncont) THEN
566 DO WHILE(ii_stok_l>multimp*ncont)
567 multimp=multimp+4
568 ENDDO
569 ENDIF
570
571 ELSE
572 ncont = 0
573 ENDIF
574C
575 nsnt_l = nsnt_l + nsn_l
576 nmnt_l = nmnt_l + nmn_l
577 IF(ity==7.OR.ity==22.OR.ity==23)THEN
578 IF(inacti==7)THEN
579 nbi18_l = nbi18_l+1
580 nskyi18_l = nskyi18_l+nrtm_l
581 END IF
582 ELSEIF(ity==24)THEN
583C
584C----NLS1_L,NLS2_L, NLN_L will be calculated after MBINFLG in w_ipari
585C s a jour dans w_ipari
586c IPARI_L(35,NI) = NLN_L
587c IPARI_L(51,NI) = NLINS_L
588c IPARI_L(52,NI) = NLINM_L
589c IPARI_L(59,NI) = L24ADD_L
590
591c compute IPARI_L(42,NI) = NRTM_SH_L
592 nrtm_sh_l=0
593 DO k=1,nrtm
594 IF(intercep(1,ni)%P(k)==proc+1)THEN
595 mtyp = intbuf_tab(ni)%MSEGTYP24(k)
596 IF(mtyp<0) nrtm_sh_l=nrtm_sh_l+1
597 ENDIF
598 ENDDO
599 ipari_l(42,ni)= nrtm_sh_l
600
601C NLN_L NLINS_L NLINM_L (edge2edge) TBD!!
602
603c!!!!!!!!!!!!!!!!!! to be cleaned !!!!!!!!!!!!!!!!!
604 l24add_l = l24add
605 ipari_l(59,ni)= l24add_l
606c-----------everywhere for the moment
607 nrtse_l = 0
608 DO i=1,nrtse
609 IF (intercep(2,ni)%P(i)==proc+1) THEN
610 nrtse_l = nrtse_l +1
611 ENDIF
612 ENDDO
613
614 nsne_l = 0
615 DO i = 1,nsne
616 se1 = intbuf_tab(ni)%IS2SE(2*(i-1)+1)
617 IF (intercep(2,ni)%P(se1)==proc+1) THEN
618 nsne_l = nsne_l + 1
619 ENDIF
620 ENDDO
621 ipari_l(52,ni) = nrtse_l
622 ipari_l(55,ni) = nsne_l
623
624
625C
626 IF(intnitsche > 0) THEN
627 nrts_l = 0
628 DO k=1,nrts
629 IF(intercep(3,ni)%P(k)==proc+1)THEN
630 nrts_l = nrts_l + 1
631 ENDIF
632 ENDDO
633 ipari_l(3,ni) = nrts_l
634 ENDIF
635C
636
637C
638 ELSEIF(ity==25)THEN
639C
640C compute IPARI_L(42,NI) = NRTM_SH_L
641 nrtm_sh_l=0
642 DO k=1,nrtm
643 IF(intercep(1,ni)%P(k)==proc+1)THEN
644 mtyp = intbuf_tab(ni)%MSEGTYP24(k)
645 IF(mtyp<0) nrtm_sh_l=nrtm_sh_l+1
646 ENDIF
647 ENDDO
648 ipari_l(42,ni)= nrtm_sh_l
649
650 ALLOCATE(tag_sm(nadmsr))
651 tag_sm(1:nadmsr)=0
652 DO k=1,nrtm
653 IF(intercep(1,ni)%P(k)==proc+1)THEN
654 n1 = intbuf_tab(ni)%ADMSR(4*(k-1)+1)
655 n2 = intbuf_tab(ni)%ADMSR(4*(k-1)+2)
656 n3 = intbuf_tab(ni)%ADMSR(4*(k-1)+3)
657 n4 = intbuf_tab(ni)%ADMSR(4*(k-1)+4)
658 IF(tag_sm(n1)==0)THEN
659 nadmsr_l=nadmsr_l+1
660 tag_sm(n1)=nadmsr_l
661 END IF
662 IF(tag_sm(n2)==0)THEN
663 nadmsr_l=nadmsr_l+1
664 tag_sm(n2)=nadmsr_l
665 END IF
666 IF(tag_sm(n3)==0)THEN
667 nadmsr_l=nadmsr_l+1
668 tag_sm(n3)=nadmsr_l
669 END IF
670 IF(tag_sm(n4)==0)THEN
671 nadmsr_l=nadmsr_l+1
672 tag_sm(n4)=nadmsr_l
673 END IF
674 ENDIF
675 ENDDO
676
677 tag_sm(1:nadmsr)=0
678 DO n=1,nedge
679 is_local = .false.
680 k1=intbuf_tab(ni)%LEDGE(nledge*(n-1)+1)
681 k2=intbuf_tab(ni)%LEDGE(nledge*(n-1)+3)
682 IF(k1 /= 0) THEN
683 IF(intercep(1,ni)%P(k1)==proc+1) THEN
684 is_local = .true.
685 ENDIF
686 ENDIF
687 IF(k2 /= 0) THEN
688 IF(intercep(1,ni)%P(k2)==proc+1) THEN
689 is_local = .true.
690 ENDIF
691 ENDIF
692 IF(is_local) THEN
693 nedge_l=nedge_l+1
694 END IF
695 ENDDO
696 DEALLOCATE(tag_sm)
697
698C
699 nconte = 0
700 nisube_l = 0
701 IF(iedge/=0) THEN
702C
703C NCONT = NEDGE*NEDGE_L/NEDGE ! cf NCONT=NEDGE , cest a voir ...
704 rcont = nedge_l
705 rcont = rcont/nedge
706 nconte = nint(nedge*rcont)
707C
708 ii_stok_e = intbuf_tab(ni)%I_STOK_E(1)
709 ii_stok_el = 0
710 IF(nedge_l>0.AND.nedge>0) nconte = max(nconte,1)
711 DO k = 1, ii_stok_e
712 n = intbuf_tab(ni)%CANDM_E2E(k)
713 e = intbuf_tab(ni)%LEDGE(nledge*(n-1)+1)
714 IF (tage(e)/=0) THEN ! Candidate on the proc where 1st segment sharing the main edge, belongs
715 ii_stok_el = ii_stok_el + 1
716 ENDIF
717 ENDDO
718 IF(nconte > 0 .AND.ii_stok_el > multimpe*nconte) THEN
719 DO WHILE(ii_stok_el > multimpe*nconte)
720 multimpe=multimpe+4
721 ENDDO
722 ENDIF
723
724 ii_stok_e = intbuf_tab(ni)%I_STOK_E(2)
725 ii_stok_el = 0
726 DO k = 1, ii_stok_e
727 e = intbuf_tab(ni)%CANDM_E2S(k)
728 IF (tage(e)/=0) THEN ! Candidate on the proc where 1st segment sharing the main edge, belongs
729 ii_stok_el = ii_stok_el + 1
730 ENDIF
731 ENDDO
732 IF(nconte > 0 .AND.ii_stok_el > multimps*nconte) THEN
733 DO WHILE(ii_stok_el > multimps*nconte)
734 multimps=multimps+4
735 ENDDO
736 ENDIF
737C
738 IF(nisub/=0)THEN
739 DO k=1,nedge
740 e = intbuf_tab(ni)%LEDGE(nledge*(k-1)+1)
741 IF (tage(e)/=0) THEN
742 nisube_l = nisube_l + intbuf_tab(ni)%ADDSUBE(1+k) -
743 . intbuf_tab(ni)%ADDSUBE(k)
744 END IF
745 END DO
746 END IF
747
748
749C-- Iremgap/IremI2 - computation of NREMNODE_EDG_L /NREMNODE_E2S_L-
750
751 IF (flagremnode == 2) THEN
752 ! NREMNODE_EDG_L
753 DO k=1,nedge
754 em1 = intbuf_tab(ni)%LEDGE(nledge*(k-1)+1)
755 km1 = 0
756 IF(em1/=0) km1=tage(em1)
757 em2 = intbuf_tab(ni)%LEDGE(nledge*(k-1)+3)
758 km2 = 0
759 IF(em2/=0) km2=tage(em2)
760 IF (km1/=0.OR.km2/=0) THEN
761 siz = intbuf_tab(ni)%KREMNODE_EDG(k+1)-intbuf_tab(ni)%KREMNODE_EDG(k)
762 ik = intbuf_tab(ni)%KREMNODE_EDG(k)
763 DO m=1,siz
764 n = intbuf_tab(ni)%REMNODE_EDG(ik+m-1)
765 es1 = intbuf_tab(ni)%LEDGE(nledge*(n-1)+1)
766 ks1 = 0
767 IF(es1/=0) ks1=tage(es1)
768 es2 = intbuf_tab(ni)%LEDGE(nledge*(n-1)+3)
769 ks2 = 0
770 IF(es2/=0) ks2=tage(es2)
771 IF(km1/=0.AND.km2/=0.AND.ks1/=0.AND.ks2/=0)THEN
772C-- Local segment - local id is stored
773 nremnode_edg_l = nremnode_edg_l + 1
774 ELSE
775C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
776 nremnode_edg_l = nremnode_edg_l + 2
777 ENDIF
778 END DO
779 ENDIF
780 ENDDO
781 ! NREMNODE_E2S_L
782 DO k=1,nrtm
783 IF(tage(k) > 0) THEN
784 siz = intbuf_tab(ni)%KREMNODE_E2S(k+1)-intbuf_tab(ni)%KREMNODE_E2S(k)
785 ik = intbuf_tab(ni)%KREMNODE_E2S(k)
786 DO m=1,siz
787 n = intbuf_tab(ni)%REMNODE_E2S(ik+m-1)
788 e = intbuf_tab(ni)%LEDGE(nledge*(n-1)+1)
789 IF (tage(e)/=0) THEN ! Candidate on the proc where 1st segment sharing the master edge, belongs
790C-- Local segment - local id is stored
791 nremnode_e2s_l = nremnode_e2s_l + 1
792 ELSE
793C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
794 nremnode_e2s_l = nremnode_e2s_l + 2
795 ENDIF
796 ENDDO
797 ENDIF
798 ENDDO
799 ENDIF
800C
801
802 ENDIF
803 ipari_l(88,ni)= nconte
804 ipari_l(87,ni)= multimpe
805 ipari_l(89,ni)= multimps
806 ipari_l(90,ni)= nisube_l
807 ipari_l(94,ni)= nremnode_edg_l
808 ipari_l(96,ni)= nremnode_e2s_l
809
810
811 END IF ! ELSEIF(ITY==25)THEN
812C
813 DEALLOCATE(tage)
814C
815 nsn_l = nsn_l + nsne_l
816
817 nmt_l = 0
818 IF (ity==8) THEN
819 DO k = 1,nmt
820 jj = intbuf_tab(ni)%LMSR(k)
821 IF(intercep(1,ni)%P(jj) == proc+1) THEN
822 nmt_l = nmt_l + 1
823 ENDIF
824 ENDDO
825 ENDIF
826C
827 imaximp_l = imaximp_l + multimp*ncont + multimpe*nconte + multimps*nconte
828C -------------------------------
829C IPARI_L Interface type 7, 8,10, 22, 23, 24, 25
830C -------------------------------
831 !for auto-impactant interfaces (secnd nodes=main surface nodes)
832 !IRECTS is used in lecins but no need in engine, set to 0
833 !to save memory consumption at engine
834 IF(intnitsche == 0) ipari_l(3,ni) = 0
835 ipari_l(4,ni) = nrtm_l ! TOTAL
836
837 IF(ity==25.AND.ipari(100,ni) > 0) THEN
838 ipari_l(74,ni) = nrtm ! NRTM Global
839
840 ELSE
841 ipari_l(74,ni) = nrtm_l ! FE
842 ENDIF
843 ipari_l(5,ni) = nsn_l ! TOTAL
844 ipari_l(78,ni) = nsn_l ! FE
845 ipari_l(6,ni) = nmn_l ! TOTAL
846 ipari_l(80,ni) = nmn_l ! FE
847 ipari_l(9,ni) = nmt_l
848 ipari_l(18,ni)= ncont
849 ipari_l(23,ni)= multimp
850
851 ipari_l(24,ni)= 0
852
853 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.ity==23)
854 . ipari_l(24,ni)= nsnr
855
856 IF(inacti==-1.AND.ity==24) ipari_l(24,ni)= nsnr
857 IF((inacti==-1.OR.inacti==5).AND.ity==25) ipari_l(24,ni)= nsnr
858
859 ipari_l(25,ni)= 0
860
861 IF(nisub>0) THEN
862 ipari_l(37,ni)= nisubs_l
863 ipari_l(38,ni)= nisubm_l
864 END IF
865
866 IF(icurv==1)THEN
867 ipari_l(40,ni)=nodlocal(ipari(40,ni))
868 ELSEIF(icurv==2)THEN
869 ipari_l(40,ni)=nodlocal(ipari(40,ni))
870 ipari_l(41,ni)=nodlocal(ipari(41,ni))
871 END IF
872 ipari_l(62,ni)=nremnode_l
873 ipari_l(81,ni)=nremnor_l
874
875 ipari_l(67,ni)=nadmsr_l
876 numnor_l = numnor_l + nadmsr_l
877
878 ipari_l(68,ni)=nedge_l
879c INT 22
880 IF(ity==22)THEN
881 isu1 = ipari_l(45,ni)
882 nbric = igrbric(isu1)%NENTITY ! global value ; update IGRN which does not exist here
883 nbric_l = 0
884 DO k = 1, nbric
885 ie = igrbric(isu1)%ENTITY(k)
886 IF(cep(ie)==proc) nbric_l = nbric_l + 1
887 !balayer le grbric, si bric \in spmd_id then nbric ++
888 !CEP contient les Brique en premiere section
889 !CEP : id_elem |-> spmd_id ; id_elem \in (|---brique---|---coque---|---...)
890 END DO
891 i22len1 = max(100 ,nint(82*nbric_l**half))
892 i22len1 = min(i22len1 ,nbric_l )
893 i22len1 = nint(jmult22*i22len1)
894 i22len_l = max(i22len_l,i22len1) !local value to determine : (ARGUMENT INTENT(INOUT))
895 ENDIF
896
897C Fin cas interfaces type 7,8, 10 ,22 ,23 ,24, 25
898C
899 ELSEIF (ity==11) THEN
900! *********************************
901C
902C
903 nrts = ipari(3,ni)
904 nrtm = ipari(4,ni)
905 nsn = ipari(5,ni)
906 nmn = ipari(6,ni)
907 igap = ipari(21,ni)
908 inacti = ipari(22,ni)
909 multimp= ipari(23,ni)
910 iform = ipari(30,ni)
911 nisub = ipari(36,ni)
912 flagremnode = ipari(63,ni)
913C
914 nrtm_l = 0
915 nrts_l = 0
916 nmn_l = 0
917 nsn_l = 0
918 nremnode_l = 0
919C
920 DO k=1,nrts
921 IF(intercep(2,ni)%P(k)==proc+1)THEN
922 nrts_l = nrts_l + 1
923 ENDIF
924 ENDDO
925C
926 ALLOCATE(tage(nrtm))
927C
928 DO k=1,nrtm
929C TAGE flag servant pour inacti
930 tage(k) = 0
931 IF(intercep(1,ni)%P(k)==proc+1)THEN
932 n1 = intbuf_tab(ni)%IRECTM(1+2*(k-1))
933 n2 = intbuf_tab(ni)%IRECTM(2+2*(k-1))
934 nrtm_l = nrtm_l + 1
935 tage(k) = nrtm_l
936 IF (tag(n1)==0) THEN
937 nmn_l = nmn_l + 1
938 tag(n1) = 1
939 ENDIF
940 IF (tag(n2)==0) THEN
941 nmn_l = nmn_l + 1
942 tag(n2) = 1
943 ENDIF
944 ENDIF
945 ENDDO
946C
947 DO k=1,nrtm
948 IF(intercep(1,ni)%P(k)==proc+1)THEN
949 n1 = intbuf_tab(ni)%IRECTM(1+2*(k-1))
950 n2 = intbuf_tab(ni)%IRECTM(2+2*(k-1))
951 tag(n1) = 0
952 tag(n2) = 0
953 ENDIF
954 ENDDO
955C
956C-- Iremp - computation of NREMNODE_L -
957 IF (flagremnode == 2) THEN
958 DO k=1,nrtm
959 IF(intercep(1,ni)%P(k)==proc+1)THEN
960 siz = intbuf_tab(ni)%KREMNODE(k+1)-intbuf_tab(ni)%KREMNODE(k)
961 e = intbuf_tab(ni)%KREMNODE(k)
962 DO m=1,siz
963 n = intbuf_tab(ni)%REMNODE(e+m-1)
964 IF(intercep(2,ni)%P(n)==proc+1)THEN
965C-- Local segment - local id is stored
966 nremnode_l = nremnode_l + 1
967 ELSE
968C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
969 nremnode_l = nremnode_l + 2
970 ENDIF
971 END DO
972 ENDIF
973 ENDDO
974 ENDIF
975C
976 nindex0 = 0
977 DO k=1,nsn
978 n = intbuf_tab(ni)%NSV(k)
979 IF(tag(n)==0) THEN
980 IF(nodlocal(n)/=0.AND.nodlocal(n)<=numnod_l) THEN
981 nsn_l = nsn_l + 1
982 tag(n) = 1
983 nindex0= nindex0 + 1
984 index0(nindex0) = n
985 ENDIF
986 ENDIF
987 ENDDO
988
989#include "vectorize.inc"
990 DO k=1,nindex0
991 tag(index0(k)) = 0
992 ENDDO
993C
994C candidats initiaux pour inacti=5
995 i_stok_l = 0
996 i_stok = intbuf_tab(ni)%I_STOK(1)
997 IF (inacti==5.OR.inacti==6.OR.inacti==7) THEN
998 DO k = 1, i_stok
999 e = intbuf_tab(ni)%CAND_E(k)
1000 IF (tage(e)/=0) THEN
1001 n = intbuf_tab(ni)%CAND_N(k)
1002 i_stok_l = i_stok_l + 1
1003 ENDIF
1004 ENDDO
1005 ENDIF
1006C
1007 IF(nisub>0) THEN
1008 nisubs_l = 0
1009 DO k=1,nrts
1010 IF (tage(k)/=0) THEN
1011 nisubs_l = nisubs_l + intbuf_tab(ni)%ADDSUBS(1+k) -
1012 . intbuf_tab(ni)%ADDSUBS(k)
1013 END IF
1014 END DO
1015C
1016 nisubm_l = 0
1017 DO k=1,nrtm
1018 IF (tage(k)/=0) THEN
1019 nisubm_l = nisubm_l + intbuf_tab(ni)%ADDSUBM(1+k) -
1020 . intbuf_tab(ni)%ADDSUBM(k)
1021 END IF
1022 END DO
1023 END IF
1024C
1025 DEALLOCATE(tage)
1026
1027 IF(nmn/=0) THEN
1028 rcont = nmn_l
1029 rcont = rcont/nmn
1030 ncont = nint(nsn*rcont)
1031 IF(nmn_l>0.AND.nsn>0) ncont = max(ncont,1)
1032
1033 IF(ncont > 0 .AND.i_stok_l > multimp*ncont) THEN
1034 DO WHILE(i_stok_l>multimp*ncont)
1035 multimp=multimp+4
1036 ENDDO
1037 ENDIF
1038
1039 ELSE
1040 ncont = 0
1041 ENDIF
1042C
1043 nsnt_l = nsnt_l + nsn_l
1044 nmnt_l = nmnt_l + nmn_l
1045
1046 imaximp_l = imaximp_l + multimp*ncont
1047C--------------------------
1048C IPARI_L TYPE 11
1049C--------------------------
1050 ipari_l(3,ni) = nrts_l
1051 ipari_l(4,ni) = nrtm_l
1052 ipari_l(5,ni) = nsn_l
1053 ipari_l(6,ni) = nmn_l
1054 ipari_l(18,ni)= ncont
1055 ipari_l(23,ni)= multimp
1056 ipari_l(24,ni) = 0
1057 ipari_l(30,ni)= iform
1058 ipari_l(62,ni)= nremnode_l
1059
1060C Fin cas interface type 11
1061
1062 ELSEIF (ity==9) THEN
1063! *********************************
1064C
1065 nmn = ipari(6,ni)
1066 imaximp_l = imaximp_l + 2*nint(nmn/probint)
1067C
1068 ELSEIF (ity==17) THEN
1069! *********************************
1070C
1071 nmn = ipari(4,ni)
1072 nsn = ipari(5,ni)
1073 multimp = ipari(23,ni)
1074 ign = ipari(36,ni)
1075 ige = ipari(34,ni)
1076C cote main
1077 nmn_l = 0
1078 DO k = 1, nmn
1079 ie = igrbric(ige)%ENTITY(k)
1080C pas d'offset car solide
1081 IF(cep(ie)==proc) nmn_l = nmn_l + 1
1082 END DO
1083C cote secnd
1084 nsn_l = 0
1085 DO k = 1, nsn
1086 ie = igrbric(ign)%ENTITY(k)
1087C pas d'offset car solide
1088 IF(cep(ie)==proc) nsn_l = nsn_l + 1
1089 END DO
1090 IF(nmn/=0) THEN
1091 rcont = nmn_l
1092 rcont = rcont/nmn
1093 ncont = nint(nsn*rcont)
1094 IF(nmn_l>0.AND.nsn>0) ncont = max(ncont,1)
1095 ELSE
1096 ncont = 0
1097 ENDIF
1098C
1099 imaximp_l = imaximp_l + (multimp*ncont*16)/5 + 1
1100C
1101cc IPARI_L(4,NI) = NMN_L
1102cc IPARI_L(5,NI) = NSN_L
1103 ipari_l(18,ni) = ncont
1104C
1105C Fin cas interface type17
1106C
1107 ELSEIF(ity==20) THEN
1108! *********************************
1109 nrts = ipari(3,ni)
1110 nrtm = ipari(4,ni)
1111 nsn = ipari(5,ni)
1112 nmn = ipari(6,ni)
1113 igap = ipari(21,ni)
1114 inacti = ipari(22,ni)
1115 multimp= ipari(23,ni)
1116 iform = ipari(30,ni)
1117 ifq = ipari(31,ni)
1118 nln = ipari(35,ni)
1119 nisub = ipari(36,ni)
1120 nisubs = ipari(37,ni)
1121 nisubm = ipari(38,ni)
1122 icurv = ipari(39,ni)
1123C
1124 intth = ipari(47,ni)
1125C
1126 nlins = ipari(51,ni)
1127 nlinm = ipari(52,ni)
1128 nlinsa = ipari(53,ni)
1129 nlinma = ipari(54,ni)
1130 nsne = ipari(55,ni)
1131 nmne = ipari(56,ni)
1132C
1133C
1134 nrtm_l = 0
1135 nmn_l = 0
1136 nsn_l = 0
1137 nln_l = 0
1138C
1139 DO i=1,numnod
1140 tagg(i) = 0
1141 END DO
1142C
1143 ALLOCATE(tage(nrtm))
1144
1145 DO k=1,nrtm
1146 tage(k) = 0
1147 IF(intercep(1,ni)%P(k)==proc+1) THEN
1148 n1l = intbuf_tab(ni)%IRECTM(4*(k-1)+1)
1149 n2l = intbuf_tab(ni)%IRECTM(4*(k-1)+2)
1150 n3l = intbuf_tab(ni)%IRECTM(4*(k-1)+3)
1151 n4l = intbuf_tab(ni)%IRECTM(4*(k-1)+4)
1152 n1 = intbuf_tab(ni)%NLG(n1l)
1153 n2 = intbuf_tab(ni)%NLG(n2l)
1154 n3 = intbuf_tab(ni)%NLG(n3l)
1155 n4 = intbuf_tab(ni)%NLG(n4l)
1156 nrtm_l = nrtm_l + 1
1157 tage(k) = nrtm_l
1158 IF (tagg(n1)==0) THEN
1159 nmn_l = nmn_l + 1
1160 nln_l = nln_l + 1
1161 tagg(n1) = 1
1162 ENDIF
1163 IF (tagg(n2)==0) THEN
1164 nmn_l = nmn_l + 1
1165 nln_l = nln_l + 1
1166 tagg(n2) = 1
1167 ENDIF
1168 IF (tagg(n3)==0) THEN
1169 nmn_l = nmn_l + 1
1170 nln_l = nln_l + 1
1171 tagg(n3) = 1
1172 ENDIF
1173 IF (tagg(n4)==0) THEN
1174 nmn_l = nmn_l + 1
1175 nln_l = nln_l + 1
1176 tagg(n4) = 1
1177 ENDIF
1178 ENDIF
1179 ENDDO
1180C
1181C
1182 nindex0 = 0
1183 DO k=1,nsn
1184 nl = intbuf_tab(ni)%NSV(k)
1185 n = intbuf_tab(ni)%NLG(nl)
1186 IF(tag(n)==0) THEN
1187 IF( nodlocal(n)/=0.AND.nodlocal(n)<=numnod_l ) THEN
1188 nsn_l = nsn_l + 1
1189 tag(n) = 1
1190 nindex0= nindex0 + 1
1191 index0(nindex0) = n
1192 IF(tagg(n)==0)THEN
1193 nln_l = nln_l + 1
1194 tagg(n) = 1
1195 END IF
1196 ENDIF
1197 ENDIF
1198 END DO
1199C
1200C candidats initiaux pour inacti=5 ou restart type 10
1201 i_stok_l = 0
1202 i_stok = intbuf_tab(ni)%I_STOK(1)
1203 IF(inacti==5.OR.inacti==6.OR.inacti==7) THEN
1204 DO k = 1, i_stok
1205 e = intbuf_tab(ni)%CAND_E(k)
1206 IF (tage(e)/=0) THEN
1207 n = intbuf_tab(ni)%CAND_N(k)
1208 i_stok_l = i_stok_l + 1
1209 ENDIF
1210 ENDDO
1211 ENDIF
1212C
1213 IF(nisub>0) THEN
1214 nisubs_l = 0
1215 DO k=1,nsn
1216 nl = intbuf_tab(ni)%NSV(k)
1217 n = intbuf_tab(ni)%NLG(nl)
1218 IF(nodlocal(n)/=0.AND.nodlocal(n)<=numnod_l) THEN
1219 nisubs_l = nisubs_l + intbuf_tab(ni)%ADDSUBS(k+1) -intbuf_tab(ni)%ADDSUBS(k)
1220 END IF
1221 END DO
1222C
1223 nisubm_l = 0
1224 DO k=1,nrtm
1225 IF (tage(k)/=0) THEN
1226 nisubs_l = nisubs_l + intbuf_tab(ni)%ADDSUBM(k+1) -intbuf_tab(ni)%ADDSUBM(k)
1227 END IF
1228 END DO
1229 END IF
1230C
1231 DEALLOCATE(tage)
1232C
1233c IF(NMN/=0) THEN
1234C NCONT = NSN*NMN_L/NMN
1235c RCONT = NMN_L
1236c RCONT = RCONT/NMN
1237c NCONT = NINT(NSN*RCONT)
1238c IF(NMN_L>0.AND.NSN>0) NCONT = MAX(NCONT,1)
1239c ELSE
1240c NCONT = 0
1241c ENDIF
1242C
1243C Partie ligne
1244C
1245 nlins_l = 0
1246 nlinm_l = 0
1247 nmne_l = 0
1248 nsne_l = 0
1249C
1250#include "vectorize.inc"
1251 DO k=1,nindex0
1252 tag(index0(k)) = 0
1253 ENDDO
1254 nindex0 = 0
1255C
1256 nlinsa_l= 0
1257 DO k=1,nlins
1258 n1l = intbuf_tab(ni)%IXLINS(2*(k-1)+1)
1259 n2l = intbuf_tab(ni)%IXLINS(2*(k-1)+2)
1260 n1 = intbuf_tab(ni)%NLG(n1l)
1261 n2 = intbuf_tab(ni)%NLG(n2l)
1262 IF(intercep(3,ni)%P(k)==proc+1) THEN
1263 nlins_l = nlins_l + 1
1264C comptage ligne active
1265 IF(k<=nlinsa)nlinsa_l = nlinsa_l + 1
1266 IF (tag(n1)==0) THEN
1267 nsne_l = nsne_l + 1
1268 tag(n1) = 1
1269 IF(tagg(n1)==0)THEN
1270 nln_l = nln_l + 1
1271 tagg(n1) = 1
1272 END IF
1273 ENDIF
1274 IF (tag(n2)==0) THEN
1275 nsne_l = nsne_l + 1
1276 tag(n2) = 1
1277 IF(tagg(n2)==0)THEN
1278 nln_l = nln_l + 1
1279 tagg(n2) = 1
1280 END IF
1281 ENDIF
1282 ENDIF
1283 ENDDO
1284C
1285 DO k=1,nlins
1286 IF(intercep(3,ni)%P(k)==proc+1) THEN
1287 n1l = intbuf_tab(ni)%IXLINS(2*(k-1)+1)
1288 n2l = intbuf_tab(ni)%IXLINS(2*(k-1)+2)
1289 n1 = intbuf_tab(ni)%NLG(n1l)
1290 n2 = intbuf_tab(ni)%NLG(n2l)
1291 tag(n1) = 0
1292 tag(n2) = 0
1293 ENDIF
1294 ENDDO
1295C
1296 ALLOCATE(tage2(nlinm))
1297C
1298 nlinma_l= 0
1299 nindex0 = 0
1300 DO k=1,nlinm
1301C TAGE flag servant pour inacti
1302 tage2(k) = 0
1303 n1l = intbuf_tab(ni)%IXLINM(2*(k-1)+1)
1304 n2l = intbuf_tab(ni)%IXLINM(2*(k-1)+2)
1305 n1 = intbuf_tab(ni)%NLG(n1l)
1306 n2 = intbuf_tab(ni)%NLG(n2l)
1307 IF(intercep(2,ni)%P(k)==proc+1) THEN
1308 nlinm_l = nlinm_l + 1
1309C comptage ligne active
1310 IF(k<=nlinma)nlinma_l = nlinma_l + 1
1311 tage2(k) = nlinm_l
1312 IF (tag(n1)==0) THEN
1313 nmne_l = nmne_l + 1
1314 tag(n1) = 1
1315 nindex0= nindex0 + 1
1316 index0(nindex0) = n1
1317 IF(tagg(n1)==0)THEN
1318 nln_l = nln_l + 1
1319 tagg(n1) = 1
1320 END IF
1321 ENDIF
1322 IF (tag(n2)==0) THEN
1323 nmne_l = nmne_l + 1
1324 tag(n2) = 1
1325 nindex0= nindex0 + 1
1326 index0(nindex0) = n2
1327 IF(tagg(n2)==0)THEN
1328 nln_l = nln_l + 1
1329 tagg(n2) = 1
1330 END IF
1331 ENDIF
1332 ENDIF
1333 ENDDO
1334#include "vectorize.inc"
1335 DO k=1,nindex0
1336 tag(index0(k)) = 0
1337 ENDDO
1338 nindex0 = 0
1339C
1340C
1341c DO I = 1, NLN
1342c N = INTBUF_TAB(NI)%NLG(I)
1343c IF(MOD(FRONT(N,PROC+1),10)==1) THEN
1344c NSNE_L = NSNE_L + 1
1345c END IF
1346c END DO
1347C
1348C candidats initiaux pour inacti=5 A REVOIR si besoin !!!
1349c I_STOK = INTBUF_TAB(NI)%i_STOK(1)
1350c IF (INACTI==5.OR.INACTI==6.OR.INACTI==7) THEN
1351c I_STOK_L = 0
1352c DO K = 1, I_STOK
1353c E = INTBUF_TAB(NI)%CAND_E(K)
1354c IF (TAGE(E)/=0) THEN
1355c N = INTBUF_TAB(NI)%CAND_N(K)
1356c I_STOK_L = I_STOK_L + 1
1357c ENDIF
1358c ENDDO
1359c ENDIF
1360C
1361 DEALLOCATE(tage2)
1362C
1363C Calcul de NCONT en prenant le max des edge et non edge
1364C
1365 ncont1 = 0
1366 IF(nmn/=0) THEN
1367C NCONT = NSN*NMN_L/NMN
1368 rcont = nmn_l
1369 rcont = rcont/nmn
1370 ncont = nint(nsn*rcont)
1371 IF(nmn_l>0.AND.nsn>0) ncont1 = max(ncont,1)
1372
1373 IF(ncont1 > 0 .AND.i_stok_l > multimp*ncont1) THEN
1374 DO WHILE(i_stok_l>multimp*ncont1)
1375 multimp=multimp+4
1376 ENDDO
1377 ENDIF
1378
1379 ENDIF
1380
1381 ncont2 = 0
1382 IF(nmne/=0) THEN
1383 rcont = nmne_l
1384 rcont = rcont/nmne
1385 ncont = nint(nsne*rcont)
1386 IF(nmne_l>0.AND.nsne>0) ncont2 = max(ncont,1)
1387
1388 IF(ncont2 > 0 .AND.i_stok_l > multimp*ncont2) THEN
1389 DO WHILE(i_stok_l>multimp*ncont2)
1390 multimp=multimp+4
1391 ENDDO
1392 ENDIF
1393 ENDIF
1394 ncont = max(ncont1,ncont2)
1395C
1396C
1397C
1398 nsnt_l = nsnt_l + nsn_l + nsne_l
1399 nmnt_l = nmnt_l + nmn_l + nmne_l
1400 imaximp_l = imaximp_l + multimp*ncont
1401C-----------------
1402C IPARI_L TYPE 20
1403C-----------------
1404 !for auto-impactant interfaces (secnd nodes=main surface nodes)
1405 !IRECTS is used in lecins but no need in engine, set to 0
1406 !to save memory consumption at engine
1407 ipari_l(3,ni) = 0
1408 ipari_l(4,ni) = nrtm_l
1409 ipari_l(5,ni) = nsn_l
1410 ipari_l(6,ni) = nmn_l
1411 ipari_l(18,ni) = ncont
1412 ipari_l(23,ni)= multimp
1413 ipari_l(24,ni) = 0
1414C s a jour dans w_ipari IF(INACTI==5.OR.INACTI==6.OR.INACTI==7)
1415C s a jour dans w_ipari . IPARI_L(24,NI)= NSNR
1416C s a jour dans w_ipari IPARI_L(25,NI) = 0
1417 ipari_l(35,ni) = nln_l
1418 ipari_l(51,ni) = nlins_l
1419 ipari_l(52,ni) = nlinm_l
1420C s a jour dans w_ipari IPARI_L(53,NI) = NLINSA_L
1421C s a jour dans w_ipari IPARI_L(54,NI) = NLINMA_L
1422 ipari_l(55,ni) = nsne_l
1423 ipari_l(56,ni) = nmne_l
1424C s a jour dans w_ipari IF(INACTI==5.OR.INACTI==6.OR.INACTI==7)
1425C s a jour dans w_ipari . IPARI_L(57,NI)= NLINSR
1426 IF(nisub>0) THEN
1427 ipari_l(37,ni)= nisubs_l
1428 ipari_l(38,ni)= nisubm_l
1429 END IF
1430
1431 IF(icurv==1)THEN
1432 ipari_l(40,ni)=nodlocal(ipari(40,ni))
1433 ELSEIF(icurv==2)THEN
1434 ipari_l(40,ni)=nodlocal(ipari(40,ni))
1435 ipari_l(41,ni)=nodlocal(ipari(41,ni))
1436 END IF
1437 ipari_l(53,ni) = nlinsa_l
1438 ipari_l(54,ni) = nlinma_l
1439 ipari_l(25,ni)= 0
1440
1441C Fin cas interfaces type 20
1442C
1443 ELSEIF(ity==21) THEN
1444! *********************************
1445C
1446C interface type21
1447C
1448 nrts = ipari(3,ni)
1449 nrtm = ipari(4,ni)
1450 nsn = ipari(5,ni)
1451 nmn = ipari(6,ni)
1452 igap = ipari(21,ni)
1453 inacti = ipari(22,ni)
1454 multimp= ipari(23,ni)
1455 iform = ipari(30,ni)
1456 ifq = ipari(31,ni)
1457C
1458 intth = ipari(47,ni)
1459C
1460 nrtm_l = nrtm
1461 nmn_l = 0
1462 nrts_l = 0
1463 nsn_l = 0
1464C
1465C
1466 nindex0 = 0
1467 DO k=1,nmn
1468 n =intbuf_tab(ni)%MSR(k)
1469 IF(tag(n)==0) THEN
1470 IF(nodlocal(n)/=0.AND.nodlocal(n)<=numnod_l) THEN
1471 nmn_l = nmn_l + 1
1472 tag(n) = 1
1473 nindex0= nindex0 + 1
1474 index0(nindex0) = n
1475 ENDIF
1476 ENDIF
1477 END DO
1478C
1479#include "vectorize.inc"
1480 DO i=1,nindex0
1481 n = index0(i)
1482 tag(n) = 0
1483 END DO
1484C
1485 nindex0 = 0
1486 DO k=1,nsn
1487 n = intbuf_tab(ni)%NSV(k)
1488 IF(tag(n)==0) THEN
1489 IF(nodlocal(n)/=0.AND.nodlocal(n)<=numnod_l) THEN
1490 nindex0 = nindex0 + 1
1491 index0(nindex0) = n
1492 nsn_l = nsn_l + 1
1493 tag(n) = 1
1494 ENDIF
1495 ENDIF
1496 END DO
1497#include "vectorize.inc"
1498 DO k=1,nindex0
1499 tag(index0(k)) = 0
1500 ENDDO
1501 nindex0 = 0
1502C
1503C Prepare MULTIMP in any case
1504 i_stok = intbuf_tab(ni)%I_STOK(1)
1505 i_stok_l = 0
1506 DO k = 1, i_stok
1507 m = intbuf_tab(ni)%CAND_N(k)
1508 n = intbuf_tab(ni)%NSV(k)
1509 IF(nodlocal(n)/=0.AND.nodlocal(n)<=numnod_l) THEN
1510 i_stok_l = i_stok_l + 1
1511 ENDIF
1512 ENDDO
1513C
1514 DO k=1,nrts
1515 IF(intercep(1,ni)%P(k)==proc+1) THEN
1516 nrts_l = nrts_l + 1
1517 END IF
1518 END DO
1519C
1520 ncont = nsn_l
1521C
1522 IF(ncont > 0 .AND.i_stok_l > multimp*ncont) THEN
1523 DO WHILE(i_stok_l>multimp*ncont)
1524 multimp=multimp+4
1525 ENDDO
1526 ENDIF
1527C
1528 ipari_l(3,ni) = nrts_l
1529 ipari_l(4,ni) = nrtm_l
1530 ipari_l(5,ni) = nsn_l
1531 ipari_l(6,ni) = nmn_l
1532 ipari_l(8,ni) = nmn
1533 ipari_l(18,ni)= ncont
1534 ipari_l(23,ni)= multimp
1535 ipari_l(24,ni)= 0
1536 ipari_l(25,ni)= 0
1537C
1538C
1539 nsnt_l = nsnt_l + nsn_l
1540 nmnt_l = nmnt_l + nmn_l
1541
1542C
1543 imaximp_l = imaximp_l + ncont
1544
1545C Fin cas interfaces type 21
1546C
1547 ENDIF
1548 ENDDO
1549C
1550 DEALLOCATE(tagi2)
1551 DEALLOCATE(tagg)
1552 RETURN
1553 END
ipari_l_ini
subroutine ipari_l_ini(ipari, proc, numnod_l, nbddi2m, i2nsn_l, probint, imaximp_l, nbi18_l, nskyi18_l, nsnt_l, nmnt_l, nsnt2_l, nmnt2_l, cep, igrbric, ipari_l, nodlocal, i2nsn25_l, intercep, intbuf_tab, numnor_l, i24maxnsne, multi_fvm, tag, index0, nindex0)
Definition ipari_l_ini.F:39
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
front_mod
Definition front_mod.F:84
groupdef_mod
Definition groupdef_mod.F:662
nl
character *2 function nl()
Definition message.F:2354
starter
program starter
Definition starter.F:39
front_mod::intersurfp
Definition front_mod.F:109