OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
domdec2.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!|| domdec2 ../starter/source/spmd/domdec2.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| c_doms10 ../starter/source/spmd/domdec2.F
30!|| check_skew ../starter/source/spmd/domain_decomposition/check_skew.F
31!|| domain_decomposition_pcyl ../starter/source/loads/general/load_pcyl/domain_decomposition_pcyl.F
32!|| frontplus_rm ../starter/source/spmd/node/frontplus.F
33!|| ifrontplus ../starter/source/spmd/node/frontplus.f
34!|| nlocal ../starter/source/spmd/node/ddtools.F
35!|| split_joint ../starter/source/constraints/general/cyl_joint/split_joint.F
36!||--- uses -----------------------------------------------------
37!|| front_mod ../starter/share/modules1/front_mod.F
38!|| message_mod ../starter/share/message_module/message_mod.F
39!|| monvol_struct_mod ../starter/share/modules1/monvol_struct_mod.f
40!|| submodel_mod ../starter/share/modules1/submodel_mod.F
41!||====================================================================
42 SUBROUTINE domdec2(
43 1 DD_IAD ,IPARI ,IB ,NPBY ,
44 2 LPBY ,IXRI ,IBVEL ,LBVEL ,
45 3 IPARG ,CEL ,IXS ,IXS10 ,IXS20 ,
46 4 IXS16 ,IXQ ,IXC ,IXT ,IXP ,
47 5 IXR ,IXTG ,IXTG6 ,T_MONVOL,
48 6 IGRSURF,ADSKY ,LCNE ,GEO ,
49 7 NPRW ,LPRW ,LCNI2 ,ADSKYI2,CEPI2,
50 8 CELI2 ,I2NSNT ,ISKN ,ISKWP,NSKWP ,
51 9 ISENSP ,NSENSP ,IACCP ,NACCP ,
52 A LACCELM,IBCV ,IRBE3 ,LRBE3 ,FRONT_RM,
53 B IRBYM ,LCRBYM ,CEP ,IBCR ,IRBE2 ,
54 C LRBE2 ,CEPSP ,CELSPH ,ILOADP,LLOADP,
55 D LGAUGE ,IGAUP ,NGAUP ,INTBUF_TAB,IBFFLUX,
56 E ICNDS10,ITAGND ,IGEO ,TAG_SKN,MULTIPLE_SKEW,
57 F IBFV ,IBCSCYC,LBCSCYC,R_SKEW,IPM ,
58 G SENSORS, LEN_CEP,EBCS_TAB,LOADS,IFRAME,
59 H NICONV ,NIRADIA ,NITFLUX,NUMCONV,NUMRADIA,NFXFLUX,
60 I SENSOR_USER_STRUCT)
61C
62C-----------------------------------------------
63C M o d u l e s
64C-----------------------------------------------
65 USE message_mod
66 USE front_mod
67 USE intbufdef_mod
68 USE groupdef_mod
69 USE skew_mod
70 USE monvol_struct_mod
71 USE sensor_mod
72 USE ale_ebcs_mod
73 USE ebcs_mod
74 USE loads_mod
75 USE submodel_mod , ONLY : nsubmod
76C-----------------------------------------------
77C I m p l i c i t T y p e s
78C-----------------------------------------------
79#include "implicit_f.inc"
80C-----------------------------------------------
81C C o m m o n B l o c k s
82C-----------------------------------------------
83#include "com01_c.inc"
84#include "com04_c.inc"
85#include "param_c.inc"
86#include "sphcom.inc"
87C-----------------------------------------------
88C D u m m y A r g u m e n t s
89C-----------------------------------------------
90 INTEGER ,INTENT(IN) :: NICONV
91 INTEGER ,INTENT(IN) :: NIRADIA
92 INTEGER ,INTENT(IN) :: NITFLUX
93 INTEGER ,INTENT(IN) :: NUMCONV
94 INTEGER ,INTENT(IN) :: NUMRADIA
95 INTEGER ,INTENT(IN) :: NFXFLUX
96 INTEGER IPARI(NPARI,NINTER),
97 . DD_IAD(NSPMD+1,NSPGROUP), NPRW(*), LPRW(*),
98 . NPBY(NNPBY,*), LPBY(*), IXRI(4,*),
99 . IBVEL(NBVELP,*), LBVEL(*), IPARG(NPARG,*), CEL(*),
100 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),IXTG(NIXTG,*),
101 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),
102 . IXS10(6,*),IXS20(12,*),IXS16(8,*),IXTG6(4,*),IB(NIBCLD,*),
103 . I2NSNT,ISKN(LISKN,*),ISKWP(*),NSKWP(*),
104 . ADSKY(0:*), LCNE, LCNI2, ADSKYI2(0:*),CEPI2(*),CELI2(*),
105 . ISENSP(2,*), NSENSP(*), IACCP(*), NACCP(*),
106 . LACCELM(3,*),IBCV(NICONV, *),IRBE3(NRBE3L,*), LRBE3(*),
107 . FRONT_RM(NRBYM,NSPMD), IRBYM(NIRBYM,*) ,LCRBYM(*), CEP(LEN_CEP),
108 . ibcr(niradia,*),irbe2(nrbe2l,*), lrbe2(*),
109 . cepsp(numsph), celsph(numsph),iloadp(sizloadp,*),lloadp(*),
110 . lgauge(3,*), igaup(*), ngaup(*), ibfflux(nitflux,*),
111 . icnds10(3,*),itagnd(*),ibfv(nifv,*),ibcscyc(4,*),lbcscyc(2,*),
112 . r_skew(*),ipm(npropmi,*),len_cep
113 INTEGER, DIMENSION(NPROPGI,*), INTENT(IN) :: IGEO
114 INTEGER, DIMENSION(NUMSKW+NSUBMOD+1), INTENT(INOUT) :: TAG_SKN
115 TYPE(PLIST_SKEW_), DIMENSION(NUMSKW+1), INTENT(INOUT) :: MULTIPLE_SKEW
116! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
117! TAG_SKN : integer ; dimension=NUMSKW+NSUBMOD+1
118! tag array --> tag the i SKEW if a SPRING uses it
119! tag array=0 --> the SKEW is not used by a SPRING
120! tag array=1 --> the skew is used by one spring
121! tag array>1 --> the SKEW is used by several SPRING
122! MULTIPLE_SKEW : SKEW_TYPE ; dimension=NUMSKW+1
123! MULTIPLE_SKEW(I)%PLIST(:) is a list of processor
124! where the SKEW is stuck
125! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
126 my_real :: geo(npropg,*)
127
128 TYPE(intbuf_struct_) INTBUF_TAB(*)
129 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
130 TYPE(MONVOL_STRUCT_), DIMENSION(NVOLU), INTENT(IN) :: T_MONVOL
131 TYPE(sensors_) ,INTENT(IN) :: SENSORS
132 TYPE(t_ebcs_tab), INTENT(INOUT) :: EBCS_TAB ! ebcs data structure
133 TYPE (LOADS_), INTENT(INOUT) :: LOADS ! load data structure
134 INTEGER ,DIMENSION(LISKN,NUMFRAM+1) ,INTENT(IN) :: IFRAME ! frame data structure
135 LOGICAL IS_EBCS_PARALLEL
136 TYPE(SENSOR_USER_STRUCT_) ,INTENT(INOUT) :: SENSOR_USER_STRUCT
137C-----------------------------------------------
138C E x t e r n a l F u n c t i o n s
139C-----------------------------------------------
140 INTEGER NLOCAL
141 EXTERNAL NLOCAL
142C-----------------------------------------------
143C L o c a l V a r i a b l e s
144C-----------------------------------------------
145 INTEGER IP,IPROC,IF1, IF2, TYP,
146 . insnmax, ipmax, sum, insnp, lastm,
147 . k, i, is, nn_s, iad, j, k1, k3, nn, nl,nl_l,
148 . nsn,nmn,p,n,n1,n2,n3,n4,nty,ngrou,nel,ng,l,m,nir,
149 . imain,kk,nrts,nrtm,pm,
150 . off, proc, nin, ity_old, ity, msr, nsl_l, nsl,
151 . iels(nspmd), p_sph, int2flag,int2frplus,
152 . ilev,cnt,offset,fingeo,iad1,iad2,numloadp,ite2frplus
153 INTEGER :: ISENS
154 my_real
155 . ect_ak,fr_ak
156 INTEGER :: IJK
157 INTEGER :: SURF_ID,NUMBER_NODE,NODE_ID
158 INTEGER :: NUMBER_PROC,NUMBER_SEGMENT
159C-----------------------------------------------------
160C S o u r c e L i n e s
161C-----------------------------------------------------
162 int2flag=0
163 cnt = 0
164 5000 CONTINUE
165c count flag, how many times we redo this task
166c CNT = CNT+1
167c print*,'Count:',CNT
168 int2frplus=0
169C-----------------------------------------------------
170
171 CALL domain_decomposition_pcyl(loads,iframe)
172 ! ------------------------
173 DO isens=1,sensors%NSENSOR
174 ! ------------------------
175 ! dist-surf sensor : for plane defined by 3 nodes,
176 ! add the 3 nodes and the reference node
177 ! on all spmd processors
178 IF (sensors%SENSOR_TAB(isens)%TYPE==15) THEN
179 ! -------------
180 ! reference node : %IPARAM(1)
181 n1 = sensors%SENSOR_TAB(isens)%IPARAM(1)
182 DO p=1,nspmd
183 CALL ifrontplus(n1,p)
184 ENDDO
185 ! -------------
186 IF(sensors%SENSOR_TAB(isens)%IPARAM(2)==0) THEN
187 ! plane nodes : %IPARAM(3:5)
188 DO i=1,3
189 n1 = sensors%SENSOR_TAB(isens)%IPARAM(3+i-1)
190 DO p=1,nspmd
191 CALL ifrontplus(n1,p)
192 ENDDO
193 ENDDO
194 ! -------------
195 ENDIF
196 ENDIF
197 ! ------------------------
198 ENDDO
199 ! ------------------------
200 ! check if a user sensor is used
201 IF(sensor_user_struct%IS_USED) THEN
202 ! ------------------------
203 ! add all the nodes on the NSPMD domains
204 IF(sensor_user_struct%POINTER_NODE>0) THEN
205 DO i=1,sensor_user_struct%NUMBER_NODE
206 n1 = sensor_user_struct%NODE_LIST(i)
207 DO p=1,nspmd
208 CALL ifrontplus(n1,p)
209 ENDDO
210 ENDDO
211 ENDIF
212 ! ------------------------
213 ENDIF
214 ! ------------------------
215 IF(numskw>0)THEN
216C skew global fixe
217 iskwp(1)=1
218 DO p = 1, nspmd
219 nskwp(p) = 0
220 END DO
221 IF(n2d==0 .AND. len_cep > 0)THEN
222 offset = numels + numelq + numelc + numelt + numelp
223! check if a SPRING is linked with a SKEW
224 CALL check_skew(ixr,igeo,iskn,cep,iskwp,nskwp,tag_skn,multiple_skew,
225 . r_skew,ipm,offset)
226
227
228 DO i=1,numskw
229 IF(tag_skn(i+1) > 0) cycle ! tag/=0 --> already done in CHECK_SKEW
230 n1=iskn(1,i+1)
231 n2=iskn(2,i+1)
232 n3=iskn(3,i+1)
233 insnmax = 0
234 imain = 1
235 IF(n1+n2+n3/=0) THEN
236 DO p = 1, nspmd
237 nn = nlocal(n1,p)+
238 + nlocal(n2,p)+
239 + nlocal(n3,p)
240 IF(nn>insnmax)THEN
241 insnmax=nn
242 imain=p
243 END IF
244 END DO
245 IF(insnmax/=3)THEN
246 CALL ifrontplus(n1,imain)
247 CALL ifrontplus(n2,imain)
248 CALL ifrontplus(n3,imain)
249 END IF
250 END IF
251 iskwp(i+1) = imain
252 nskwp(imain) = nskwp(imain)+1
253 END DO
254 ELSE
255 DO i=1,numskw
256 n1=iskn(1,i+1)
257 n2=iskn(2,i+1)
258 insnmax = 0
259 imain = 1
260 IF(n1+n2/=0) THEN
261 DO p = 1, nspmd
262 nn = nlocal(n1,p)+
263 . nlocal(n2,p)
264 IF(nn>insnmax)THEN
265 insnmax=nn
266 imain=p
267 END IF
268 END DO
269 IF(insnmax/=2)THEN
270 CALL ifrontplus(n1,imain)
271 CALL ifrontplus(n2,imain)
272 END IF
273 END IF
274 iskwp(i+1) = imain
275 nskwp(imain) = nskwp(imain)+1
276 END DO
277 END IF
278 END IF
279C-----------------------------------------------------
280C Traitement special rigid wall moving
281C-----------------------------------------------------
282 k = 0
283 DO n = 1, nrwall
284 n3 = 2*nrwall+n
285 nsl=nprw(n)
286 msr = nprw(n3)
287 IF(msr/=0) THEN
288 DO p = 1, nspmd
289 nsl_l = 0
290 DO kk = 1, nsl
291 nn = lprw(k+kk)
292 IF(nlocal(nn,p)==1)THEN
293 nsl_l = nsl_l + 1
294 ENDIF
295 ENDDO
296 IF(nsl_l>0) CALL ifrontplus(msr,p)
297 ENDDO
298 ENDIF
299 k = k + nsl
300 ENDDO
301C
302C-----------------------------------------------------
303C Traitement special pressure loads + forces concentrees
304C-----------------------------------------------------
305 DO n = 1, nconld
306 n1 = ib(1,n)
307 n2 = ib(2,n)
308 n3 = ib(3,n)
309 n4 = ib(4,n)
310 IF(n4/=-1.AND.n2d==0.AND.n4/=0)THEN
311 DO p = 1, nspmd
312 IF(nlocal(n1,p)==1.AND.
313 + nlocal(n2,p)==1.AND.
314 + nlocal(n3,p)==1.AND.
315 + nlocal(n4,p)==1)THEN
316 GOTO 9999
317 ENDIF
318 ENDDO
319 ENDIF
320 IF(n4/=-1.AND.n2d==0)THEN
321 DO p = 1, nspmd
322 IF(nlocal(n1,p)==1.AND.
323 + nlocal(n2,p)==1.AND.
324 + nlocal(n3,p)==1)THEN
325 IF(n4/=0) THEN
326 CALL ifrontplus(n4,p)
327 ENDIF
328 GOTO 9999
329 ENDIF
330 ENDDO
331 ENDIF
332 IF(n4/=-1)THEN
333 DO p = 1, nspmd
334 IF(nlocal(n1,p)==1.AND.
335 + nlocal(n2,p)==1)THEN
336 IF(n2d==0.AND.n4/=0) THEN
337 CALL ifrontplus(n4,p)
338 ENDIF
339 IF(n2d==0) THEN
340 CALL ifrontplus(n3,p)
341 ENDIF
342 GOTO 9999
343 ENDIF
344 ENDDO
345 ENDIF
346 DO p = 1, nspmd
347 IF(nlocal(n1,p)==1) THEN
348 IF(n2d==0.AND.n4/=0.AND.n4/=-1) THEN
349 CALL ifrontplus(n4,p)
350 ENDIF
351 IF(n2d==0.AND.n4/=-1) THEN
352 CALL ifrontplus(n3,p)
353 ENDIF
354 IF(n4/=-1) THEN
355 CALL ifrontplus(n2,p)
356 ENDIF
357 GOTO 9999
358 ENDIF
359 ENDDO
360 IF(n4/=0.AND.n4/=0.AND.n4/=-1) THEN
361 CALL ifrontplus(n4,1)
362 ENDIF
363 IF(n2d==0.AND.n4/=-1) THEN
364 CALL ifrontplus(n3,1)
365 ENDIF
366 IF(n4/=-1) THEN
367 CALL ifrontplus(n2,1)
368 ENDIF
369 CALL ifrontplus(n1,1)
370 9999 CONTINUE
371 ENDDO
372C-----------------------------------------------------
373C Traitement special flux conv for heat transfert
374C-----------------------------------------------------
375 DO n = 1, numconv
376 n1 = ibcv(1,n)
377 n2 = ibcv(2,n)
378 n3 = ibcv(3,n)
379 n4 = ibcv(4,n)
380 IF(n2d==0.AND.n4/=0)THEN
381 DO p = 1, nspmd
382 IF(nlocal(n1,p)==1.AND.
383 + nlocal(n2,p)==1.AND.
384 + nlocal(n3,p)==1.AND.
385 + nlocal(n4,p)==1)THEN
386 GOTO 9191
387 ENDIF
388 ENDDO
389 ENDIF
390 IF(n2d==0)THEN
391 DO p = 1, nspmd
392 IF(nlocal(n1,p)==1.AND.
393 + nlocal(n2,p)==1.AND.
394 + nlocal(n3,p)==1)THEN
395 IF(n4/=0) THEN
396 CALL ifrontplus(n4,p)
397 ENDIF
398 GOTO 9191
399 ENDIF
400 ENDDO
401 ENDIF
402 DO p = 1, nspmd
403 IF(nlocal(n1,p)==1.AND.
404 + nlocal(n2,p)==1)THEN
405 IF(n2d==0.AND.n4/=0) THEN
406 CALL ifrontplus(n4,p)
407 ENDIF
408 IF(n2d==0) THEN
409 CALL ifrontplus(n3,p)
410 ENDIF
411 GOTO 9191
412 ENDIF
413 ENDDO
414 DO p = 1, nspmd
415 IF(nlocal(n1,p)==1) THEN
416 IF(n2d==0.AND.n4/=0) THEN
417 CALL ifrontplus(n4,p)
418 ENDIF
419 IF(n2d==0) THEN
420 CALL ifrontplus(n3,p)
421 ENDIF
422 CALL ifrontplus(n2,p)
423 GOTO 9191
424 ENDIF
425 ENDDO
426 IF(n4/=0) THEN
427 CALL ifrontplus(n4,1)
428 ENDIF
429 IF(n2d==0) THEN
430 CALL ifrontplus(n3,1)
431 ENDIF
432 CALL ifrontplus(n2,1)
433 CALL ifrontplus(n1,1)
434 9191 CONTINUE
435 ENDDO
436C
437C-----------------------------------------------------
438C Traitement special radiative flux for heat transfert
439C-----------------------------------------------------
440 DO n = 1, numradia
441 n1 = ibcr(1,n)
442 n2 = ibcr(2,n)
443 n3 = ibcr(3,n)
444 n4 = ibcr(4,n)
445 IF(n2d==0.AND.n4/=0)THEN
446 DO p = 1, nspmd
447 IF(nlocal(n1,p)==1.AND.
448 + nlocal(n2,p)==1.AND.
449 + nlocal(n3,p)==1.AND.
450 + nlocal(n4,p)==1)THEN
451 GOTO 9192
452 ENDIF
453 ENDDO
454 ENDIF
455 IF(n2d==0)THEN
456 DO p = 1, nspmd
457 IF(nlocal(n1,p)==1.AND.
458 + nlocal(n2,p)==1.AND.
459 + nlocal(n3,p)==1)THEN
460 IF(n4/=0) THEN
461 CALL ifrontplus(n4,p)
462 ENDIF
463 GOTO 9192
464 ENDIF
465 ENDDO
466 ENDIF
467 DO p = 1, nspmd
468 IF(nlocal(n1,p)==1.AND.
469 + nlocal(n2,p)==1)THEN
470 IF(n2d==0.AND.n4/=0) THEN
471 CALL ifrontplus(n4,p)
472 ENDIF
473 IF(n2d==0) THEN
474 CALL ifrontplus(n3,p)
475 ENDIF
476 GOTO 9192
477 ENDIF
478 ENDDO
479 DO p = 1, nspmd
480 IF(nlocal(n1,p)==1) THEN
481 IF(n2d==0.AND.n4/=0) THEN
482 CALL ifrontplus(n4,p)
483 ENDIF
484 IF(n2d==0) THEN
485 CALL ifrontplus(n3,p)
486 ENDIF
487 CALL ifrontplus(n2,p)
488 GOTO 9192
489 ENDIF
490 ENDDO
491 IF(n4/=0) THEN
492 CALL ifrontplus(n4,1)
493 ENDIF
494 IF(n2d==0) THEN
495 CALL ifrontplus(n3,1)
496 ENDIF
497 CALL ifrontplus(n2,1)
498 CALL ifrontplus(n1,1)
499 9192 CONTINUE
500 ENDDO
501C---------------------------------------------------------
502C Traitement special imposed heat flux for heat transfert
503C---------------------------------------------------------
504 DO n = 1, nfxflux
505 IF(ibfflux(10,n) == 1) cycle
506 n1 = ibfflux(1,n)
507 n2 = ibfflux(2,n)
508 n3 = ibfflux(3,n)
509 n4 = ibfflux(4,n)
510 IF(n2d==0.AND.n4/=0)THEN
511 DO p = 1, nspmd
512 IF(nlocal(n1,p)==1.AND.
513 + nlocal(n2,p)==1.AND.
514 + nlocal(n3,p)==1.AND.
515 + nlocal(n4,p)==1) GOTO 9193
516 ENDDO
517 ENDIF
518 IF(n2d==0)THEN
519 DO p = 1, nspmd
520 IF(nlocal(n1,p)==1.AND.
521 + nlocal(n2,p)==1.AND.
522 + nlocal(n3,p)==1)THEN
523 IF(n4/=0) CALL ifrontplus(n4,p)
524 GOTO 9193
525 ENDIF
526 ENDDO
527 ENDIF
528 DO p = 1, nspmd
529 IF(nlocal(n1,p)==1.AND.nlocal(n2,p)==1)THEN
530 IF(n2d==0.AND.n4/=0) CALL ifrontplus(n4,p)
531 IF(n2d==0) CALL ifrontplus(n3,p)
532 GOTO 9193
533 ENDIF
534 ENDDO
535 DO p = 1, nspmd
536 IF(nlocal(n1,p)==1) THEN
537 IF(n2d==0.AND.n4/=0) CALL ifrontplus(n4,p)
538 IF(n2d==0) CALL ifrontplus(n3,p)
539 CALL ifrontplus(n2,p)
540 GOTO 9193
541 ENDIF
542 ENDDO
543 IF(n4/=0) CALL ifrontplus(n4,1)
544 IF(n2d==0) CALL ifrontplus(n3,1)
545 CALL ifrontplus(n2,1)
546 CALL ifrontplus(n1,1)
547 9193 CONTINUE
548 ENDDO
549C-----------------------------------------------------
550C Traitement special load/Pfluid
551C-----------------------------------------------------
552 DO n = 1, nloadp
553 DO i = 1,iloadp(1,n)/4
554 n1=lloadp(iloadp(4,n)+4*(i-1))
555 n2=lloadp(iloadp(4,n)+4*(i-1)+1)
556 n3=lloadp(iloadp(4,n)+4*(i-1)+2)
557 n4=lloadp(iloadp(4,n)+4*(i-1)+3)
558 IF(n4/=-1.AND.n2d==0.AND.n4/=0)THEN
559 DO p = 1, nspmd
560 IF(nlocal(n1,p)==1.AND.
561 + nlocal(n2,p)==1.AND.
562 + nlocal(n3,p)==1.AND.
563 + nlocal(n4,p)==1)THEN
564 GOTO 8888
565 ENDIF
566 ENDDO
567 ENDIF
568 IF(n4/=-1.AND.n2d==0)THEN
569 DO p = 1, nspmd
570 IF(nlocal(n1,p)==1.AND.
571 + nlocal(n2,p)==1.AND.
572 + nlocal(n3,p)==1)THEN
573 IF(n4/=0) THEN
574 CALL ifrontplus(n4,p)
575 ENDIF
576 GOTO 8888
577 ENDIF
578 ENDDO
579 ENDIF
580 IF(n4/=-1)THEN
581 DO p = 1, nspmd
582 IF(nlocal(n1,p)==1.AND.
583 + nlocal(n2,p)==1)THEN
584 IF(n2d==0.AND.n4/=0) THEN
585 CALL ifrontplus(n4,p)
586 ENDIF
587 IF(n2d==0) THEN
588 CALL ifrontplus(n3,p)
589 ENDIF
590 GOTO 8888
591 ENDIF
592 ENDDO
593 ENDIF
594 DO p = 1, nspmd
595 IF(nlocal(n1,p)==1) THEN
596 IF(n2d==0.AND.n4/=0.AND.n4/=-1) THEN
597 CALL ifrontplus(n4,p)
598 ENDIF
599 IF(n2d==0.AND.n4/=-1) THEN
600 CALL ifrontplus(n3,p)
601 ENDIF
602 IF(n4/=-1) THEN
603 CALL ifrontplus(n2,p)
604 ENDIF
605 GOTO 8888
606 ENDIF
607 ENDDO
608 IF(n4/=0.AND.n4/=0.AND.n4/=-1) THEN
609 CALL ifrontplus(n4,1)
610 ENDIF
611 IF(n2d==0.AND.n4/=-1) THEN
612 CALL ifrontplus(n3,1)
613 ENDIF
614 IF(n4/=-1) THEN
615 CALL ifrontplus(n2,1)
616 ENDIF
617 CALL ifrontplus(n1,1)
618 8888 CONTINUE
619 ENDDO
620 ENDDO
621C
622C-----------------------------------------------------
623C Traitement supplementaire rivets
624C-----------------------------------------------------
625 DO p = 1, nspmd
626 DO j=1,nrivet
627 if1 = nlocal(ixri(2,j),p)
628 if2 = nlocal(ixri(3,j),p)
629 IF (if1==1.OR.if2==1) THEN
630 CALL ifrontplus(ixri(2,j),p)
631 CALL ifrontplus(ixri(3,j),p)
632 ENDIF
633 ENDDO
634 ENDDO
635
636C
637C-----------------------------------------------------
638C Traitement supplementaire RBE2
639C-----------------------------------------------------
640 IF (nrbe2>0.AND.nspmd>1) THEN
641 DO n = 1, nrbe2
642 nsn = irbe2(5,n)
643 m = irbe2(3,n)
644 iad = irbe2(1,n)
645 DO p = 1, nspmd
646 IF (nlocal(m,p)==0) THEN
647 imain = 0
648 DO j = 1, nsn
649 l = lrbe2(iad+j)
650 IF(nlocal(l,p)/=0)THEN
651 imain = 1
652 GO TO 186
653 ENDIF
654 ENDDO
655 186 CONTINUE
656 IF(imain==1)THEN
657 CALL ifrontplus(m,p)
658 ENDIF
659 ENDIF
660 ENDDO
661 ENDDO
662C traitement noeuds non connectes
663 DO n = 1, nrbe2
664 nsn = irbe2(5,n)
665 m = irbe2(3,n)
666 iad = irbe2(1,n)
667 sum = 0
668 insnmax = 0
669 ipmax = 1
670 lastm = 0
671 DO p=1,nspmd
672 IF(nlocal(m,p)/=0) THEN
673 sum = sum + 1
674 lastm = p
675 ENDIF
676 insnp = 0
677 DO j = 1, nsn
678 l = lrbe2(iad+j)
679 IF(nlocal(l,p)/=0)THEN
680 insnp = insnp + 1
681 ENDIF
682 ENDDO
683 IF (insnp>insnmax) THEN
684 ipmax = p
685 insnmax = insnp
686 ENDIF
687 END DO
688 IF(sum==0) THEN
689 IF(insnmax==0) THEN
690 CALL ifrontplus(m,1)
691 ELSE
692 CALL ifrontplus(m,ipmax)
693 ENDIF
694 ELSEIF(insnmax==0) THEN
695 ipmax = lastm
696 ENDIF
697C
698 DO j = 1, nsn
699 l = lrbe2(iad+j)
700 sum = 0
701 DO p=1,nspmd
702 IF(nlocal(l,p)/=0)THEN
703 sum = sum + 1
704 ENDIF
705 ENDDO
706 IF(sum==0) THEN
707 CALL ifrontplus(l,ipmax)
708 ENDIF
709 ENDDO
710 ENDDO
711 ENDIF
712C
713C-----------------------------------------------------
714C Traitement RBE3 : Idem int2
715C-----------------------------------------------------
716 IF (nrbe3>0.AND.nspmd>1) THEN
717 DO n = 1, nrbe3
718 nir = irbe3(5,n)
719 k = irbe3(3,n)
720 iad = irbe3(1,n)
721 imain = 0
722 DO p = 1, nspmd
723 IF (nlocal(k,p)/=0) THEN
724 imain = 1
725 ENDIF
726 ENDDO
727 IF (imain==0) THEN
728 imain = 1
729 DO j=1,nir
730 kk = lrbe3(iad+j)
731 DO p = 1, nspmd
732 IF (nlocal(kk,p)/=0) THEN
733 imain = p
734 GOTO 51
735 ENDIF
736 ENDDO
737 ENDDO
738 51 CONTINUE
739 CALL ifrontplus(k,imain)
740 ENDIF
741 DO p = 1, nspmd
742 IF (nlocal(k,p)==0) THEN
743 GO TO 201
744 ENDIF
745C pas d'optimisation possible
746 DO j=1,nir
747 kk = lrbe3(iad+j)
748 IF (nlocal(kk,p)==0) THEN
749 CALL ifrontplus(kk,p)
750 ENDIF
751 ENDDO
752C optimisation possible
753 201 CONTINUE
754 ENDDO
755 ENDDO
756 ENDIF
757
758
759C
760C-----------------------------------------------------
761C Traitement supplementaire rigid bodies
762C-----------------------------------------------------
763 IF (nrbykin>0.AND.nspmd>1) THEN
764C--------------------------------------------------------------
765C Dans le cas de noeuds SECONDARYs de Rigid bodies non connectees
766C on les affecte sur le PMAIN
767C--------------------------------------------------------------
768 k=0
769 DO n = 1, nrbykin
770 nsn = npby(2,n)
771 m = npby(1,n)
772C Recherche du 1er proc qui a le noeud main
773 DO p=1,nspmd
774 IF (nlocal(m,p)/=0) GOTO 86
775 ENDDO
776 86 CONTINUE
777 pm = p
778
779 DO j = 1, nsn
780 l = lpby(k+j)
781 DO p=1,nspmd
782 IF(nlocal(l,p)/=0) GOTO 87
783 ENDDO
784 CALL ifrontplus(l,pm)
785 87 CONTINUE
786 ENDDO
787 k = k + nsn
788 ENDDO
789C--------------------------------------------------------------
790 k=0
791 DO n = 1, nrbykin
792 nsn = npby(2,n)
793 m = npby(1,n)
794 DO p = 1, nspmd
795 IF(nlocal(m,p)==0)THEN
796 imain = 0
797 DO j = 1, nsn
798 l = lpby(k+j)
799 IF(nlocal(l,p)/=0)THEN
800 imain = 1
801 GO TO 85
802 ENDIF
803 ENDDO
804 85 CONTINUE
805 IF(imain==1)THEN
806 CALL ifrontplus(m,p)
807 ENDIF
808 ENDIF
809 ENDDO
810 k = k + nsn
811 ENDDO
812C traitement noeuds non connectes
813 k=0
814 DO n = 1, nrbykin
815 nsn = npby(2,n)
816 m = npby(1,n)
817 sum = 0
818 insnmax = 0
819 ipmax = 1
820 lastm = 0
821 DO p=1,nspmd
822 IF(nlocal(m,p)/=0) THEN
823 sum = sum + 1
824 lastm = p
825 ENDIF
826 insnp = 0
827 DO j = 1, nsn
828 l = lpby(k+j)
829 IF(nlocal(l,p)/=0)THEN
830 insnp = insnp + 1
831 ENDIF
832 ENDDO
833 IF (insnp>insnmax) THEN
834 ipmax = p
835 insnmax = insnp
836 ENDIF
837 END DO
838C
839 IF(sum==0) THEN
840 IF(insnmax==0) THEN
841 CALL ifrontplus(m,1)
842 ELSE
843 CALL ifrontplus(m,ipmax)
844 ENDIF
845C cas au moins un main connecte mais aucun noeud SECONDARY de connecte
846 ELSEIF(insnmax==0) THEN
847 ipmax = lastm
848 ENDIF
849C
850 DO j = 1, nsn
851 l = lpby(k+j)
852 sum = 0
853 DO p=1,nspmd
854 IF(nlocal(l,p)/=0)THEN
855 sum = sum + 1
856 ENDIF
857 ENDDO
858 IF(sum==0) THEN
859 CALL ifrontplus(l,ipmax)
860 ENDIF
861 ENDDO
862 k = k + nsn
863 ENDDO
864
865 ENDIF
866C
867
868C-----------------------------------------------------
869C Traitement supplementaire RBM : Idem RB
870C-----------------------------------------------------
871 IF(nfxvel > 0 .AND. nspmd > 1)THEN
872
873 DO n=1,nfxvel
874 fingeo = ibfv(13,n)
875 IF (fingeo == 2)THEN ! FINGEO=2 option /IMPVEL/FGEO
876 n1 = ibfv(1,n) ! This impvel option has 2 nodes,
877 n2 = ibfv(14,n) ! ensure that the Nodes are on same domain.
878
879 iad1 = ifront%IENTRY(n1)
880 iad2 = ifront%IENTRY(n2)
881
882 IF (iad1 == -1 .AND. iad2 == -1)THEN ! Case Both nodes are free
883 CALL ifrontplus(n1,1) ! Stick them on processor 1 to avoid them
884 CALL ifrontplus(n2,1) ! to be sticked on different DOMAINS
885 ELSE
886 IF(iad1 /= -1 ) THEN
887 DO WHILE (iad1 /= 0) ! IAD1 is the pointer of Node1
888 p = ifront%P(1,iad1)
889 CALL ifrontplus(n2,p) ! Stick Node2 where Node1 is
890 iad1=ifront%P(2,iad1) ! NEXT
891 ENDDO
892 ENDIF
893
894 IF(iad2 /= -1 ) THEN
895 DO WHILE (iad2 /= 0) ! IAD2 is the pointer of Node2
896 p = ifront%P(1,iad2)
897 CALL ifrontplus(n1,p) ! Stick Node1 where Node2 is
898 iad2=ifront%P(2,iad2) ! NEXT
899 ENDDO
900 ENDIF
901
902 ENDIF
903 ENDIF
904 ENDDO
905 ENDIF ! IF(NFXVEL > 0 .AND. NSPMD > 1)THEN
906
907 IF (nibvel>0.AND.nspmd>1) THEN
908 k=0
909 DO n = 1, nibvel
910 nsn = ibvel(3,n)
911 m = ibvel(4,n)
912 DO p = 1, nspmd
913 IF (nlocal(m,p)==0) THEN
914 imain = 0
915 DO j = 1, nsn
916 l = lbvel(k+j)
917 IF(nlocal(l,p)/=0)THEN
918 imain = 1
919 GO TO 185
920 ENDIF
921 ENDDO
922 185 CONTINUE
923 IF(imain==1)THEN
924 CALL ifrontplus(m,p)
925 ENDIF
926 ENDIF
927 ENDDO
928 k = k + nsn
929 ENDDO
930C traitement noeuds non connectes
931 k=0
932 DO n = 1, nibvel
933 nsn = ibvel(3,n)
934 m = ibvel(4,n)
935 sum = 0
936 insnmax = 0
937 ipmax = 1
938 lastm = 0
939 DO p=1,nspmd
940 IF(nlocal(m,p)/=0) THEN
941 sum = sum + 1
942 lastm = p
943 ENDIF
944 insnp = 0
945 DO j = 1, nsn
946 l = lbvel(k+j)
947 IF(nlocal(l,p)/=0)THEN
948 insnp = insnp + 1
949 ENDIF
950 ENDDO
951 IF (insnp>insnmax) THEN
952 ipmax = p
953 insnmax = insnp
954 ENDIF
955 END DO
956 IF(sum==0) THEN
957 IF(insnmax==0) THEN
958 CALL ifrontplus(m,1)
959 ELSE
960 CALL ifrontplus(m,ipmax)
961 ENDIF
962 ELSEIF(insnmax==0) THEN
963 ipmax = lastm
964 ENDIF
965C
966 DO j = 1, nsn
967 l = lbvel(k+j)
968 sum = 0
969 DO p=1,nspmd
970 IF(nlocal(l,p)/=0)THEN
971 sum = sum + 1
972 ENDIF
973 ENDDO
974 IF(sum==0) THEN
975 CALL ifrontplus(l,ipmax)
976 ENDIF
977 ENDDO
978 k = k + nsn
979 ENDDO
980 ENDIF
981C
982C-----------------------------------------------------
983C Traitement rigid materials
984C-----------------------------------------------------
985 IF (irigid_mat>0.AND.nspmd>1) THEN
986 k=0
987 DO n = 1, nrbym
988 nsn = irbym(2,n)
989 DO p = 1, nspmd
990 imain = 0
991 DO j = 1, nsn
992 l = lcrbym(k+j)
993 IF(nlocal(l,p)/=0)THEN
994 imain = 1
995 GO TO 195
996 ENDIF
997 ENDDO
998 195 CONTINUE
999 IF(imain==1)THEN
1000 CALL frontplus_rm(front_rm(n,p),1)
1001 ENDIF
1002 ENDDO
1003 k = k + nsn
1004 ENDDO
1005C traitement cdg non connectes
1006 k=0
1007 DO n = 1, nrbym
1008 nsn = irbym(2,n)
1009 m = irbym(1,n)
1010 sum = 0
1011 insnmax = 0
1012 ipmax = 1
1013 lastm = 0
1014 DO p=1,nspmd
1015 IF(front_rm(m,p)/=0.AND.front_rm(m,p)/=100) THEN
1016 sum = sum + 1
1017 lastm = p
1018 ENDIF
1019 insnp = 0
1020 DO j = 1, nsn
1021 l = lcrbym(k+j)
1022 IF(nlocal(l,p)/=0)THEN
1023 insnp = insnp + 1
1024 ENDIF
1025 ENDDO
1026 IF (insnp>insnmax) THEN
1027 ipmax = p
1028 insnmax = insnp
1029 ENDIF
1030 END DO
1031C
1032 IF(sum==0) THEN
1033 IF(insnmax==0) THEN
1034 CALL frontplus_rm(front_rm(m,1),1)
1035 ELSE
1036 CALL frontplus_rm(front_rm(m,ipmax),1)
1037 ENDIF
1038C cas au moins un main connecte mais aucun noeud SECONDARY de connecte
1039 ELSEIF(insnmax==0) THEN
1040 ipmax = lastm
1041 ENDIF
1042C
1043 DO j = 1, nsn
1044 l = lcrbym(k+j)
1045 sum = 0
1046 DO p=1,nspmd
1047 IF(nlocal(l,p)/=0)THEN
1048 sum = sum + 1
1049 ENDIF
1050 ENDDO
1051 IF(sum==0) THEN
1052 CALL ifrontplus(l,ipmax)
1053 ENDIF
1054 ENDDO
1055 k = k + nsn
1056 ENDDO
1057 ELSEIF(irigid_mat > 0) THEN
1058 DO n = 1, nrbym
1059 CALL frontplus_rm(front_rm(n,1),1)
1060 ENDDO
1061 ENDIF
1062C-----------------------------------------------------
1063C Traitement special /BSC/CYCLIC
1064C-----------------------------------------------------
1065 DO n = 1, nbcscyc
1066 k = ibcscyc(1,n)
1067 nsn=ibcscyc(3,n)
1068 DO j = 1, nsn
1069 n1 = lbcscyc(1,k+j)
1070 n2 = lbcscyc(2,k+j)
1071 DO p = 1, nspmd
1072 IF(nlocal(n1,p)==1 .AND. nlocal(n2,p)==0)CALL ifrontplus(n2,p)
1073 IF(nlocal(n2,p)==1 .AND. nlocal(n1,p)==0)CALL ifrontplus(n1,p)
1074 ENDDO
1075 ENDDO
1076 ENDDO
1077C-----------------------------------------------------
1078C Traitement Itet=2 of S10
1079C-----------------------------------------------------
1080 IF (ns10e>0.AND.nspmd>1) THEN
1081 CALL c_doms10(icnds10,itagnd,ite2frplus)
1082 IF (ite2frplus > 0 ) GOTO 5000
1083 ENDIF
1084C-----------------------------------------------------
1085C Traitement supplementaire interface type 2
1086C-----------------------------------------------------
1087 IF (ninter>0.AND.nspmd>1) THEN
1088 IF (n2d==0) THEN
1089 nir = 4
1090 ELSE
1091 nir = 2
1092 ENDIF
1093 DO n = 1, ninter
1094 nty = ipari(7,n)
1095 IF (nty==2) THEN
1096 nrts = ipari(3,n)
1097 nrtm = ipari(4,n)
1098 nsn = ipari(5,n)
1099 nmn = ipari(6,n)
1100 ilev = ipari(20,n)
1101 IF (ilev == 25 .or. ilev == 26 .or. ilev == 27 .or. ilev == 28) int2flag=1
1102 DO i=1,nsn
1103 l = intbuf_tab(n)%IRTLM(i)
1104 k = intbuf_tab(n)%NSV(i)
1105C
1106 imain = 0
1107 DO p = 1, nspmd
1108 IF (nlocal(k,p)/=0) THEN
1109 imain = 1
1110 ENDIF
1111 ENDDO
1112 IF (imain==0) THEN
1113 imain = 1
1114 DO j=1,nir
1115 kk = intbuf_tab(n)%IRECTM((l-1)*4+j)
1116 DO p = 1, nspmd
1117 IF (nlocal(kk,p)/=0) THEN
1118 imain = p
1119 GOTO 50
1120 ENDIF
1121 ENDDO
1122 ENDDO
1123 50 CONTINUE
1124 CALL ifrontplus(k,imain)
1125 int2frplus=1
1126
1127 ENDIF
1128 DO p = 1, nspmd
1129 IF (nlocal(k,p)==0) THEN
1130 GO TO 200
1131 ENDIF
1132C pas d'optimisation possible
1133 DO j=1,nir
1134 kk = intbuf_tab(n)%IRECTM((l-1)*4+j)
1135 IF (nlocal(kk,p)==0) THEN
1136 CALL ifrontplus(kk,p)
1137 int2frplus=1
1138 ENDIF
1139 ENDDO
1140C optimisation possible
1141 200 CONTINUE
1142 ENDDO
1143 ENDDO
1144 ENDIF
1145 ENDDO
1146 ENDIF
1147 IF (int2frplus /= 0 .AND. int2flag/=0)GOTO 5000
1148C-----------------------------------------------------
1149C Traitement special noeuds non encore affectes
1150C-----------------------------------------------------
1151C mise sur Pi des noeuds non affectes (round robbin)
1152 iproc = 1
1153 DO i = 1,numnod
1154 sum = 0
1155 IF(ifront%IENTRY(i)==-1) THEN
1156 ifront%IENTRY(i)=i
1157 ifront%P(1,i) = iproc
1158 ifront%P(2,i) = 0
1159 iproc = mod(iproc,nspmd)+1
1160 ENDIF
1161 END DO
1162C-----------------------------------------------------
1163C Traitement special sensor type2
1164C-----------------------------------------------------
1165 IF(sensors%NSENSOR>0) THEN
1166 DO p = 1, nspmd
1167 nsensp(p) = 0
1168 END DO
1169 DO i=1,sensors%NSENSOR
1170 typ = sensors%SENSOR_TAB(i)%TYPE
1171 isensp(1,i) = 0
1172 isensp(2,i) = 0
1173C
1174 IF(typ==0)THEN
1175 ELSEIF(typ==1)THEN
1176 ELSEIF(typ==2)THEN
1177C--------------------------------
1178C CAPTEUR - DEPLACEMENT
1179C--------------------------------
1180 n1 = sensors%SENSOR_TAB(i)%IPARAM(1)
1181 DO p = 1, nspmd
1182 IF(nlocal(n1,p)==1)THEN
1183 isensp(1,i) = p
1184 nsensp(p) = nsensp(p)+1
1185 GOTO 500
1186 END IF
1187 END DO
1188 500 CONTINUE
1189 n2 = sensors%SENSOR_TAB(i)%IPARAM(2)
1190 DO p = 1, nspmd
1191 IF(nlocal(n2,p)==1)THEN
1192 isensp(2,i) = p
1193 nsensp(p) = nsensp(p)+1
1194 GOTO 600
1195 END IF
1196 END DO
1197 600 CONTINUE
1198 ELSEIF(typ==3)THEN
1199 ELSEIF(typ==4)THEN
1200 ELSEIF(typ==5)THEN
1201 ELSEIF(typ==6)THEN
1202 ELSEIF(typ==7)THEN
1203 ELSEIF(typ==8)THEN
1204c
1205 ELSEIF(typ==13)THEN ! SENSOR WORK
1206 n1 = sensors%SENSOR_TAB(i)%IPARAM(1)
1207 DO p = 1, nspmd
1208 IF (nlocal(n1,p)==1) THEN
1209 isensp(1,i) = p
1210 nsensp(p) = nsensp(p)+1
1211 EXIT
1212 END IF
1213 END DO
1214 n2 = sensors%SENSOR_TAB(i)%IPARAM(2)
1215 IF (n2 > 0) THEN
1216 DO p = 1, nspmd
1217 IF (nlocal(n2,p)==1) THEN
1218 isensp(2,i) = p
1219 nsensp(p) = nsensp(p)+1
1220 EXIT
1221 END IF
1222 END DO
1223 ENDIF
1224c
1225 ELSEIF(typ==14)THEN
1226 ELSEIF(typ>=29.AND.typ<=31) THEN
1227 ELSE
1228 ENDIF
1229 ENDDO
1230 END IF
1231C
1232C-----------------------------------------------------
1233C Traitement special accelerometres
1234C-----------------------------------------------------
1235 IF(naccelm>0) THEN
1236 DO p = 1, nspmd
1237 naccp(p) = 0
1238 END DO
1239C
1240 DO i=1,naccelm
1241 n1 = laccelm(1,i)
1242 DO p = 1, nspmd
1243 IF(nlocal(n1,p)==1)THEN
1244 iaccp(i) = p
1245 naccp(p) = naccp(p)+1
1246 EXIT
1247 END IF
1248 END DO
1249 END DO
1250 END IF
1251C
1252C-----------------------------------------------------
1253C Traitement special gauges
1254C-----------------------------------------------------
1255 IF(nbgauge>0) THEN
1256 DO p = 1, nspmd
1257 ngaup(p) = 0
1258 END DO
1259C
1260 DO i=1,nbgauge
1261 n1=lgauge(3,i)
1262 IF(n1>0)THEN
1263 DO p = 1, nspmd
1264 IF(nlocal(n1,p)==1)THEN
1265 igaup(i) = p
1266 ngaup(p) = ngaup(p)+1
1267 EXIT
1268 END IF
1269 END DO
1270 !!ELSE
1271 ELSEIF(n1<0)THEN
1272 n1 = -n1 + numels
1273 p = cep(n1 ) + 1
1274 igaup(i) = p
1275 ngaup(p) = ngaup(p) + 1
1276 ENDIF
1277 END DO
1278 END IF
1279
1280 IF(njoint>0) CALL split_joint( )
1281
1282C-----------------------------------------------------
1283C dd_iad => dd_grp : nb de groupes par sous domaine
1284 ngrou = 0
1285 DO i = 1, nspgroup
1286 DO p = 1, nspmd
1287c IF (DD_IAD(P+1,I)>0) THEN
1288c NEL = DD_IAD(P+1,I) - DD_IAD(P,I)
1289c IF (NEL>0) THEN
1290c NG = (NEL-1)/NVSIZ + 1
1291c NGROU = NGROU + NG
1292c ELSE
1293c NG = 0
1294c ENDIF
1295c DD_IAD(P,I) = NG
1296c ELSE
1297c DD_IAD(P,I) = 0
1298c ENDIF
1299C seule la verification est conservee, le remplacement de dd_iad est fait directement dans les routines xtails
1300 ngrou = ngrou + dd_iad(p,i)
1301 ENDDO
1302 ENDDO
1303 IF (ngrou/=ngroup) THEN
1304C WRITE(IOUT,*)'** ERROR : DOMAIN DEC AND NGROUP DIFFER'
1305C WRITE(ISTDO,*)'** ERROR : DOMAIN DEC AND NGROUP DIFFER'
1306C IERR = IERR + 1
1307 CALL ancmsg(msgid=363,
1308 . msgtype=msgerror,
1309 . anmode=aninfo_blind_1,
1310 . i1=ngrou,
1311 . i2=ngroup)
1312 ENDIF
1313C
1314C-----------------------------------------------------
1315C Preparation de ADDCNE : Adresse matrice CNE
1316C-----------------------------------------------------
1317 DO n=0,numnod+1
1318 adsky(n) = 0
1319 ENDDO
1320C
1321 DO k=2,9
1322 DO i=1,numels
1323 n = ixs(k,i) + 1
1324 adsky(n) = adsky(n) + 1
1325 ENDDO
1326 ENDDO
1327C
1328 IF(numels10>0) THEN
1329 DO k=1,6
1330 DO i=1,numels10
1331 n = ixs10(k,i) + 1
1332 adsky(n) = adsky(n) + 1
1333 ENDDO
1334 ENDDO
1335 ENDIF
1336 IF(numels20>0)THEN
1337 DO k=1,12
1338 DO i=1,numels20
1339 n = ixs20(k,i) + 1
1340 adsky(n) = adsky(n) + 1
1341 ENDDO
1342 ENDDO
1343 ENDIF
1344C
1345 IF(numels16>0)THEN
1346 DO k=1,8
1347 DO i=1,numels16
1348 n = ixs16(k,i) + 1
1349 adsky(n) = adsky(n) + 1
1350 ENDDO
1351 ENDDO
1352 ENDIF
1353C
1354 DO k=2,5
1355 DO i=1,numelq
1356 n = ixq(k,i) + 1
1357 adsky(n) = adsky(n) + 1
1358 ENDDO
1359 ENDDO
1360C
1361
1362 DO k=2,5
1363 DO i=1,numelc
1364 n = ixc(k,i) + 1
1365 adsky(n) = adsky(n) + 1
1366 ENDDO
1367 ENDDO
1368C
1369 DO k=2,3
1370 DO i=1,numelt
1371 n = ixt(k,i) + 1
1372 adsky(n) = adsky(n) + 1
1373 ENDDO
1374 ENDDO
1375C
1376 DO k=2,3
1377 DO i=1,numelp
1378 n = ixp(k,i) + 1
1379 adsky(n) = adsky(n) + 1
1380 ENDDO
1381 ENDDO
1382C
1383C traitement a part du 3eme noeud optionnel sauf type 12
1384 DO k=2,3
1385 DO i=1,numelr
1386 n = ixr(k,i) + 1
1387 adsky(n) = adsky(n) + 1
1388 ENDDO
1389 ENDDO
1390 DO i=1,numelr
1391 n = ixr(4,i) + 1
1392 IF(igeo(11,ixr(1,i))/=12) n = 0
1393 adsky(n) = adsky(n) + 1
1394 ENDDO
1395C
1396 DO k=2,4
1397 DO i=1,numeltg
1398 n = ixtg(k,i) + 1
1399 adsky(n) = adsky(n) + 1
1400 ENDDO
1401 ENDDO
1402C elem penta6
1403 IF(numeltg6>0)THEN
1404 DO k=1,3
1405 DO i=1,numeltg6
1406 n = ixtg6(k,i)+1
1407 adsky(n) = adsky(n) + 1
1408 END DO
1409 END DO
1410 END IF
1411C
1412C--------------------------------------
1413C prise en compte des forces des mv
1414C--------------------------------------
1415 IF (nvolu>0) THEN
1416 k3 = 1 + nimv * nvolu + nicbag * nvolu * nvolu
1417 k1 = 1
1418 DO n = 1, nvolu
1419 is = t_monvol(n)%EXT_SURFID
1420 nn_s = igrsurf(is)%NSEG
1421 DO j = 1, nn_s
1422 ity=igrsurf(is)%ELTYP(j)
1423 i = igrsurf(is)%ELEM(j)
1424 IF (ity==3) THEN
1425 DO k = 2,5
1426 nn = ixc(k,i) + 1
1427 adsky(nn) = adsky(nn) + 1
1428 ENDDO
1429 ELSE
1430 DO k=2,4
1431 nn = ixtg(k,i) + 1
1432 adsky(nn) = adsky(nn) + 1
1433 END DO
1434 ENDIF
1435 ENDDO
1436 k1 = k1 + nimv
1437 ENDDO
1438 ENDIF
1439C--------------------------------------
1440C prise en compte des forces concentrees + pressure loads
1441C--------------------------------------
1442 IF(nconld>0) THEN
1443 DO nl = 1, nconld
1444 n1=ib(1,nl)
1445 n2=ib(2,nl)
1446 n3=ib(3,nl)
1447 n4=ib(4,nl)
1448 nn = n1 + 1
1449 adsky(nn) = adsky(nn) + 1
1450 IF(n4/=-1)THEN
1451 nn = n2 + 1
1452 adsky(nn) = adsky(nn) + 1
1453 IF(n2d==0)THEN
1454 nn = n3 + 1
1455 adsky(nn) = adsky(nn) + 1
1456 IF(n4/=0) THEN
1457 nn = n4 + 1
1458 adsky(nn) = adsky(nn) + 1
1459 ENDIF
1460 ENDIF
1461 ENDIF
1462 ENDDO
1463 ENDIF
1464C-----------------------------------------------
1465C pseudo element BC for heat transfert
1466C-----------------------------------------------
1467 IF(numconv>0) THEN
1468 DO nl = 1, numconv
1469 n1=ibcv(1,nl)
1470 n2=ibcv(2,nl)
1471 n3=ibcv(3,nl)
1472 n4=ibcv(4,nl)
1473 nn = n1 + 1
1474 adsky(nn) = adsky(nn) + 1
1475 IF(n4/=-1)THEN
1476 nn = n2 + 1
1477 adsky(nn) = adsky(nn) + 1
1478 IF(n2d==0)THEN
1479 nn = n3 + 1
1480 adsky(nn) = adsky(nn) + 1
1481 IF(n4/=0) THEN
1482 nn = n4 + 1
1483 adsky(nn) = adsky(nn) + 1
1484 ENDIF
1485 ENDIF
1486 ENDIF
1487 ENDDO
1488 ENDIF
1489C-----------------------------------------------
1490C pseudo element BR for radiative heat transfert
1491C-----------------------------------------------
1492 IF(numradia>0) THEN
1493 DO nl = 1, numradia
1494 n1=ibcr(1,nl)
1495 n2=ibcr(2,nl)
1496 n3=ibcr(3,nl)
1497 n4=ibcr(4,nl)
1498 nn = n1 + 1
1499 adsky(nn) = adsky(nn) + 1
1500 nn = n2 + 1
1501 adsky(nn) = adsky(nn) + 1
1502 IF(n2d==0)THEN
1503 nn = n3 + 1
1504 adsky(nn) = adsky(nn) + 1
1505 IF(n4/=0) THEN
1506 nn = n4 + 1
1507 adsky(nn) = adsky(nn) + 1
1508 ENDIF
1509 ENDIF
1510 ENDDO
1511 ENDIF
1512C-----------------------------------------------
1513C pseudo element for imposed heat flux
1514C-----------------------------------------------
1515 IF(nfxflux>0) THEN
1516 DO nl = 1, nfxflux
1517 IF(ibfflux(10,nl) == 1) cycle
1518 n1=ibfflux(1,nl)
1519 n2=ibfflux(2,nl)
1520 n3=ibfflux(3,nl)
1521 n4=ibfflux(4,nl)
1522 nn = n1 + 1
1523 adsky(nn) = adsky(nn) + 1
1524 IF(n4/=-1)THEN
1525 nn = n2 + 1
1526 adsky(nn) = adsky(nn) + 1
1527 IF(n2d==0)THEN
1528 nn = n3 + 1
1529 adsky(nn) = adsky(nn) + 1
1530 IF(n4/=0) THEN
1531 nn = n4 + 1
1532 adsky(nn) = adsky(nn) + 1
1533 ENDIF
1534 ENDIF
1535 ENDIF
1536 ENDDO
1537 ENDIF
1538C--------------------------------------
1539C prise en compte des load/pfluid
1540C--------------------------------------
1541 IF(nloadp>0) THEN
1542 DO nl = 1, nloadp
1543 DO i = 1,iloadp(1,nl)/4
1544 n1=lloadp(iloadp(4,nl)+4*(i-1))
1545 n2=lloadp(iloadp(4,nl)+4*(i-1)+1)
1546 n3=lloadp(iloadp(4,nl)+4*(i-1)+2)
1547 n4=lloadp(iloadp(4,nl)+4*(i-1)+3)
1548 nn = n1 + 1
1549 adsky(nn) = adsky(nn) + 1
1550 IF(n4/=-1)THEN
1551 nn = n2 + 1
1552 adsky(nn) = adsky(nn) + 1
1553 IF(n2d==0)THEN
1554 nn = n3 + 1
1555 adsky(nn) = adsky(nn) + 1
1556 IF(n4/=0) THEN
1557 nn = n4 + 1
1558 adsky(nn) = adsky(nn) + 1
1559 ENDIF
1560 ENDIF
1561 ENDIF
1562 ENDDO
1563 ENDDO
1564 ENDIF
1565
1566! -------------------------------------
1567! Euler boundary conditions : non-relecting frontier
1568! add 1 contribution per node of element
1569! ------------
1570 IF(nebcs>0) THEN
1571 DO i=1,nebcs
1572 is_ebcs_parallel = .false.
1573 IF(ebcs_tab%tab(i)%poly%type == 10 .or. ebcs_tab%tab(i)%poly%type == 11)is_ebcs_parallel=.true.
1574 IF(is_ebcs_parallel) THEN
1575 surf_id = ebcs_tab%tab(i)%poly%surf_id ! surface id
1576 number_node = 4
1577 IF(n2d/=0) number_node = 2
1578 ! ------------
1579 ! loop over the elements of the ebcs
1580 DO j=1,ebcs_tab%tab(i)%poly%nb_elem
1581 ! loop over the 4 nodes of the surfaces
1582 DO ijk=1,number_node
1583 node_id = igrsurf(surf_id)%NODES(j,ijk) + 1
1584 adsky(node_id) = adsky(node_id) + 1
1585 ENDDO
1586 ENDDO
1587 ! ------------
1588 ENDIF
1589 ENDDO
1590 ENDIF
1591! -------------------------------------
1592! /LOAD/PCYL : add 1 contribution per node per segment
1593! ------------
1594! ! loop over the /LOAD/PCYL
1595 DO i=1,loads%NLOAD_CYL
1596 number_segment = loads%LOAD_CYL(i)%NSEG ! number of segment for the PCYL I
1597 ! ------------
1598 DO j=1,number_segment ! loop over the segments of the surface
1599 DO k=1,4
1600 node_id = loads%LOAD_CYL(i)%SEGNOD(j,k) + 1! get the node id + 1 (if the segment is a triangle, NODE_ID(node 4) = 0))
1601 number_proc = 0
1602 IF(node_id/=0) adsky(node_id) = adsky(node_id) + 1
1603 ENDDO
1604 ENDDO
1605 ! ------------
1606 ENDDO
1607! -------------------------------------
1608
1609C-----------------------------------------------
1610C CALCUL DES ADRESSES DU VECTEUR SKYLINE
1611C-----------------------------------------------
1612 adsky(1) = 1
1613 DO i=2,numnod+1
1614 adsky(i)=adsky(i)+adsky(i-1)
1615 ENDDO
1616C
1617 lcne = adsky(numnod+1)-1
1618C
1619C-----------------------------------------------
1620C Remplissage de CEL : connection Element/Local
1621C-----------------------------------------------
1622 off = 0
1623 nin = 0
1624 ity_old = 0
1625 DO proc = 1, nspmd
1626 off = 0
1627 nin = 0
1628 ity_old = 0
1629 DO ng = 1, ngroup
1630 nel = iparg(2,ng)
1631 p = iparg(32,ng)+1
1632 ity = iparg(5,ng)
1633 IF (ity/=ity_old) THEN
1634 nin = 0
1635 ity_old = ity
1636 ENDIF
1637C SPH non pris en comp
1638 IF(ity/=51) THEN
1639 IF (p==proc) THEN
1640 DO i = 1, nel
1641 cel(i+off) = nin+i
1642 ENDDO
1643 nin = nin + nel
1644 ENDIF
1645 off = off + nel
1646 ENDIF
1647 ENDDO
1648 ENDDO
1649
1650c tableau IELS initialise a 0 (pour traitement SPH)
1651 DO proc = 1,nspmd
1652 iels(proc) = 0
1653 ENDDO
1654
1655c on remplit le tableau CELSPH pour traitement SPH
1656 DO j = 1, numsph
1657 p_sph = cepsp(j) + 1
1658 iels(p_sph) = iels(p_sph) + 1
1659 celsph(j) = iels(p_sph)
1660 ENDDO
1661C-----------------------------------------------
1662C Ajout pseudo element BCL
1663C-----------------------------------------------
1664 IF(nconld>0) THEN
1665 DO nl = 1, nconld
1666 cel(off+nl) = 0
1667 ENDDO
1668C
1669 DO proc = 1, nspmd
1670 nl_l = 0
1671 DO nl = 1, nconld
1672 IF(cel(off+nl)==0) THEN
1673 n1=ib(1,nl)
1674 n2=ib(2,nl)
1675 n3=ib(3,nl)
1676 n4=ib(4,nl)
1677 IF(n4/=-1)THEN
1678 IF(n2d==0)THEN
1679 IF(n4/=0) THEN
1680 IF(nlocal(n1,proc)==1.AND.
1681 + nlocal(n2,proc)==1.AND.
1682 + nlocal(n3,proc)==1.AND.
1683 + nlocal(n4,proc)==1)THEN
1684 nl_l = nl_l + 1
1685 cel(nl+off) = nl_l
1686 ENDIF
1687 ELSE
1688 IF(nlocal(n1,proc)==1.AND.
1689 + nlocal(n2,proc)==1.AND.
1690 + nlocal(n3,proc)==1)THEN
1691 nl_l = nl_l + 1
1692 cel(nl+off) = nl_l
1693 ENDIF
1694 ENDIF
1695 ELSE
1696 IF(nlocal(n1,proc)==1.AND.
1697 + nlocal(n2,proc)==1)THEN
1698 nl_l = nl_l + 1
1699 cel(nl+off) = nl_l
1700 ENDIF
1701 ENDIF
1702 ELSE
1703 IF(nlocal(n1,proc)==1) THEN
1704 nl_l = nl_l + 1
1705 cel(nl+off) = nl_l
1706 ENDIF
1707 ENDIF
1708 ENDIF
1709 ENDDO
1710C
1711 ENDDO
1712 off = off + nconld
1713 ENDIF
1714C-----------------------------------------------
1715C Ajout pseudo element bc for heat tranfert
1716C-----------------------------------------------
1717 IF(numconv>0) THEN
1718 DO nl = 1, numconv
1719 cel(off+nl) = 0
1720 ENDDO
1721C
1722 DO proc = 1, nspmd
1723 nl_l = 0
1724 DO nl = 1, numconv
1725 IF(cel(off+nl)==0) THEN
1726 n1=ibcv(1,nl)
1727 n2=ibcv(2,nl)
1728 n3=ibcv(3,nl)
1729 n4=ibcv(4,nl)
1730 IF(ibcv(7,nl) == 1) THEN
1731 IF(proc-1 == cep(ibcv(8,nl))) THEN
1732 nl_l = nl_l + 1
1733 cel(nl+off) = nl_l
1734 ENDIF
1735 ELSE
1736 IF(n2d==0)THEN
1737 IF(n4/=0) THEN
1738 IF(nlocal(n1,proc)==1.AND.
1739 + nlocal(n2,proc)==1.AND.
1740 + nlocal(n3,proc)==1.AND.
1741 + nlocal(n4,proc)==1)THEN
1742 nl_l = nl_l + 1
1743 cel(nl+off) = nl_l
1744 ENDIF
1745 ELSE
1746 IF(nlocal(n1,proc)==1.AND.
1747 + nlocal(n2,proc)==1.AND.
1748 + nlocal(n3,proc)==1)THEN
1749 nl_l = nl_l + 1
1750 cel(nl+off) = nl_l
1751 ENDIF
1752 ENDIF
1753 ELSE
1754 IF(nlocal(n1,proc)==1.AND.
1755 + nlocal(n2,proc)==1)THEN
1756 nl_l = nl_l + 1
1757 cel(nl+off) = nl_l
1758 ENDIF
1759 ENDIF
1760 ENDIF
1761 ENDIF
1762 ENDDO
1763 ENDDO
1764 off = off + numconv
1765 ENDIF
1766C-----------------------------------------------
1767C Ajout pseudo element br for radiative heat tranfert
1768C-----------------------------------------------
1769 IF(numradia>0) THEN
1770 DO nl = 1, numradia
1771 cel(off+nl) = 0
1772 ENDDO
1773C
1774 DO proc = 1, nspmd
1775 nl_l = 0
1776 DO nl = 1, numradia
1777 IF(cel(off+nl)==0) THEN
1778 n1=ibcr(1,nl)
1779 n2=ibcr(2,nl)
1780 n3=ibcr(3,nl)
1781 n4=ibcr(4,nl)
1782 IF(ibcr(7,nl) == 1) THEN
1783 IF(proc-1== cep(ibcr(8,nl))) THEN
1784 nl_l = nl_l + 1
1785 cel(nl+off) = nl_l
1786 ENDIF
1787 ELSE
1788 IF(n2d==0)THEN
1789 IF(n4/=0) THEN
1790 IF(nlocal(n1,proc)==1.AND.
1791 + nlocal(n2,proc)==1.AND.
1792 + nlocal(n3,proc)==1.AND.
1793 + nlocal(n4,proc)==1)THEN
1794 nl_l = nl_l + 1
1795 cel(nl+off) = nl_l
1796 ENDIF
1797 ELSE
1798 IF(nlocal(n1,proc)==1.AND.
1799 + nlocal(n2,proc)==1.AND.
1800 + nlocal(n3,proc)==1)THEN
1801 nl_l = nl_l + 1
1802 cel(nl+off) = nl_l
1803 ENDIF
1804 ENDIF
1805 ELSE
1806 IF(nlocal(n1,proc)==1.AND.
1807 + nlocal(n2,proc)==1)THEN
1808 nl_l = nl_l + 1
1809 cel(nl+off) = nl_l
1810 ENDIF
1811 ENDIF
1812 ENDIF
1813 ENDIF
1814 ENDDO
1815 ENDDO
1816 off = off + numradia
1817 ENDIF
1818C-----------------------------------------------
1819C Ajout pseudo element for imposed heat flux
1820C-----------------------------------------------
1821 IF(nfxflux>0) THEN
1822 DO nl = 1, nfxflux
1823 cel(off+nl) = 0
1824 ENDDO
1825C
1826 DO proc = 1, nspmd
1827 nl_l = 0
1828 DO nl = 1, nfxflux
1829 IF(ibfflux(10,nl) == 1) cycle
1830 IF(cel(off+nl)==0) THEN
1831 n1=ibfflux(1,nl)
1832 n2=ibfflux(2,nl)
1833 n3=ibfflux(3,nl)
1834 n4=ibfflux(4,nl)
1835 IF(n2d==0)THEN
1836 IF(n4/=0) THEN
1837 IF(nlocal(n1,proc)==1.AND.
1838 + nlocal(n2,proc)==1.AND.
1839 + nlocal(n3,proc)==1.AND.
1840 + nlocal(n4,proc)==1)THEN
1841 nl_l = nl_l + 1
1842 cel(nl+off) = nl_l
1843 ENDIF
1844 ELSE
1845 IF(nlocal(n1,proc)==1.AND.
1846 + nlocal(n2,proc)==1.AND.
1847 + nlocal(n3,proc)==1)THEN
1848 nl_l = nl_l + 1
1849 cel(nl+off) = nl_l
1850 ENDIF
1851 ENDIF
1852 ELSE
1853 IF(nlocal(n1,proc)==1.AND.nlocal(n2,proc)==1)THEN
1854 nl_l = nl_l + 1
1855 cel(nl+off) = nl_l
1856 ENDIF
1857 ENDIF
1858 ENDIF
1859 ENDDO
1860 ENDDO
1861 off = off + nfxflux
1862 ENDIF
1863C-----------------------------------------------
1864C Ajout pseudo element pfluid
1865C-----------------------------------------------
1866 IF(nloadp>0) THEN
1867 numloadp=0
1868 DO nl = 1, nloadp
1869 DO i = 1,iloadp(1,nl)/4
1870 cel(off+numloadp+i) = 0
1871 ENDDO
1872 numloadp=numloadp+iloadp(1,nl)/4
1873 ENDDO
1874C
1875 DO proc = 1, nspmd
1876 nl_l = 0
1877 numloadp=0
1878 DO nl = 1, nloadp
1879 DO i = 1,iloadp(1,nl)/4
1880 IF(cel(off+numloadp+i)==0) THEN
1881 n1=lloadp(iloadp(4,nl)+4*(i-1))
1882 n2=lloadp(iloadp(4,nl)+4*(i-1)+1)
1883 n3=lloadp(iloadp(4,nl)+4*(i-1)+2)
1884 n4=lloadp(iloadp(4,nl)+4*(i-1)+3)
1885 IF(n4/=-1)THEN
1886 IF(n2d==0)THEN
1887 IF(n4/=0) THEN
1888 IF(nlocal(n1,proc)==1.AND.
1889 + nlocal(n2,proc)==1.AND.
1890 + nlocal(n3,proc)==1.AND.
1891 + nlocal(n4,proc)==1)THEN
1892 nl_l = nl_l + 1
1893 cel(off+numloadp+i) = nl_l
1894 ENDIF
1895 ELSE
1896 IF(nlocal(n1,proc)==1.AND.
1897 + nlocal(n2,proc)==1.AND.
1898 + nlocal(n3,proc)==1)THEN
1899 nl_l = nl_l + 1
1900 cel(off+numloadp+i) = nl_l
1901 ENDIF
1902 ENDIF
1903 ELSE
1904 IF(nlocal(n1,proc)==1.AND.
1905 + nlocal(n2,proc)==1)THEN
1906 nl_l = nl_l + 1
1907 cel(off+numloadp+i) = nl_l
1908 ENDIF
1909 ENDIF
1910 ELSE
1911 IF(nlocal(n1,proc)==1) THEN
1912 nl_l = nl_l + 1
1913 cel(off+numloadp+i) = nl_l
1914 ENDIF
1915 ENDIF
1916 ENDIF
1917 ENDDO
1918 numloadp=numloadp+iloadp(1,nl)/4
1919 ENDDO
1920 ENDDO
1921 off = off + numloadp
1922 ENDIF
1923C
1924C Traitement assemblage // int2
1925C
1926 IF(i2nsnt>0) THEN
1927C
1928C-----------------------------------------------------
1929C Preparation de ADDCNI2 : Adresse matrice CNI2 (connectivite interface type 2)
1930C-----------------------------------------------------
1931 DO n=0,numnod+1
1932 adskyi2(n) = 0
1933 ENDDO
1934C
1935 IF (n2d==0) THEN
1936 nir = 4
1937 ELSE
1938 nir = 2
1939 ENDIF
1940 DO n = 1, ninter
1941 nty = ipari(7,n)
1942 IF (nty==2) THEN
1943 nrts = ipari(3,n)
1944 nrtm = ipari(4,n)
1945 nsn = ipari(5,n)
1946 nmn = ipari(6,n)
1947 DO i=1,nsn
1948 l = intbuf_tab(n)%IRTLM(i)
1949 k = intbuf_tab(n)%NSV(i)
1950 DO j=1,nir
1951 kk = intbuf_tab(n)%IRECTM((l-1)*4+j) + 1
1952 adskyi2(kk) = adskyi2(kk) + 1
1953 END DO
1954 END DO
1955 END IF
1956 END DO
1957C-----------------------------------------------
1958C CALCUL DES ADRESSES DU VECTEUR SKYLINE
1959C-----------------------------------------------
1960 adskyi2(1) = 1
1961 DO i=2,numnod+1
1962 adskyi2(i)=adskyi2(i)+adskyi2(i-1)
1963 ENDDO
1964 lcni2 = adskyi2(numnod+1)-1
1965C-----------------------------------------------
1966C Remplissage de CEPI2 : connection Element/Local
1967C-----------------------------------------------
1968 off = 0
1969 DO n = 1, ninter
1970 nty = ipari(7,n)
1971 IF (nty==2) THEN
1972 nrts = ipari(3,n)
1973 nrtm = ipari(4,n)
1974 nsn = ipari(5,n)
1975 nmn = ipari(6,n)
1976 DO i=1,nsn
1977 l = intbuf_tab(n)%IRTLM(i)
1978 k = intbuf_tab(n)%NSV(i)
1979 celi2(off+i) = 0
1980 DO p = 1, nspmd
1981 IF(nlocal(k,p)==1)THEN
1982 cepi2(off+i) = p-1
1983 GO TO 102
1984 ENDIF
1985 ENDDO
1986 102 CONTINUE
1987 ENDDO
1988 off = off + nsn
1989 END IF
1990 END DO
1991C-----------------------------------------------
1992C Remplissage de CEL : connection Element/Local
1993C-----------------------------------------------
1994 DO p = 1, nspmd
1995 off = 0
1996 nl_l = 0
1997 DO n = 1, ninter
1998 nty = ipari(7,n)
1999 IF (nty==2) THEN
2000 nrts = ipari(3,n)
2001 nrtm = ipari(4,n)
2002 nsn = ipari(5,n)
2003 nmn = ipari(6,n)
2004 DO i=1,nsn
2005 l = intbuf_tab(n)%IRTLM(i)
2006 k = intbuf_tab(n)%NSV(i)
2007 IF(celi2(off+i)==0) THEN
2008 IF(nlocal(k,p)==1)THEN
2009 nl_l = nl_l + 1
2010 celi2(off+i) = nl_l
2011 END IF
2012 END IF
2013 END DO
2014 off = off + nsn
2015 END IF
2016 END DO
2017 END DO
2018 END IF
2019C
2020 RETURN
2021 END
2022C
2023!||====================================================================
2024!|| fillcne ../starter/source/spmd/domdec2.F
2025!||--- called by ------------------------------------------------------
2026!|| lectur ../starter/source/starter/lectur.f
2027!||--- calls -----------------------------------------------------
2028!|| nlocal ../starter/source/spmd/node/ddtools.F
2029!||--- uses -----------------------------------------------------
2030!|| monvol_struct_mod ../starter/share/modules1/monvol_struct_mod.F
2031!||====================================================================
2032 SUBROUTINE fillcne(
2033 1 CNE ,LCNE ,IXS ,IXS10 ,IXS20 ,
2034 2 IXS16 ,IXQ ,IXC ,IXT ,IXP ,
2035 3 IXR ,IXTG ,IXTG6 ,T_MONVOL ,
2036 4 IGRSURF,IB ,ADDCNE ,CEP ,
2037 5 ILEN ,GEO ,IBCV ,IBCR ,IBFFLUX,
2038 6 ILOADP ,LLOADP ,CEL ,EBCS_TAB,LOADS,
2039 7 NICONV ,NIRADIA ,NITFLUX,NUMCONV,NUMRADIA,NFXFLUX)
2040C-----------------------------------------------
2041C M o d u l e s
2042C-----------------------------------------------
2043 USE groupdef_mod
2044 USE monvol_struct_mod
2045 USE ale_ebcs_mod
2046 USE ebcs_mod
2047 USE loads_mod
2048C-----------------------------------------------
2049C I m p l i c i t T y p e s
2050C-----------------------------------------------
2051#include "implicit_f.inc"
2052C-----------------------------------------------
2053C C o m m o n B l o c k s
2054C-----------------------------------------------
2055#include "com01_c.inc"
2056#include "com04_c.inc"
2057#include "param_c.inc"
2058C-----------------------------------------------
2059C D u m m y A r g u m e n t s
2060C-----------------------------------------------
2061 INTEGER ,INTENT(IN) :: NICONV
2062 INTEGER ,INTENT(IN) :: NIRADIA
2063 INTEGER ,INTENT(IN) :: NITFLUX
2064 INTEGER ,INTENT(IN) :: NUMCONV
2065 INTEGER ,INTENT(IN) :: NUMRADIA
2066 INTEGER ,INTENT(IN) :: NFXFLUX
2067 INTEGER IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),IXTG(NIXTG,*),
2068 . ixt(nixt,*),ixp(nixp,*),ixr(nixr,*),cep(*),
2069 . ixs10(6,*),ixs20(12,*),ixs16(8,*),ixtg6(4,*),
2070 . ib(nibcld,*),
2071 . addcne(0:*), cne(*), lcne, ilen,
2072 . ibcv(niconv,*), ibcr(niradia,*),ibfflux(nitflux,*),
2073 . iloadp(sizloadp,*),lloadp(*)
2074 INTEGER CEL(*)
2075 my_real
2076 . GEO(NPROPG,*)
2077 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
2078 TYPE(MONVOL_STRUCT_), DIMENSION(NVOLU), INTENT(IN) :: T_MONVOL
2079 TYPE(T_EBCS_TAB), INTENT(INOUT) :: EBCS_TAB ! ebcs data structure
2080 TYPE (LOADS_), INTENT(INOUT) :: LOADS ! load data structure
2081C-----------------------------------------------
2082C F u n c t i o n
2083C-----------------------------------------------
2084 INTEGER NLOCAL
2085 EXTERNAL NLOCAL
2086C-----------------------------------------------
2087C L o c a l V a r i a b l e s
2088C-----------------------------------------------
2089 INTEGER I, J, K, N, IDEB, OFF, OFFC, OFFTG, K1, K3, NL, NUMLOADP,
2090 . n1, n2, n3, n4, nn, p, nl_l, is, nn_s, iad, ity,
2091 . work(70000)
2092
2093 INTEGER, DIMENSION(:), ALLOCATABLE :: ADSKY, ITRI, INDEX
2094 INTEGER :: IJK,NUMBER_NODE
2095 INTEGER :: NELEM,ELEM_ID,NODE_ID
2096 INTEGER :: SURF_ID ! surface id
2097 INTEGER :: LOCAL_SEGMENT,NUMBER_SEGMENT ! number of segment for /LOAD
2098 INTEGER :: PROC_ID ! processor id
2099 LOGICAL :: IS_EBCS_PARALLEL
2100C-----------------------------------------------
2101C S o u r c e L i n e s
2102C-----------------------------------------------
2103C CALCUL DE CNE ADDCNE
2104C-----------------------------------------------
2105 ALLOCATE(adsky(0:numnod+1))
2106 ALLOCATE(itri(ilen))
2107 ALLOCATE(index(2*ilen))
2108 DO i = 0, numnod+1
2109 adsky(i) = addcne(i)
2110 ENDDO
2111C
2112C tri des elements locaux suivants num user
2113C
2114 DO i = 1, numels
2115 itri(i) = ixs(11,i)
2116 ENDDO
2117C rajout condition type element solide
2118 CALL my_orders(0,work,itri,index,numels8,1)
2119 ideb = numels8+1
2120 IF(numels10>0)
2121 . CALL my_orders(0,work,itri(ideb),index(ideb),numels10,1)
2122C
2123 DO j=1, numels10
2124 index(ideb+j-1) = index(ideb+j-1)+numels8
2125 ENDDO
2126C
2127 ideb = ideb + numels10
2128 IF(numels20>0)
2129 . CALL my_orders(0,work,itri(ideb),index(ideb),numels20,1)
2130C
2131 DO j=1, numels20
2132 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10
2133 ENDDO
2134C
2135 ideb = ideb + numels20
2136 IF(numels16>0)
2137 . CALL my_orders(0,work,itri(ideb),index(ideb),numels16,1)
2138C
2139 DO j=1, numels16
2140 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10+numels20
2141 ENDDO
2142C
2143 DO j=1,numels
2144 i = index(j)
2145 DO k=1,8
2146 n = ixs(k+1,i)
2147 IF(n/=0) THEN
2148 cne(adsky(n)) = i
2149 adsky(n) = adsky(n) + 1
2150 ENDIF
2151 ENDDO
2152 ENDDO
2153C
2154 IF(numels10>0) THEN
2155 DO j=1,numels10
2156 i = index(numels8+j)
2157 DO k=1,6
2158 n = ixs10(k,i-numels8)
2159 IF(n/=0) THEN
2160 cne(adsky(n)) = i
2161 adsky(n) = adsky(n) + 1
2162 ENDIF
2163 ENDDO
2164 ENDDO
2165 ENDIF
2166 IF(numels20>0)THEN
2167 DO j=1,numels20
2168 i = index(numels8+numels10+j)
2169 DO k=1,12
2170 n = ixs20(k,i-numels8-numels10)
2171 IF(n/=0) THEN
2172 cne(adsky(n)) = i
2173 adsky(n) = adsky(n) + 1
2174 ENDIF
2175 ENDDO
2176 ENDDO
2177 ENDIF
2178C
2179 IF(numels16>0)THEN
2180 DO j=1,numels16
2181 i = index(numels8+numels10+numels20+j)
2182 DO k=1,8
2183 n = ixs16(k,i-numels8-numels10-numels20)
2184 IF(n/=0) THEN
2185 cne(adsky(n)) = i
2186 adsky(n) = adsky(n) + 1
2187 ENDIF
2188 ENDDO
2189 ENDDO
2190 ENDIF
2191C
2192 off = numels
2193C
2194 DO i = 1, numelq
2195 itri(i) = ixq(7,i)
2196 ENDDO
2197 CALL my_orders(0,work,itri,index,numelq,1)
2198 DO j=1,numelq
2199 i = index(j)
2200 DO k=1,4
2201 n = ixq(k+1,i)
2202 cne(adsky(n)) = i+off
2203 adsky(n) = adsky(n) + 1
2204 ENDDO
2205 ENDDO
2206 off = off + numelq
2207C
2208C tri des elements locaux suivants num user
2209C
2210 DO i = 1, numelc
2211 itri(i) = ixc(7,i)
2212 ENDDO
2213 CALL my_orders(0,work,itri,index,numelc,1)
2214 DO j=1,numelc
2215 i = index(j)
2216 DO k=1,4
2217 n = ixc(k+1,i)
2218 cne(adsky(n)) = i+off
2219 adsky(n) = adsky(n) + 1
2220 ENDDO
2221 ENDDO
2222 offc = off
2223 off = off + numelc
2224C
2225 DO i = 1, numelt
2226 itri(i) = ixt(5,i)
2227 ENDDO
2228 CALL my_orders(0,work,itri,index,numelt,1)
2229 DO j=1,numelt
2230 i = index(j)
2231 DO k=1,2
2232 n = ixt(k+1,i)
2233 cne(adsky(n)) = i+off
2234 adsky(n) = adsky(n) + 1
2235 ENDDO
2236 ENDDO
2237 off = off + numelt
2238C
2239 DO i = 1, numelp
2240 itri(i) = ixp(6,i)
2241 ENDDO
2242 CALL my_orders(0,work,itri,index,numelp,1)
2243 DO j=1,numelp
2244 i = index(j)
2245 DO k=1,2
2246 n = ixp(k+1,i)
2247 cne(adsky(n)) = i+off
2248 adsky(n) = adsky(n) + 1
2249 ENDDO
2250 ENDDO
2251 off = off + numelp
2252C
2253 DO i = 1, numelr
2254 itri(i) = ixr(6,i)
2255 ENDDO
2256 CALL my_orders(0,work,itri,index,numelr,1)
2257 DO j=1,numelr
2258 i = index(j)
2259 DO k=1,2
2260 n = ixr(k+1,i)
2261 cne(adsky(n)) = i+off
2262 adsky(n) = adsky(n) + 1
2263 ENDDO
2264 IF(nint(geo(12,ixr(1,i)))==12) THEN
2265 n = ixr(4,i)
2266 cne(adsky(n)) = i+off
2267 adsky(n) = adsky(n) + 1
2268 ENDIF
2269 ENDDO
2270 off = off + numelr
2271C
2272 DO i = 1, numeltg
2273 itri(i) = ixtg(6,i)
2274 ENDDO
2275C rajout condition type element triangle
2276 CALL my_orders(0,work,itri,index,numeltg-numeltg6,1)
2277 ideb = numeltg-numeltg6+1
2278 IF (numeltg6/=0)
2279 . CALL my_orders(0,work,itri(ideb),index(ideb),numeltg6,1)
2280 DO j=1, numeltg6
2281 index(ideb+j-1) = index(ideb+j-1)+numeltg-numeltg6
2282 ENDDO
2283C
2284 DO j=1,numeltg
2285 i = index(j)
2286 DO k=1,3
2287 n = ixtg(k+1,i)
2288 cne(adsky(n)) = i+off
2289 adsky(n) = adsky(n) + 1
2290 ENDDO
2291 ENDDO
2292C
2293 IF(numeltg6>0)THEN
2294 DO j=1,numeltg6
2295 i = index(numeltg-numeltg6+j)
2296 DO k=1,3
2297 n = ixtg6(k,i-numeltg+numeltg6)
2298 IF(n/=0) THEN
2299 cne(adsky(n)) = i
2300 adsky(n) = adsky(n) + 1
2301 ENDIF
2302 ENDDO
2303 ENDDO
2304 ENDIF
2305C
2306 offtg = off
2307 off = off + numeltg
2308 off = off + numelx
2309C
2310C---------------------------------------------
2311C mv
2312 IF (nvolu>0) THEN
2313 k1 = 1
2314 DO n = 1, nvolu
2315 is = t_monvol(n)%EXT_SURFID
2316 nn_s= igrsurf(is)%NSEG
2317 DO j = 1, nn_s
2318 ity= igrsurf(is)%ELTYP(j)
2319 i = igrsurf(is)%ELEM(j)
2320 IF (ity==3) THEN
2321 DO k = 2,5
2322 nn = ixc(k,i)
2323 cne(adsky(nn)) = i+offc
2324 adsky(nn) = adsky(nn) + 1
2325 ENDDO
2326 ELSE
2327 DO k=2,4
2328 nn = ixtg(k,i)
2329 cne(adsky(nn)) = i+offtg
2330 adsky(nn) = adsky(nn) + 1
2331 END DO
2332 ENDIF
2333 ENDDO
2334 k1 = k1 + nimv
2335 ENDDO
2336 ENDIF
2337C-----------------------------------------------
2338C pseudo element BCL
2339C-----------------------------------------------
2340 IF(nconld>0) THEN
2341 DO nl = 1, nconld
2342 n1=ib(1,nl)
2343 n2=ib(2,nl)
2344 n3=ib(3,nl)
2345 n4=ib(4,nl)
2346 nn = n1
2347 cne(adsky(nn)) = nl+off
2348 adsky(nn) = adsky(nn) + 1
2349 IF(n4/=-1)THEN
2350 nn = n2
2351 cne(adsky(nn)) = nl+off
2352 adsky(nn) = adsky(nn) + 1
2353 IF(n2d==0)THEN
2354 nn = n3
2355 cne(adsky(nn)) = nl+off
2356 adsky(nn) = adsky(nn) + 1
2357 IF(n4/=0) THEN
2358 nn = n4
2359 cne(adsky(nn)) = nl+off
2360 adsky(nn) = adsky(nn) + 1
2361 ENDIF
2362 ENDIF
2363 ENDIF
2364 ENDDO
2365 ENDIF
2366C-----------------------------------------------
2367C pseudo element BCL : affectation a un proc
2368C-----------------------------------------------
2369 IF(nconld>0) THEN
2370 DO nl = 1, nconld
2371 n1=ib(1,nl)
2372 n2=ib(2,nl)
2373 n3=ib(3,nl)
2374 n4=ib(4,nl)
2375 IF(n4/=-1)THEN
2376 IF(n2d==0)THEN
2377 IF(n4/=0) THEN
2378 DO p = 1, nspmd
2379 IF(nlocal(n1,p)==1.AND.
2380 + nlocal(n2,p)==1.AND.
2381 + nlocal(n3,p)==1.AND.
2382 + nlocal(n4,p)==1)THEN
2383 cep(nl+off) = p-1
2384 GOTO 9
2385 ENDIF
2386 ENDDO
2387 9 CONTINUE
2388 ELSE
2389 DO p = 1, nspmd
2390 IF(nlocal(n1,p)==1.AND.
2391 + nlocal(n2,p)==1.AND.
2392 + nlocal(n3,p)==1)THEN
2393 cep(nl+off) = p-1
2394 GOTO 99
2395 ENDIF
2396 ENDDO
2397 99 CONTINUE
2398 ENDIF
2399 ELSE
2400 DO p = 1, nspmd
2401 IF(nlocal(n1,p)==1.AND.
2402 + nlocal(n2,p)==1)THEN
2403 cep(nl+off) = p-1
2404 GOTO 999
2405 ENDIF
2406 ENDDO
2407 999 CONTINUE
2408 ENDIF
2409 ELSE
2410 DO p = 1, nspmd
2411 IF(nlocal(n1,p)==1) THEN
2412 cep(nl+off) = p-1
2413 GOTO 9999
2414 ENDIF
2415 ENDDO
2416 9999 CONTINUE
2417 ENDIF
2418 ENDDO
2419 off = off + nconld
2420 ENDIF
2421C
2422C-----------------------------------------------
2423C pseudo element BC for heat transfert
2424C-----------------------------------------------
2425 IF(numconv>0) THEN
2426 DO nl = 1, numconv
2427 n1=ibcv(1,nl)
2428 n2=ibcv(2,nl)
2429 n3=ibcv(3,nl)
2430 n4=ibcv(4,nl)
2431 nn = n1
2432 cne(adsky(nn)) = nl+off
2433 adsky(nn) = adsky(nn) + 1
2434 IF(n4/=-1)THEN
2435 nn = n2
2436 cne(adsky(nn)) = nl+off
2437 adsky(nn) = adsky(nn) + 1
2438 IF(n2d==0)THEN
2439 nn = n3
2440 cne(adsky(nn)) = nl+off
2441 adsky(nn) = adsky(nn) + 1
2442 IF(n4/=0) THEN
2443 nn = n4
2444 cne(adsky(nn)) = nl+off
2445 adsky(nn) = adsky(nn) + 1
2446 ENDIF
2447 ENDIF
2448 ENDIF
2449 ENDDO
2450 ENDIF
2451
2452C-----------------------------------------------
2453C pseudo element BC for heat transfert : affectation a un proc
2454C-----------------------------------------------
2455 IF(numconv>0) THEN
2456 DO nl = 1, numconv
2457 n1=ibcv(1,nl)
2458 n2=ibcv(2,nl)
2459 n3=ibcv(3,nl)
2460 n4=ibcv(4,nl)
2461 IF(ibcv(7,nl) == 1) THEN
2462 p = cep(ibcv(8,nl))
2463 cep(nl+off) = p
2464 ELSE
2465 IF(n2d==0)THEN
2466 IF(n4/=0) THEN
2467 DO p = 1, nspmd
2468 IF(nlocal(n1,p)==1.AND.
2469 + nlocal(n2,p)==1.AND.
2470 + nlocal(n3,p)==1.AND.
2471 + nlocal(n4,p)==1)THEN
2472 cep(nl+off) = p-1
2473 GOTO 1
2474 ENDIF
2475 ENDDO
2476 1 CONTINUE
2477 ELSE
2478 DO p = 1, nspmd
2479 IF(nlocal(n1,p)==1.AND.
2480 + nlocal(n2,p)==1.AND.
2481 + nlocal(n3,p)==1)THEN
2482 cep(nl+off) = p-1
2483 GOTO 11
2484 ENDIF
2485 ENDDO
2486 11 CONTINUE
2487 ENDIF
2488 ELSE
2489 DO p = 1, nspmd
2490 IF(nlocal(n1,p)==1.AND.
2491 + nlocal(n2,p)==1)THEN
2492 cep(nl+off) = p-1
2493 GOTO 111
2494 ENDIF
2495 ENDDO
2496 111 CONTINUE
2497 ENDIF
2498 ENDIF
2499 ENDDO
2500 off = off + numconv
2501 ENDIF
2502C
2503C-----------------------------------------------
2504C pseudo element BC for radiative heat transfert
2505C-----------------------------------------------
2506 IF(numradia>0) THEN
2507 DO nl = 1, numradia
2508 n1=ibcr(1,nl)
2509 n2=ibcr(2,nl)
2510 n3=ibcr(3,nl)
2511 n4=ibcr(4,nl)
2512 nn = n1
2513 cne(adsky(nn)) = nl+off
2514 adsky(nn) = adsky(nn) + 1
2515 nn = n2
2516 cne(adsky(nn)) = nl+off
2517 adsky(nn) = adsky(nn) + 1
2518 IF(n2d==0)THEN
2519 nn = n3
2520 cne(adsky(nn)) = nl+off
2521 adsky(nn) = adsky(nn) + 1
2522 IF(n4/=0) THEN
2523 nn = n4
2524 cne(adsky(nn)) = nl+off
2525 adsky(nn) = adsky(nn) + 1
2526 ENDIF
2527 ENDIF
2528 ENDDO
2529 ENDIF
2530C-----------------------------------------------
2531C pseudo element BC for heat transfert : affectation a un proc
2532C-----------------------------------------------
2533 IF(numradia>0) THEN
2534 DO nl = 1, numradia
2535 n1=ibcr(1,nl)
2536 n2=ibcr(2,nl)
2537 n3=ibcr(3,nl)
2538 n4=ibcr(4,nl)
2539 IF(ibcr(7,nl) == 1) THEN
2540 p = cep(ibcr(8,nl))
2541 cep(nl+off) = p
2542 ELSE
2543 IF(n2d==0)THEN
2544 IF(n4/=0) THEN
2545 DO p = 1, nspmd
2546 IF(nlocal(n1,p)==1.AND.
2547 + nlocal(n2,p)==1.AND.
2548 + nlocal(n3,p)==1.AND.
2549 + nlocal(n4,p)==1)THEN
2550 cep(nl+off) = p-1
2551 GOTO 2
2552 ENDIF
2553 ENDDO
2554 2 CONTINUE
2555 ELSE
2556 DO p = 1, nspmd
2557 IF(nlocal(n1,p)==1.AND.
2558 + nlocal(n2,p)==1.AND.
2559 + nlocal(n3,p)==1)THEN
2560 cep(nl+off) = p-1
2561 GOTO 22
2562 ENDIF
2563 ENDDO
2564 22 CONTINUE
2565 ENDIF
2566 ELSE
2567 DO p = 1, nspmd
2568 IF(nlocal(n1,p)==1.AND.
2569 + nlocal(n2,p)==1)THEN
2570 cep(nl+off) = p-1
2571 GOTO 222
2572 ENDIF
2573 ENDDO
2574 222 CONTINUE
2575 ENDIF
2576 ENDIF
2577 ENDDO
2578 off = off + numradia
2579 ENDIF
2580C-----------------------------------------------
2581C pseudo element BC for imposed heat flux
2582C-----------------------------------------------
2583 IF(nfxflux>0) THEN
2584 DO nl = 1, nfxflux
2585 IF(ibfflux(10,nl) == 1) cycle
2586 n1=ibfflux(1,nl)
2587 n2=ibfflux(2,nl)
2588 n3=ibfflux(3,nl)
2589 n4=ibfflux(4,nl)
2590 nn = n1
2591 cne(adsky(nn)) = nl+off
2592 adsky(nn) = adsky(nn) + 1
2593 IF(n4/=-1)THEN
2594 nn = n2
2595 cne(adsky(nn)) = nl+off
2596 adsky(nn) = adsky(nn) + 1
2597 IF(n2d==0)THEN
2598 nn = n3
2599 cne(adsky(nn)) = nl+off
2600 adsky(nn) = adsky(nn) + 1
2601 IF(n4/=0) THEN
2602 nn = n4
2603 cne(adsky(nn)) = nl+off
2604 adsky(nn) = adsky(nn) + 1
2605 ENDIF
2606 ENDIF
2607 ENDIF
2608 ENDDO
2609 ENDIF
2610
2611C-----------------------------------------------
2612C pseudo element BC for heat transfert : affectation a un proc
2613C-----------------------------------------------
2614 IF(nfxflux>0) THEN
2615 DO nl = 1, nfxflux
2616 IF(ibfflux(10,nl) == 0) THEN
2617C SURFACIC FLUX
2618 n1=ibfflux(1,nl)
2619 n2=ibfflux(2,nl)
2620 n3=ibfflux(3,nl)
2621 n4=ibfflux(4,nl)
2622 IF(n2d==0)THEN
2623 IF(n4/=0) THEN
2624 DO p = 1, nspmd
2625 IF(nlocal(n1,p)==1.AND.
2626 + nlocal(n2,p)==1.AND.
2627 + nlocal(n3,p)==1.AND.
2628 + nlocal(n4,p)==1)THEN
2629 cep(nl+off) = p-1
2630 GOTO 3
2631 ENDIF
2632 ENDDO
2633 3 CONTINUE
2634 ELSE
2635 DO p = 1, nspmd
2636 IF(nlocal(n1,p)==1.AND.
2637 + nlocal(n2,p)==1.AND.
2638 + nlocal(n3,p)==1)THEN
2639 cep(nl+off) = p-1
2640 GOTO 33
2641 ENDIF
2642 ENDDO
2643 33 CONTINUE
2644 ENDIF
2645 ELSE
2646 DO p = 1, nspmd
2647 IF(nlocal(n1,p)==1.AND.nlocal(n2,p)==1)THEN
2648 cep(nl+off) = p-1
2649 GOTO 333
2650 ENDIF
2651 ENDDO
2652 333 CONTINUE
2653 ENDIF
2654C VOLUMIC FLUX
2655 ELSEIF(ibfflux(10,nl) == 1) THEN
2656c N1 = IBFFLUX(1,NL)
2657 n1 = ibfflux(8,nl)
2658 ibfflux(2,nl) = 0
2659 IF(nspmd > 1) THEN
2660 ibfflux(1,nl) = cel(n1)
2661 ibfflux(2,nl) = cep(n1)
2662 ENDIF
2663 cep(nl+off) = cep(n1)
2664 ENDIF
2665 ENDDO
2666 off = off + nfxflux
2667 ENDIF
2668C-----------------------------------------------
2669C pseudo element BCL
2670C-----------------------------------------------
2671 IF(nloadp>0) THEN
2672 numloadp=0
2673 DO nl = 1, nloadp
2674 DO i = 1,iloadp(1,nl)/4
2675 n1=lloadp(iloadp(4,nl)+4*(i-1))
2676 n2=lloadp(iloadp(4,nl)+4*(i-1)+1)
2677 n3=lloadp(iloadp(4,nl)+4*(i-1)+2)
2678 n4=lloadp(iloadp(4,nl)+4*(i-1)+3)
2679 nn = n1
2680 cne(adsky(nn)) = off+numloadp+i
2681 adsky(nn) = adsky(nn) + 1
2682 IF(n4/=-1)THEN
2683 nn = n2
2684 cne(adsky(nn)) = off+numloadp+i
2685 adsky(nn) = adsky(nn) + 1
2686 IF(n2d==0)THEN
2687 nn = n3
2688 cne(adsky(nn)) = off+numloadp+i
2689 adsky(nn) = adsky(nn) + 1
2690 IF(n4/=0) THEN
2691 nn = n4
2692 cne(adsky(nn)) = off+numloadp+i
2693 adsky(nn) = adsky(nn) + 1
2694 ENDIF
2695 ENDIF
2696 ENDIF
2697 ENDDO
2698 numloadp=numloadp+iloadp(1,nl)/4
2699 ENDDO
2700 ENDIF
2701C-----------------------------------------------
2702C pseudo element LLOADP : affectation a un proc
2703C-----------------------------------------------
2704 IF(nloadp>0) THEN
2705 DO nl = 1, nloadp
2706 DO i = 1,iloadp(1,nl)/4
2707 n1=lloadp(iloadp(4,nl)+4*(i-1))
2708 n2=lloadp(iloadp(4,nl)+4*(i-1)+1)
2709 n3=lloadp(iloadp(4,nl)+4*(i-1)+2)
2710 n4=lloadp(iloadp(4,nl)+4*(i-1)+3)
2711 IF(n4/=-1)THEN
2712 IF(n2d==0)THEN
2713 IF(n4/=0) THEN
2714 DO p = 1, nspmd
2715 IF(nlocal(n1,p)==1.AND.
2716 + nlocal(n2,p)==1.AND.
2717 + nlocal(n3,p)==1.AND.
2718 + nlocal(n4,p)==1)THEN
2719 cep(i+off) = p-1
2720 GOTO 4
2721 ENDIF
2722 ENDDO
2723 4 CONTINUE
2724 ELSE
2725 DO p = 1, nspmd
2726 IF(nlocal(n1,p)==1.AND.
2727 + nlocal(n2,p)==1.AND.
2728 + nlocal(n3,p)==1)THEN
2729 cep(i+off) = p-1
2730 GOTO 44
2731 ENDIF
2732 ENDDO
2733 44 CONTINUE
2734 ENDIF
2735 ELSE
2736 DO p = 1, nspmd
2737 IF(nlocal(n1,p)==1.AND.
2738 + nlocal(n2,p)==1)THEN
2739 cep(i+off) = p-1
2740 GOTO 444
2741 ENDIF
2742 ENDDO
2743 444 CONTINUE
2744 ENDIF
2745 ELSE
2746 DO p = 1, nspmd
2747 IF(nlocal(n1,p)==1) THEN
2748 cep(i+off) = p-1
2749 GOTO 4444
2750 ENDIF
2751 ENDDO
2752 4444 CONTINUE
2753 ENDIF
2754 ENDDO
2755 off = off + iloadp(1,nl)/4
2756 ENDDO
2757 ENDIF
2758
2759! -------------------------------------
2760! Euler boundary conditions : non-relecting frontier
2761! ------------
2762 IF(nebcs>0) THEN
2763 DO i=1,nebcs
2764 is_ebcs_parallel = .false.
2765 IF(ebcs_tab%tab(i)%poly%type == 10 .or. ebcs_tab%tab(i)%poly%type == 11)is_ebcs_parallel=.true.
2766 IF(is_ebcs_parallel) THEN
2767 surf_id = ebcs_tab%tab(i)%poly%surf_id ! surface id
2768 number_node = 4
2769 IF(n2d /= 0) number_node = 2
2770
2771 ! ------------
2772 ! loop over the elements of the EBCS
2773 DO j=1,ebcs_tab%tab(i)%poly%nb_elem
2774 ! loop over the 4 nodes of the surfaces
2775 elem_id = ebcs_tab%tab(i)%poly%ielem(j) ! element id
2776 DO ijk=1,number_node
2777 node_id = igrsurf(surf_id)%NODES(j,ijk) ! node id
2778 cne(adsky(node_id)) = elem_id ! element id
2779 adsky(node_id) = adsky(node_id) + 1
2780 ENDDO
2781 ENDDO
2782 ! ------------
2783 ENDIF
2784 ENDDO
2785 ENDIF
2786! -------------------------------------
2787
2788! -------------------------------------
2789! /LOAD/PCYL : add 1 contribution per node per segment
2790! ------------
2791 ! loop over the /load/pcyl
2792 local_segment = 0
2793 DO i=1,loads%NLOAD_CYL
2794 number_segment = loads%LOAD_CYL(i)%NSEG ! number of segment for the PCYL I
2795 ! ------------
2796 ! loop over the segments of the surface to find where the node are defined
2797 DO j=1,number_segment ! loop over the segments of the surface
2798 proc_id = loads%CYL_RESTART(i)%SEGMENT_TO_PROC(j)
2799 DO k=1,4
2800 node_id = loads%LOAD_CYL(i)%SEGNOD(j,k) ! get the node id (if the segment is a triangle, NODE_ID(node 4) = 0))
2801 IF(node_id/=0) THEN
2802 cep(off+local_segment+j) = proc_id - 1 ! force the proc for the fake element
2803 cne(adsky(node_id)) = off+local_segment+j ! fake element id
2804 adsky(node_id) = adsky(node_id) + 1
2805 ENDIF
2806 ENDDO
2807 ENDDO
2808 local_segment = local_segment + number_segment
2809 ! ------------
2810 ENDDO
2811! -------------------------------------
2812 DEALLOCATE(adsky)
2813 DEALLOCATE(itri)
2814 DEALLOCATE(index)
2815
2816 RETURN
2817 END
2818C
2819!||====================================================================
2820!|| fillcni2 ../starter/source/spmd/domdec2.F
2821!||--- called by ------------------------------------------------------
2822!|| lectur ../starter/source/starter/lectur.F
2823!||--- uses -----------------------------------------------------
2824!||====================================================================
2825 SUBROUTINE fillcni2(
2826 1 CNI2 ,LCNI2 ,ADDCNI2, IPARI, INTBUF_TAB)
2827C-----------------------------------------------
2828C M o d u l e s
2829C-----------------------------------------------
2830 USE intbufdef_mod
2831C-----------------------------------------------
2832C I m p l i c i t T y p e s
2833C-----------------------------------------------
2834#include "implicit_f.inc"
2835C-----------------------------------------------
2836C C o m m o n B l o c k s
2837C-----------------------------------------------
2838#include "com01_c.inc"
2839#include "com04_c.inc"
2840#include "param_c.inc"
2841C-----------------------------------------------
2842C D u m m y A r g u m e n t s
2843C-----------------------------------------------
2844 INTEGER ADDCNI2(0:*), CNI2(*),
2845 . LCNI2, IPARI(NPARI,NINTER)
2846
2847 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2848C-----------------------------------------------
2849C L o c a l V a r i a b l e s
2850C-----------------------------------------------
2851 INTEGER I, J, L, K, N, OFF, NTY, NRTS, NRTM, NSN, NMN,
2852 . KK, NIR
2853 INTEGER, DIMENSION(:), ALLOCATABLE :: ADSKYI2 !(0:NUMNOD+1)
2854C-----------------------------------------------
2855C S o u r c e L i n e s
2856C-----------------------------------------------
2857C CALCUL DE CNE ADDCNE
2858C-----------------------------------------------
2859 ALLOCATE(adskyi2(0:numnod+1))
2860 DO i = 0, numnod+1
2861 adskyi2(i) = addcni2(i)
2862 ENDDO
2863C
2864C ordre => ordre des elements dans l'interface type 2
2865C
2866C
2867 off = 0
2868 IF (n2d==0) THEN
2869 nir = 4
2870 ELSE
2871 nir = 2
2872 ENDIF
2873 DO n = 1, ninter
2874 nty = ipari(7,n)
2875 IF (nty==2) THEN
2876 nrts = ipari(3,n)
2877 nrtm = ipari(4,n)
2878 nsn = ipari(5,n)
2879 nmn = ipari(6,n)
2880 DO i=1,nsn
2881 l = intbuf_tab(n)%IRTLM(i)
2882 k = intbuf_tab(n)%NSV(i)
2883 DO j=1,nir
2884 kk = intbuf_tab(n)%IRECTM((l-1)*4+j)
2885 cni2(adskyi2(kk)) = off+i
2886 adskyi2(kk) = adskyi2(kk) + 1
2887 END DO
2888 END DO
2889 off = off + nsn
2890 END IF
2891 END DO
2892 DEALLOCATE(adskyi2)
2893C
2894 RETURN
2895 END
2896C
2897!||====================================================================
2898!|| ddprint ../starter/source/spmd/domdec2.F
2899!||--- called by ------------------------------------------------------
2900!|| lectur ../starter/source/starter/lectur.F
2901!||====================================================================
2902 SUBROUTINE ddprint(DDSTAT, MEMFLOW)
2903C-----------------------------------------------
2904C I m p l i c i t T y p e s
2905C-----------------------------------------------
2906#include "implicit_f.inc"
2907C-----------------------------------------------
2908C C o m m o n B l o c k s
2909C-----------------------------------------------
2910#include "com01_c.inc"
2911#include "com04_c.inc"
2912#include "commandline.inc"
2913#include "units_c.inc"
2914#include "sphcom.inc"
2915#include "scr05_c.inc"
2916C-----------------------------------------------
2917C D u m m y A r g u m e n t s
2918C-----------------------------------------------
2919 INTEGER DDSTAT(50,*)
2920 INTEGER(KIND=8) :: MEMFLOW(2,*)
2921C DDSTAT
2922C 1 : NUMNOD Local
2923C 2 : NELEM Local
2924C 3 : NUMELS_L
2925C 4 : NUMELQ_L
2926C 5 : NUMELC_L
2927C 6 : NUMELP_L
2928C 7 : NUMELT_L
2929C 8 : NUMELR_L
2930C 9 : -
2931C 10: NUMELTG_L
2932C 11: NUMELX_L
2933C 12: NBDDPROC : nb de proc frontiere
2934C 13: NBDDBOUN : nb de noeud frontiere
2935C 14: NBDDNOD : taille des comm en nb de noeuds
2936C 15: NBDDNRB : taille des comm en nb de noeuds main de rby
2937C 16: NRBYKIN_L : nombre de rigid body MAIN locaux
2938C 17: NUMSPH_L : nombre de particules SPH locales
2939C 18: MEMI : taille memoire locale entier MA
2940C 19: MEMR : taille memoire locale reel AM
2941C 20: NSNT_L : nombre de noeuds SECONDARYs d'interface de contact (7,10,11)
2942C 21: NMNT_L : nombre de noeuds MAIN d'interface de contact (7,10,11)
2943C 22: NSNT2_L : nombre de noeuds SECONDARYs d'interface type2
2944C 23: NMNT2_L : nombre de noeuds MAIN d'interface type2
2945C 24: RESTSIZE : Taille du restart en MB
2946C 24: NSLARB_L : nombre de noeuds SECONDARY rigid body
2947C-----------------------------------------------
2948C L o c a l V a r i a b l e s
2949C-----------------------------------------------
2950 INTEGER P, NACTIVE, J
2951 INTEGER (KIND=8) MEMTOTAL,RTOBYTES,ITOBYTES,MBYTE
2952 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE ::AVERAGE,DEVIATION
2953 INTEGER STAVALUE
2954C-----------------------------------------------
2955 NACTIVE=50
2956C Double of float to Bytes conversion
2957C In double precision : one double = 8 bytes
2958C In single precision : one float = 4 bytes
2959 allocate( average(nactive) )
2960 ALLOCATE( deviation(nactive) )
2961 mbyte=1024*1024
2962 IF (iresp==1) THEN
2963 rtobytes = 4
2964 ELSE
2965 rtobytes = 8
2966 ENDIF
2967 itobytes = 4
2968
2969C
2970 IF(nspmd>1) THEN
2971 DO j=1, nactive
2972 average(j)=zero
2973 deviation(j)=zero
2974 END DO
2975 DO p=1,nspmd
2976 DO j=1, nactive
2977 average(j) = average(j) + ddstat(j,p)
2978 END DO
2979 ENDDO
2980 DO j=1, nactive
2981 average(j) = average(j) / nspmd
2982 END DO
2983C
2984 DO p=1,nspmd
2985 DO j=1, nactive
2986 deviation(j) = deviation(j) + (ddstat(j,p)-average(j))**2
2987 END DO
2988 ENDDO
2989 DO j=1, nactive
2990 deviation(j) = sqrt(deviation(j)/nspmd)
2991 END DO
2992
2993 WRITE(iout,*)
2994 WRITE(iout,*)
2995 WRITE(iout,*)'STATISTICS ON DOMAIN DECOMPOSITION '
2996 WRITE(iout,*)'---------------------------------- '
2997 WRITE(IOUT,*)
2998 WRITE(IOUT,'(a,i6)')
2999 . 'average nb. of boundary nodes :',NINT(AVERAGE(13))
3000 WRITE(IOUT,'(a,i6)')
3001 . 'standard deviation :',NINT(DEVIATION(13))
3002 WRITE(IOUT,*)
3003 WRITE(IOUT,'(a,i8)')
3004 . 'average number of local nodes :',NINT(AVERAGE(1))
3005 WRITE(IOUT,'(a,i8)')
3006 . 'standard deviation :',NINT(DEVIATION(1))
3007 WRITE(IOUT,*)
3008 IF(AVERAGE(20)+AVERAGE(21) >= ONE)THEN
3009 WRITE(IOUT,'(a,i8,a3,i8)')
3010 . 'average nb. of contact nodes(secondary/main) :',
3011 . NINT(AVERAGE(20)),' / ',NINT(AVERAGE(21))
3012 WRITE(IOUT,'(a,i8,a3,i8)')
3013 . 'standard deviation :',
3014 . NINT(DEVIATION(20)),' / ',NINT(DEVIATION(21))
3015 WRITE(IOUT,*)
3016 END IF
3017
3018 IF(AVERAGE(22)+AVERAGE(23) >= ONE)THEN
3019 WRITE(IOUT,'(a,i8,a3,i8)')
3020 . 'average nb. of int2 nodes(secondary/main):',
3021 . NINT(AVERAGE(22)),' / ',NINT(AVERAGE(23))
3022 WRITE(IOUT,'(a,i8,a3,i8)')
3023 . 'standard deviation :',
3024 . NINT(DEVIATION(22)),' / ',NINT(DEVIATION(23))
3025 WRITE(IOUT,*)
3026 END IF
3027.AND. IF(NUMSPH>0AVERAGE(17) >= ONE) THEN
3028 WRITE(IOUT,'(a,i8,a3,i8)')
3029 . 'average nb. of sph particles :',
3030 . NINT(AVERAGE(17))
3031 WRITE(IOUT,'(a,i8,a3,i8)')
3032 . 'standard deviation :',
3033 . NINT(DEVIATION(17))
3034 WRITE(IOUT,*)
3035 END IF
3036
3037 WRITE(IOUT,*)
3038 . 'proc nb of elts nb of bound. nodes nb of bound. procs'
3039 DO P=1,NSPMD
3040 WRITE(IOUT,1000) P,DDSTAT(2,P),DDSTAT(13,P),DDSTAT(12,P)
3041 ENDDO
3042C
3043 DO P=1,NSPMD
3044 WRITE(IOUT,*)
3045 WRITE(IOUT,'(1x,a,i4)')
3046 . 'domain decomposition summary for spmd processor',P
3047 WRITE(IOUT,*)
3048 . '----------------------------------------------------'
3049 WRITE(IOUT,*) 'number of nodes................. :',DDSTAT(1,P)
3050 IF(NUMELS>0)
3051 . WRITE(IOUT,*)'number of solid elements........ :',DDSTAT(3,P)
3052 IF(NUMELQ>0)
3053 . WRITE(IOUT,*)'number of quad elements......... :',DDSTAT(4,P)
3054 IF(NUMELC>0)
3055 . WRITE(IOUT,*)'number of 4-n shell elements.... :',DDSTAT(5,P)
3056 IF(NUMELP>0)
3057 . WRITE(IOUT,*)'number of beam elements......... :',DDSTAT(6,P)
3058 IF(NUMELT>0)
3059 . WRITE(IOUT,*)'number of truss elements........ :',DDSTAT(7,P)
3060 IF(NUMELR>0)
3061 . WRITE(IOUT,*)'number of spring elements....... :',DDSTAT(8,P)
3062 IF(NUMELTG>0)
3063 . WRITE(IOUT,*)'number of 3-n shell elements.... :',DDSTAT(10,P)
3064 IF(NUMELX>0)
3065 . WRITE(IOUT,*)'number of multipurpose elements. :',DDSTAT(11,P)
3066 WRITE(IOUT,*) 'total number of nodes for comm.. :',DDSTAT(14,P)
3067 IF(NRBYKIN>0)THEN
3068 WRITE(IOUT,*)'number of rigid body components. :',DDSTAT(16,P)
3069 WRITE(IOUT,*)'number of r.b.m. nodes for comm. :',DDSTAT(15,P)
3070 WRITE(IOUT,*)'number of secondary rigid body nodes :',DDSTAT(24,P)
3071 ENDIF
3072 IF(NINTER>0)THEN
3073 WRITE(IOUT,*)'number of int2 secondary nodes...... :',DDSTAT(22,P)
3074 WRITE(IOUT,*)'number of int2 main nodes..... :',DDSTAT(23,P)
3075 WRITE(IOUT,*)'number of contact secondary nodes... :',DDSTAT(20,P)
3076 WRITE(IOUT,*)'number of contact main nodes.. :',DDSTAT(21,P)
3077 END IF
3078 IF(NUMSPH>0)
3079 . WRITE(IOUT,*)'number of smooth particles...... :',DDSTAT(17,P)
3080 WRITE(IOUT,*)
3081 DDSTAT(18,P)=MAX(DDSTAT(18,P),1310720) ! 5 Mo en entiers / 4 bytes
3082 STAVALUE=INT(5242880/RTOBYTES)
3083 DDSTAT(19,P)=MAX(DDSTAT(19,P),STAVALUE) ! 5 Mo en flottants
3084 MEMTOTAL=DDSTAT(19,P)*RTOBYTES + DDSTAT(18,P) * ITOBYTES
3085 IF( GOT_INSPIRE_ALM == 1)THEN
3086 WRITE(IOUT,1201)P,
3087 . DDSTAT(19,P)*RTOBYTES/MBYTE,
3088 . DDSTAT(18,P)*ITOBYTES/MBYTE,
3089 . MEMTOTAL/MBYTE,
3090 . DDSTAT(25,P)/1024
3091 ELSE
3092 WRITE(IOUT,1200)P,
3093 . DDSTAT(19,P)*RTOBYTES/MBYTE,
3094 . DDSTAT(18,P)*ITOBYTES/MBYTE,
3095 . MEMTOTAL/MBYTE,
3096 . DDSTAT(25,P)/1024
3097 ENDIF
3098
3099 IF (NFLOW>0) THEN
3100 WRITE(IOUT,*)
3101 IF( GOT_INSPIRE_ALM == 1)THEN
3102 WRITE(IOUT,'(a)')
3103 .' additional solver storage for bem solutions'
3104 ELSE
3105 WRITE(IOUT,'(a)')
3106 .' additional engine storage for bem solutions'
3107 ENDIF
3108 WRITE(IOUT,'(a)')
3109 .' -------------------------------------------'
3110 MEMTOTAL=MEMTOTAL+MEMFLOW(1,P)*4+MEMFLOW(2,P)*RTOBYTES
3111 WRITE(IOUT,1400) MEMFLOW(2,P)*RTOBYTES/1048576,
3112 * MEMFLOW(1,P)*4/1048576,
3113 * MEMTOTAL/1048576
3114 ENDIF
3115 ENDDO
3116 ELSE
3117 P=1
3118 DDSTAT(18,P)=MAX(DDSTAT(18,P),1310720) ! 5 Mo en entiers / 4 bytes
3119 STAVALUE=INT(5242880/RTOBYTES)
3120 DDSTAT(19,P)=MAX(DDSTAT(19,P),5242880/RTOBYTES) ! 5 Mo en flottants
3121 MEMTOTAL=DDSTAT(19,P)*RTOBYTES+DDSTAT(18,P)*ITOBYTES
3122
3123 IF( GOT_INSPIRE_ALM == 1)THEN
3124 WRITE(IOUT,1201)P,DDSTAT(19,P)*RTOBYTES/1048576,
3125 . DDSTAT(18,P)*4/1048576,
3126 . MEMTOTAL/1048576,
3127 . DDSTAT(25,P)/1024
3128 ELSE
3129 WRITE(IOUT,1200)P,DDSTAT(19,P)*RTOBYTES/1048576,
3130 . DDSTAT(18,P)*4/1048576,
3131 . MEMTOTAL/1048576,
3132 . DDSTAT(25,P)/1024
3133 ENDIF
3134
3135 IF (NFLOW>0) THEN
3136 WRITE(IOUT,*)
3137 IF( GOT_INSPIRE_ALM == 1)THEN
3138 WRITE(IOUT,'(a)')
3139 .' additional solver storage for bem solutions'
3140 ELSE
3141 WRITE(IOUT,'(a)')
3142 .' additional engine storage for bem solutions'
3143 ENDIF
3144 WRITE(IOUT,'(a)')
3145 .' -------------------------------------------'
3146 MEMTOTAL=MEMTOTAL+MEMFLOW(1,P)*4+MEMFLOW(2,P)*RTOBYTES
3147 WRITE(IOUT,1400) MEMFLOW(2,P)*RTOBYTES/1048576,
3148 . MEMFLOW(1,P)*4/1048576,
3149 . MEMTOTAL/1048576
3150 ENDIF
3151 END IF
3152 WRITE(IOUT,*)
3153C
3154 1000 FORMAT(I5,8X,I6,16X,I6,16X,I6)
3155 1200 FORMAT(/,
3156 . ' local engine storage evaluation for spmd processor',I6,/
3157 . ' --------------------------------------------------------'/
3158 . ' memory used for reals ',I10,' mb ',/
3159 . ' memory used for integers',I10,' mb ',/
3160 . ' total memory evaluation ',I10,' mb ',/
3161 . ' '/,
3162 . ' restart file size',I10,' mb')
3163 1201 FORMAT(/,
3164 . ' local solver storage evaluation for spmd processor',I6,/
3165 . ' --------------------------------------------------------'/
3166 . ' memory used for reals ',I10,' mb ',/
3167 . ' memory used for integers',I10,' mb ',/
3168 . ' total memory evaluation ',I10,' mb ',/
3169 . ' '/,
3170 . ' restart file size',I10,' mb')
3171
3172 1300 FORMAT(
3173 . ' nodal fields. . . . . . ',I10,/
3174 . ' condensed data. . . . . ',I10)
3175 1310 FORMAT(
3176 . ' temporary storage . . . ',I10,' -> condensed problem')
3177 1320 FORMAT(
3178 . ' temporary storage . . . ',I10,' -> sup. elem: ',I10)
3179 1340 FORMAT(
3180 . ' new total . . . . . . . ',I10,' mb'/)
3181 1350 FORMAT(
3182 . ' sup. elem modes . . . . ',I10,' mb',/
3183 . ' condensed matrices. . . ',I10,' mb',/
3184 . ' ---------'/
3185 . ' total . . . . . . . . . ',I10,' mb')
3186 1400 FORMAT(
3187 . ' add. memory for reals . ',I10,' mb',/
3188 . ' add. memory for integers',I10,' mb',/
3189 . ' ---------'/
3190 . ' new total . . . . . . . ',I10,' mb'/)
3191C
3192 DEALLOCATE( AVERAGE )
3193 DEALLOCATE( DEVIATION )
3194 RETURN
3195 END
3196!||====================================================================
3197!|| c_doms10 ../starter/source/spmd/domdec2.F
3198!||--- called by ------------------------------------------------------
3199!|| domdec2 ../starter/source/spmd/domdec2.F
3200!||--- calls -----------------------------------------------------
3201!|| ifrontplus ../starter/source/spmd/node/frontplus.F
3202!|| nlocal ../starter/source/spmd/node/ddtools.F
3203!||====================================================================
3204 SUBROUTINE C_DOMS10(ICNDS10,ITAGND,IPLUS)
3205C-----------------------------------------------
3206C I m p l i c i t T y p e s
3207C-----------------------------------------------
3208#include "implicit_f.inc"
3209C-----------------------------------------------
3210C C o m m o n B l o c k s
3211C-----------------------------------------------
3212#include "com04_c.inc"
3213#include "com01_c.inc"
3214C-----------------------------------------------
3215C D u m m y A r g u m e n t s
3216C-----------------------------------------------
3217 INTEGER ICNDS10(3,*),ITAGND(*)
3218C-----------------------------------------------
3219C F u n c t i o n
3220C-----------------------------------------------
3221 INTEGER NLOCAL
3222 EXTERNAL NLOCAL
3223C-----------------------------------------------
3224C L o c a l V a r i a b l e s
3225C-----------------------------------------------
3226 INTEGER N, NN,N1,N2,P,NF,NS,NF0,NFMAX,IPLUS
3227 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGI,NNF
3228C-----------------------------------------------
3229! TAGI->N: NNF(N)=MAX_NF
3230 ALLOCATE( TAGI(NUMNOD),NNF(NS10E) )
3231 TAGI(1:NUMNOD) = 0
3232 NNF(1:NS10E) = 1
3233 IPLUS = 0
3234C-------------only one of the mid-node is chosen (max_nf) for 1er pass---------
3235 DO N = 1, NS10E
3236 NN = ICNDS10(1,N)
3237 IF(ITAGND(NN)>NS10E) CYCLE
3238 N1 = ICNDS10(2,N)
3239 N2 = ICNDS10(3,N)
3240C----- normally N1,N2 are local as NN-----
3241 NF = 0
3242 DO P = 1, NSPMD
3243 NF = NF +NLOCAL(NN,P)
3244 ENDDO
3245 NNF(N) = NF
3246c IF(NF <=1 ) CYCLE
3247 IF (TAGI(N1)==0) THEN
3248 TAGI(N1) = N
3249 ELSE
3250 NS = ICNDS10(1,TAGI(N1))
3251 NF0 = 0
3252 DO P = 1, NSPMD
3253 NF0 = NF0 +NLOCAL(NS,P)
3254 ENDDO
3255 IF (NF>NF0) TAGI(N1)=N
3256 END IF
3257 IF (TAGI(N2)==0) THEN
3258 TAGI(N2) = N
3259 ELSE
3260 NS = ICNDS10(1,TAGI(N2))
3261 NF0 = 0
3262 DO P = 1, NSPMD
3263 NF0 = NF0 +NLOCAL(NS,P)
3264 ENDDO
3265 IF (NF>NF0) TAGI(N2)=N
3266 END IF
3267 END DO
3268C-------------avoid non symmetry M/S S/M--------
3269 DO N = 1, NS10E
3270 NN = ICNDS10(1,N)
3271 IF(ITAGND(NN)>NS10E) CYCLE
3272 N1 = ICNDS10(2,N)
3273 N2 = ICNDS10(3,N)
3274 IF (TAGI(N1)==N) THEN
3275 DO P = 1, NSPMD
3276.AND. IF(NLOCAL(N1,P)==1NLOCAL(NN,P)/=1) CALL IFRONTPLUS(NN,P)
3277 ENDDO
3278 END IF
3279 IF (TAGI(N2)==N) THEN
3280 DO P = 1, NSPMD
3281.AND. IF(NLOCAL(N2,P)==1NLOCAL(NN,P)/=1) CALL IFRONTPLUS(NN,P)
3282 ENDDO
3283 END IF
3284 END DO
3285C-------------3nd pass for the case- in certain proc--(not necessary)-----
3286C DO N = 1, NS10E
3287C NN = ICNDS10(1,N)
3288C IF(ITAGND(NN)>NS10E) CYCLE
3289C N1 = ICNDS10(2,N)
3290C N2 = ICNDS10(3,N)
3291C NFMAX = TAGI(N1)
3292C IF (NFMAX>0.AND.NFMAX/=N) THEN
3293C NS = ICNDS10(1,NFMAX)
3294C NF = 0
3295C DO P = 1, NSPMD
3296C IF(NLOCAL(NN,P)==1.OR.NLOCAL(NS,P)==1) NF = NF + 1
3297C ENDDO
3298C IF (NF > NNF(NFMAX)) THEN
3299C NF0 = 0
3300C DO P = 1, NSPMD
3301C IF(NLOCAL(N1,P)==1) NF0 = NF0 + 1
3302C ENDDO
3303C IF (NF0 > NF) THEN
3304C DO P = 1, NSPMD
3305C IF(NLOCAL(N1,P)==1.AND.NLOCAL(NN,P)/=1) CALL IFRONTPLUS(NN,P)
3306C ENDDO
3307C END IF !(NF0 > NF) THEN
3308C END IF
3309C END IF
3310C NFMAX = TAGI(N2)
3311C IF (NFMAX>0.AND.NFMAX/=N) THEN
3312C NS = ICNDS10(1,NFMAX)
3313C NF = 0
3314C DO P = 1, NSPMD
3315C IF(NLOCAL(NN,P)==1.OR.NLOCAL(NS,P)==1) NF = NF + 1
3316C ENDDO
3317C IF (NF > NNF(NFMAX)) THEN
3318C NF0 = 0
3319C DO P = 1, NSPMD
3320C IF(NLOCAL(N2,P)==1) NF0 = NF0 + 1
3321C ENDDO
3322C IF (NF0 > NF) THEN
3323C DO P = 1, NSPMD
3324C IF(NLOCAL(N2,P)==1.AND.NLOCAL(NN,P)/=1) CALL IFRONTPLUS(NN,P)
3325C ENDDO
3326C END IF !(NF0 > NF) THEN
3327C END IF
3328C END IF
3329C END DO
3330
3331 DO N = 1, NS10E
3332 NN = ICNDS10(1,N)
3333 IF(ITAGND(NN)>NS10E) CYCLE
3334 N1 = ICNDS10(2,N)
3335 N2 = ICNDS10(3,N)
3336 DO P = 1, NSPMD
3337 IF(NLOCAL(NN,P)==1)THEN
3338 IF(NLOCAL(N1,P)/=1) THEN
3339 CALL IFRONTPLUS(N1,P)
3340 IPLUS =1
3341 END IF
3342 IF(NLOCAL(N2,P)/=1) THEN
3343 CALL IFRONTPLUS(N2,P)
3344 IPLUS =1
3345 END IF
3346 END IF
3347 END DO
3348 END DO
3349C ----------------------------
3350 DEALLOCATE( TAGI,NNF )
3351C ----------------------------
3352C
3353 RETURN
3354 END
check_skew
subroutine check_skew(ixr, igeo, iskn, cep, iskwp, nskwp, tag_skn, multiple_skew, r_skew, ipm, offset)
Definition check_skew.F:35
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
domain_decomposition_pcyl
subroutine domain_decomposition_pcyl(loads, iframe)
Definition domain_decomposition_pcyl.F:33
domdec2
subroutine domdec2(dd_iad, ipari, ib, npby, lpby, ixri, ibvel, lbvel, iparg, cel, ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg6, t_monvol, igrsurf, adsky, lcne, geo, nprw, lprw, lcni2, adskyi2, cepi2, celi2, i2nsnt, iskn, iskwp, nskwp, isensp, nsensp, iaccp, naccp, laccelm, ibcv, irbe3, lrbe3, front_rm, irbym, lcrbym, cep, ibcr, irbe2, lrbe2, cepsp, celsph, iloadp, lloadp, lgauge, igaup, ngaup, intbuf_tab, ibfflux, icnds10, itagnd, igeo, tag_skn, multiple_skew, ibfv, ibcscyc, lbcscyc, r_skew, ipm, sensors, len_cep, ebcs_tab, loads, iframe, niconv, niradia, nitflux, numconv, numradia, nfxflux, sensor_user_struct)
Definition domdec2.F:61
fillcni2
subroutine fillcni2(cni2, lcni2, addcni2, ipari, intbuf_tab)
Definition domdec2.F:2827
ddprint
subroutine ddprint(ddstat, memflow)
Definition domdec2.F:2903
fillcne
subroutine fillcne(cne, lcne, ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg6, t_monvol, igrsurf, ib, addcne, cep, ilen, geo, ibcv, ibcr, ibfflux, iloadp, lloadp, cel, ebcs_tab, loads, niconv, niradia, nitflux, numconv, numradia, nfxflux)
Definition domdec2.F:2040
c_doms10
subroutine c_doms10(icnds10, itagnd, iplus)
Definition domdec2.F:3205
ifrontplus
subroutine ifrontplus(n, p)
Definition frontplus.F:100
frontplus_rm
subroutine frontplus_rm(front, index)
Definition frontplus.F:29
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
ale_ebcs_mod
Definition ale_ebcs_mod.F:40
ale_ebcs_mod::nebcs
integer nebcs
Definition ale_ebcs_mod.F:43
front_mod
Definition front_mod.F:84
front_mod::ifront
type(my_front) ifront
Definition front_mod.F:93
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
monvol_struct_mod
Definition monvol_struct_mod.F:66
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
split_joint
subroutine split_joint()
Definition split_joint.F:35
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
nl
character *2 function nl()
Definition message.F:2354
lectur
subroutine lectur(multi_fvm, lsubmodel, is_dyna, detonators, ebcs_tab, seatbelt_converted_elements, nb_seatbelt_shells, nb_dyna_include, user_windows, output, mat_elem, names_and_titles, defaults, glob_therm, pblast, sensor_user_struct)
Definition lectur.F:533
starter
program starter
Definition starter.F:39