OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
w_front.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| w_front ../starter/source/restart/ddsplit/w_front.F
25!||--- called by ------------------------------------------------------
26!|| ddsplit ../starter/source/restart/ddsplit/ddsplit.F
27!||--- calls -----------------------------------------------------
28!|| arret ../starter/source/system/arret.F
29!|| nlocal ../starter/source/spmd/node/ddtools.F
30!|| plist_ifront ../starter/source/spmd/node/ddtools.F
31!||--- uses -----------------------------------------------------
32!|| constraint_mod ../starter/source/modules/constaint_mod.F90
33!|| front_mod ../starter/share/modules1/front_mod.F
34!|| fvbag_mod ../starter/share/modules1/fvbag_mod.F
35!|| split_cfd_mod ../starter/share/modules1/split_cfd_mod.F
36!||====================================================================
37 SUBROUTINE w_front(
38 1 PROC ,NBDDACC ,NBDDKIN ,NODLOCAL,
39 2 NBDDPROC,NBDDBOUN,NODGLOB ,NUMNOD_L,NBDDNRB ,
40 3 NPBY ,LPBY ,NPRW ,LPRW ,LEN_IA ,
41 4 DD_RBY2 ,ITABI2M ,NBDDI2M ,CEP ,MONVOL ,
42 5 NNLINK ,LLLINK ,LJOINT ,
43 6 NBDDNCJ ,IBVEL ,LBVEL ,NBDDNRBM,DD_RBM2 ,
44 7 NSTRF ,NNODT_L ,NNODL_L ,IEXMAD ,ISP0 ,
45 8 NRCVVOIS,NSNDVOIS,NERVOIS ,NESVOIS ,
46 9 NSEGFL_L,IPARG ,
47 A NUMEL ,ALE_CONNECTIVITY ,NBCFD ,IXS ,IXQ , IXTG,
48 B NUMELS_L,NUMELQ_L,NUMELTG_L,CEL ,GEO ,PORNOD ,
49 C NUMPOR_L,NUMEL_L ,IPARI ,INTBUF_TAB,NBI18_L ,
50 D IEXLNK ,IGRNOD ,DD_LAGF ,NLAGF_L ,IADLL ,
51 E LLL ,ISKWP ,NSKWP ,ISENSP ,NSENSP ,
52 F IACCP ,NACCP ,IRBE3 ,LRBE3 ,ITABRBE3M,
53 G NBDDRBE3M,IRBYM ,LCRBYM ,FRONT_RM ,DD_RBYM2,
54 H NBDDNRBYM,IRBE2 ,LRBE2 ,NBDDRBE2,ITABRBE2M,
55 I IEDGE_TMP,NODEDGE,EDGELOCAL,NBDDEDGE_L,
56 J IGAUP ,NGAUP ,FRONTB_R2R,SDD_R2R_ELEM,ADDCSRECT,
57 K CSRECT,NBDDNORT ,NBDDNOR_MAX,NBCCFR25 ,NBCCNOR ,
58 L NUMNOR_L,NBDDEDGT,NBDDEDG_MAX,INTERCEP,NBDDCNDM,
59 M ITABCNDM,MULTI_FVM,IGRSURF,ISKWP_L,ALE_ELM,
60 N SIZE_ALE_ELM,NSENSOR,NLOC_DMG,constraint_struct,ITHERM)
61C-----------------------------------------------
62C M o d u l e s
63C-----------------------------------------------
64 USE fvbag_mod
65 USE front_mod
66 USE intbufdef_mod
67 USE multi_fvm_mod
68 USE groupdef_mod
69 USE split_cfd_mod
70 USE ale_connectivity_mod
71 USE user_windows_mod
72 USE nlocal_reg_mod
73 use constraint_mod , only : constraint_
74C-----------------------------------------------
75C I m p l i c i t T y p e s
76C-----------------------------------------------
77#include "implicit_f.inc"
78C-----------------------------------------------
79C C o m m o n B l o c k s
80C-----------------------------------------------
81#include "com01_c.inc"
82#include "com04_c.inc"
83#include "com_xfem1.inc"
84#include "param_c.inc"
85#include "lagmult.inc"
86#include "units_c.inc"
87#include "r2r_c.inc"
88C-----------------------------------------------
89C D u m m y A r g u m e n t s
90C-----------------------------------------------
91 INTEGER ,INTENT(IN) :: NSENSOR
92 INTEGER ,INTENT(IN) :: ITHERM
93 INTEGER PROC, NBDDACC, NBDDKIN, NBDDPROC, NBDDBOUN, NUMELS_L,
94 . numnod_l, nbddnrb, len_ia, nbddi2m, nbddncj,nbddnrbm,
95 . nnodt_l, nnodl_l, isp0, nrcvvois, nsndvois, nervois,
96 . nesvois, nsegfl_l, numel, nbcfd, numelq_l,numeltg_l,
97 . numpor_l, numel_l, nbi18_l, inacti, nlagf_l,
98 . nbddnort, nbddnor_max, nbccfr25, nbccnor, numnor_l,
99 . nbddedgt,nbddedg_max,
100 . nodlocal(*), nodglob(*), npby(nnpby,*),
101 . lpby(*), nprw(*), lprw(*), dd_rby2(3,nrbykin),
102 . itabi2m(*), cep(*), monvol(*),
103 . nnlink(10,*), lllink(*), ljoint(*),
104 . ibvel(nbvelp,*), lbvel(*), dd_rbm2(3,nibvel), nstrf(*),
105 . iparg(nparg,*),
106 . ixs(nixs,*), ixq(nixq,*), ixtg(nixtg, *),cel(*), pornod(*),
107 . ipari(npari,*), iexlnk(nr2r,nr2rlnk),
108 . dd_lagf(3,nspmd+1), iadll(*), lll(*),
109 . iskwp(*), nskwp(*),iexmad(*),
110 . isensp(2,*), nsensp(*), iaccp(*), naccp(*),
111 . irbe3(nrbe3l,*), lrbe3(*),itabrbe3m(*),nbddrbe3m,
112 . irbym(nirbym,*), dd_rbym2(3,nrbym), front_rm(nrbym,*),
113 . lcrbym(*),nbddnrbym,irbe2(nrbe2l,*), lrbe2(*),nbddrbe2,
114 . itabrbe2m(*),iedge_tmp(3,*),nodedge(2,*),
115 . edgelocal(*),nbddedge_l, igaup(*), ngaup(*),
116 . frontb_r2r(sfrontb_r2r,nspmd),sdd_r2r_elem,
117 . addcsrect(*), csrect(*),nbddcndm,itabcndm(*)
118 my_real
119 . geo(npropg,*)
120
121 TYPE(intbuf_struct_) INTBUF_TAB(*)
122 TYPE(INTERSURFP) :: INTERCEP(3,NINTER)
123 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
124 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
125 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
126 INTEGER, DIMENSION(*), INTENT(IN) :: ISKWP_L
127 INTEGER, INTENT(IN) :: SIZE_ALE_ELM
128 TYPE(split_cfd_type), INTENT(IN) :: ALE_ELM
129 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
130 TYPE (NLOCAL_STR_), TARGET, INTENT(IN) :: NLOC_DMG
131 type(constraint_), intent(inout) :: constraint_struct !< constraint structure for the splitting
132C-----------------------------------------------
133C F u n c t i o n
134C-----------------------------------------------
135 INTEGER NLOCAL
136 EXTERNAL NLOCAL
137C-----------------------------------------------
138C L o c a l V a r i a b l e s
139C-----------------------------------------------
140 INTEGER I, N, P, PP, IPACC, IPKIN, NBDDNOD, IS,ITY,
141 . msr, nsl, pmain, islocal, ideb, ifin, offc, offtg, iad,
142 . iskin, nbrb, j, k, kk, k0, k1, k2, k6, iso, imax, isbound,
143 . nbcj, nsn, m, nn, n1, n2, n3, n4, nnod, ifram, off, ip, ip0,
144 . nnod_s, nsels_s, nselq_s, nselc_s, nselt_s, nselp_s,
145 . nselr_s, nseltg_s, nsint_s, nnl_l, nnt_l, typ, nn_l,nad_l,
146 . eshift, nmad_l, ng, nft, nel, ilaw, jtur, jthe, isolnod,
147 . iv, ie, proc2, ie_loc, ns_l, ii, jj, ig, nr_l, nf_l,
148 . iv_loc, nw_l, ilw, nimp, ilp, nbe, nad, nrts, nrtm,
149 . nng, iadd, nod,
150 . ishift, lshift, nadmsr, nadmsr_l, ni, nty, ni25, nbddnor,
151 . lcsrect_l, nbddedg, nrtm_l, ic, ik0, ikn, ik,ijk,nb
152 LOGICAL PSEARCH
153
154 INTEGER SPLIST
155
156 INTEGER, DIMENSION(:), ALLOCATABLE :: DD_R2R_ELEM
157 INTEGER, DIMENSION(:), ALLOCATABLE :: PLIST
158 INTEGER, DIMENSION(:), ALLOCATABLE :: TAG_SM, TAG_MS
159 INTEGER TAGP(NSPMD)
160C
161 INTEGER IAD_EDGE(NSPMD+1),LENR,TAG_EDGE,FRNODES,IED_GL,OK,IED_FR,
162 . FR_EDGE_OLD,FR_EDGE0,FR_NBEDGE(NSPMD+1)
163 INTEGER, DIMENSION(:), ALLOCATABLE :: FR_EDGE,TAG_IED_FR
164 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAG_IED_FR0
165!
166 INTEGER, DIMENSION(:), ALLOCATABLE :: WEIGHT,TAGE,NEWFRONT,TAG,TAGER,
167 . TAGES
168 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAGE_L,TAG_L
169 INTEGER :: IAD1, LGTH
170C---------------------------------------------------------------------
171
172
173
174 INTEGER :: COMPTR
175 INTEGER :: COMPTS
176 INTEGER :: IERR
177 INTEGER :: IFV
178 INTEGER :: L
179 INTEGER :: NB_FREDGE
180 INTEGER :: NL
181 INTEGER :: OFFSET
182 INTEGER :: SHIFT_EDG
183 INTEGER :: SOLV
184 INTEGER :: NS
185 INTEGER, DIMENSION(:), ALLOCATABLE :: ACCKIN !(NBDDACC+NBDDKIN)
186 INTEGER, DIMENSION(:), ALLOCATABLE :: ADDCSRECT_L !(NUMNOR_L+1)
187 INTEGER, DIMENSION(:), ALLOCATABLE :: CPULOCALER !(NERVOIS)
188 INTEGER, DIMENSION(:), ALLOCATABLE :: CPULOCALES !(NESVOIS)
189 INTEGER, DIMENSION(:), ALLOCATABLE :: CPULOCALF !(NSEGFL_L)
190 INTEGER, DIMENSION(:), ALLOCATABLE :: CPULOCALR !(NRCVVOIS)
191 INTEGER, DIMENSION(:), ALLOCATABLE :: CPULOCALS !(NSNDVOIS)
192 INTEGER, DIMENSION(:), ALLOCATABLE :: DD_CJ !(NBDDNCJ)
193 INTEGER, DIMENSION(:), ALLOCATABLE :: DD_CNDM !(NBDDCNDM)
194 INTEGER, DIMENSION(:), ALLOCATABLE :: DD_CUT !(NNODT_L)
195 INTEGER, DIMENSION(:), ALLOCATABLE :: DD_ELEM !(NBDDACC+NBDDKIN)
196 INTEGER, DIMENSION(:), ALLOCATABLE :: DD_I2M !(NBDDI2M)
197 INTEGER, DIMENSION(:), ALLOCATABLE :: DD_P !(NSPMD)
198 INTEGER, DIMENSION(:), ALLOCATABLE :: DD_RBE2 !(NBDDRBE2)
199 INTEGER, DIMENSION(:), ALLOCATABLE :: DD_RBE3M !(NBDDRBE3M)
200 INTEGER, DIMENSION(:), ALLOCATABLE :: DD_RBM !(NBDDNRBM)
201 INTEGER, DIMENSION(:), ALLOCATABLE :: DD_RBY !(NBDDNRB)
202 INTEGER, DIMENSION(:), ALLOCATABLE :: DD_RBYM !(NBDDNRBYM)
203 INTEGER, DIMENSION(:), ALLOCATABLE :: DP_RBE3M !(NBDDRBE3M)
204 INTEGER, DIMENSION(:), ALLOCATABLE :: D_RBY !(NSPMD+1)
205 INTEGER, DIMENSION(:), ALLOCATABLE :: FR_NOR !(NBDDNORT)
206 INTEGER, DIMENSION(:), ALLOCATABLE :: IAD_CNDM !(NSPMD+1)
207 INTEGER, DIMENSION(:), ALLOCATABLE :: IAD_I2M !(NSPMD+1)
208 INTEGER, DIMENSION(:), ALLOCATABLE :: IAD_RBE2 !(NSPMD+1)
209 INTEGER, DIMENSION(:), ALLOCATABLE :: IAD_RBE3 !(NSPMD+1)
210 INTEGER, DIMENSION(:), ALLOCATABLE :: IAD_RBE3M !(NSPMD+1)
211 INTEGER, DIMENSION(:), ALLOCATABLE :: IAD_RBM !(NSPMD+1)
212 INTEGER, DIMENSION(:), ALLOCATABLE :: IAD_RBY !(NSPMD+1)
213 INTEGER, DIMENSION(:), ALLOCATABLE :: IAD_RBYM !(NSPMD+1)
214 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX !(2*(NBDDACC+NBDDKIN))
215 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX2 !(2*(NBDDNRB))
216 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX3 !(2*NBDDNCJ)
217 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX4 !(2*NBCFD)
218 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX5 !(2*(NBDDNRBYM))
219 INTEGER, DIMENSION(:), ALLOCATABLE :: ISOM !(NSPMD)
220 INTEGER, DIMENSION(:), ALLOCATABLE :: ISOM_R2R_R !(NSPMD)
221 INTEGER, DIMENSION(:), ALLOCATABLE :: ISOM_R2R_S !(NSPMD)
222 INTEGER, DIMENSION(:), ALLOCATABLE :: LERCVOIS !(NERVOIS)
223 INTEGER, DIMENSION(:), ALLOCATABLE :: LESDVOIS !(NESVOIS)
224 INTEGER, DIMENSION(:), ALLOCATABLE :: LLAGF !(NLAGF_L)
225 INTEGER, DIMENSION(:), ALLOCATABLE :: LNODPOR !(NUMPOR_L)
226 INTEGER, DIMENSION(:), ALLOCATABLE :: LNRCVOIS !(NRCVVOIS)
227 INTEGER, DIMENSION(:), ALLOCATABLE :: LNSDVOIS !(NSNDVOIS)
228 INTEGER, DIMENSION(:), ALLOCATABLE :: LSEGCOM !(NSEGFL_L)
229 INTEGER, DIMENSION(:), ALLOCATABLE :: NBRCVOIS !(NSPMD+1)
230 INTEGER, DIMENSION(:), ALLOCATABLE :: NBSDVOIS !(NSPMD+1)
231 INTEGER, DIMENSION(:), ALLOCATABLE :: NERCVOIS !(NSPMD+1)
232 INTEGER, DIMENSION(:), ALLOCATABLE :: NESDVOIS !(NSPMD+1)
233 INTEGER, DIMENSION(:), ALLOCATABLE :: NPORGEO !(NUMGEO)
234 INTEGER, DIMENSION(:), ALLOCATABLE :: NPSEGCOM !(NSPMD+1)
235 INTEGER, DIMENSION(:), ALLOCATABLE :: PROCNOR !(ADDCSRECT(NUMNOR+1))
236 INTEGER, DIMENSION(:), ALLOCATABLE :: PROC_REM !(NBDDACC+NBDDKIN)
237 INTEGER, DIMENSION(:), ALLOCATABLE :: PROC_REM1 !(NBDDNRBYM)
238 INTEGER, DIMENSION(:), ALLOCATABLE :: RG_CUT !(NNODL_L)
239 INTEGER, DIMENSION(:), ALLOCATABLE :: SECVU !(NSPMD)
240 INTEGER, DIMENSION(:), ALLOCATABLE :: WORK !(70000)
241 INTEGER, DIMENSION(:,:), ALLOCATABLE :: DD_I18 !(NSPMD+2,NBI18_L)
242 INTEGER, DIMENSION(:,:), ALLOCATABLE :: DD_LL !(NSPMD+2,NLINK)
243 INTEGER, DIMENSION(:,:), ALLOCATABLE :: DD_MAD !(5,NSPMD+1)
244 INTEGER, DIMENSION(:,:), ALLOCATABLE :: DD_MV !(NSPMD+2,NVOLU)
245 INTEGER, DIMENSION(:,:), ALLOCATABLE :: DD_R2R !(NSPMD+1,NL_DDR2R)
246 INTEGER, DIMENSION(:,:), ALLOCATABLE :: DD_SEC !(NSPMD+1,NSECT)
247 INTEGER, DIMENSION(:,:), ALLOCATABLE :: DD_WALL !(NSPMD+2,NRWALL)
248 INTEGER, DIMENSION(:,:), ALLOCATABLE :: FR_EDG !(2,NBDDEDGT)
249 INTEGER, DIMENSION(:,:), ALLOCATABLE :: FR_SAV !(2,NBDDEDG_MAX)
250 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_CJ !(NSPMD+1,NJOINT)
251 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_CUT !(NSPMD+2,NSECT*ISECUT*ISP0)
252 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_ELEM !(2,NSPMD+1)
253 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_FREDG !(NINTER25,NSPMD+1)
254 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_FRNOR !(NINTER25,NSPMD+1)
255 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_RBM2 !(4,NSPMD+1)
256 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_RBY2 !(4,NSPMD+1)
257 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_RBYM2 !(4,NSPMD+1)
258 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_SEC !(4,NSPMD+1)
259 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX25 !(2*MAX(NBDDNOR_MAXNBDDEDG_MAX))
260 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITRI !(3,NBDDACC+NBDDKIN)
261 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITRI2 !(2,NBDDNRB)
262 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITRI25 !(3,MAX(NBDDNOR_MAX,NBDDEDG_MAX))
263 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITRI25_NORMAL !(5,MAX(NBDDNOR_MAX,NBDDEDG_MAX))
264 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITRI3 !(2,NBDDNCJ)
265 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITRI4 !(2,NBCFD)
266 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ITRI5 !(2,NBDDNRBYM)
267 INTEGER, DIMENSION(:), ALLOCATABLE :: PROC_REM25 !(MAX(NBDDNOR_MAX,NBDDEDG_MAX))
268 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAGS !(NSPMD,SEGINDX)
269 INTEGER, DIMENSION(:), ALLOCATABLE :: PROC_REM_CYL_JOINT
270 INTEGER :: COMPTR_NL,COMPTS_NL
271 INTEGER :: NDOF_NLOCAL,OFFSET_S_NL,OFFSET_R_NL
272 INTEGER, DIMENSION(:), ALLOCATABLE :: ISOM_R2R_R_NL !(NSPMD)
273 INTEGER, DIMENSION(:), ALLOCATABLE :: ISOM_R2R_S_NL !(NSPMD)
274 INTEGER, POINTER, DIMENSION(:) :: IDXI,POSI
275
276 ALLOCATE(acckin(nbddacc+nbddkin))
277 ALLOCATE(addcsrect_l(numnor_l+1))
278 ALLOCATE(cpulocaler(nervois))
279 ALLOCATE(cpulocales(nesvois))
280 ALLOCATE(cpulocalf(nsegfl_l))
281 ALLOCATE(cpulocalr(nrcvvois))
282 ALLOCATE(cpulocals(nsndvois))
283 ALLOCATE(dd_cj(nbddncj))
284 ALLOCATE(dd_cndm(nbddcndm))
285 ALLOCATE(dd_cut(nnodt_l))
286 ALLOCATE(dd_elem(nbddacc+nbddkin))
287 ALLOCATE(dd_i2m(nbddi2m))
288 ALLOCATE(dd_p(nspmd))
289 ALLOCATE(dd_rbe2(nbddrbe2))
290 ALLOCATE(dd_rbe3m(nbddrbe3m))
291 ALLOCATE(dd_rbm(nbddnrbm))
292 ALLOCATE(dd_rby(nbddnrb))
293 ALLOCATE(dd_rbym(nbddnrbym))
294 ALLOCATE(dp_rbe3m(nbddrbe3m))
295 ALLOCATE(d_rby(nspmd+1))
296 ALLOCATE(fr_nor(nbddnort))
297 ALLOCATE(iad_cndm(nspmd+1))
298 ALLOCATE(iad_i2m(nspmd+1))
299 ALLOCATE(iad_rbe2(nspmd+1))
300 ALLOCATE(iad_rbe3(nspmd+1))
301 ALLOCATE(iad_rbe3m(nspmd+1))
302 ALLOCATE(iad_rbm(nspmd+1))
303 ALLOCATE(iad_rby(nspmd+1))
304 ALLOCATE(iad_rbym(nspmd+1))
305 ALLOCATE(index(2*(nbddacc+nbddkin)))
306 ALLOCATE(index2(2*(nbddnrb)))
307 ALLOCATE(index3(2*nbddncj))
308 ALLOCATE(index4(2*nbcfd))
309 ALLOCATE(index5(2*(nbddnrbym)))
310 ALLOCATE(isom(nspmd))
311 ALLOCATE(isom_r2r_r(nspmd))
312 ALLOCATE(isom_r2r_s(nspmd))
313 ALLOCATE(lercvois(nervois))
314 ALLOCATE(lesdvois(nesvois))
315 ALLOCATE(llagf(nlagf_l))
316 ALLOCATE(lnodpor(numpor_l))
317 ALLOCATE(lnrcvois(nrcvvois))
318 ALLOCATE(lnsdvois(nsndvois))
319 ALLOCATE(lsegcom(nsegfl_l))
320 ALLOCATE(nbrcvois(nspmd+1))
321 ALLOCATE(nbsdvois(nspmd+1))
322 ALLOCATE(nercvois(nspmd+1))
323 ALLOCATE(nesdvois(nspmd+1))
324 ALLOCATE(nporgeo(numgeo))
325 ALLOCATE(npsegcom(nspmd+1))
326 ALLOCATE(procnor(nbccnor))
327 ALLOCATE(proc_rem(nbddacc+nbddkin))
328 ALLOCATE(proc_rem1(nbddnrbym))
329 ALLOCATE(rg_cut(nnodl_l))
330 ALLOCATE(secvu(nspmd))
331 ALLOCATE(work(70000))
332 ALLOCATE(dd_i18(nspmd+2,nbi18_l))
333 ALLOCATE(dd_ll(nspmd+2,nlink))
334 ALLOCATE(dd_mad(5,nspmd+1))
335 ALLOCATE(dd_mv(nspmd+2,nvolu))
336 ALLOCATE(dd_r2r(nspmd+1,nl_ddr2r))
337 ALLOCATE(dd_sec(nspmd+1,nsect))
338 ALLOCATE(dd_wall(nspmd+2,nrwall))
339 ALLOCATE(fr_edg(2,nbddedgt))
340 ALLOCATE(fr_sav(2,nbddedg_max))
341 ALLOCATE(iad_cj(nspmd+1,njoint))
342 ALLOCATE(iad_cut(nspmd+2,nsect*isecut*isp0))
343 ALLOCATE(iad_elem(2,nspmd+1))
344 ALLOCATE(iad_fredg(ninter25,nspmd+1))
345 ALLOCATE(iad_frnor(ninter25,nspmd+1))
346 ALLOCATE(iad_rbm2(4,nspmd+1))
347 ALLOCATE(iad_rby2(4,nspmd+1))
348 ALLOCATE(iad_rbym2(4,nspmd+1))
349 ALLOCATE(iad_sec(4,nspmd+1))
350 ALLOCATE(index25(2*max(nbddnor_max,nbddedg_max)))
351 ALLOCATE(itri(3,nbddacc+nbddkin))
352 ALLOCATE(itri2(2,nbddnrb))
353 ALLOCATE(itri25(3,max(nbddnor_max,nbddedg_max)))
354 ALLOCATE(itri25_normal(5,max(nbddnor_max,nbddedg_max)))
355 ALLOCATE(itri3(2,nbddncj))
356 ALLOCATE(itri4(2,nbcfd))
357 ALLOCATE(itri5(2,nbddnrbym))
358 ALLOCATE(proc_rem25(max(nbddnor_max,nbddedg_max)))
359 ALLOCATE(tags(nspmd,segindx))
360 ALLOCATE( weight(numnod_l),tage(numel) )
361 ALLOCATE( newfront(ninter),tag(numnod) )
362 ALLOCATE( tager(nervois),tages(nesvois) )
363 ALLOCATE( tage_l(nspmd,numel_l),tag_l(nspmd,numnod_l) )
364! -----------------------------------
365
366C
367C Domdec pure
368C
369 nbddnod = 0
370 nbddboun= 0
371 isbound = 0
372 ALLOCATE(plist(nspmd))
373 plist(1:nspmd) = -1
374
375 DO ii = 1, numnod_l
376 i = nodglob(ii)
377 isbound = 0
378 splist=0
379 CALL plist_ifront(plist,i,splist)
380 !returns in "PLIST" array list of SPMD domains on which node I is sticked
381 !SPLITS is the number of SPMD domains on which node I is sticked
382 DO j=1,splist
383 p = plist(j)
384 IF(p/=proc)THEN
385 nbddnod = nbddnod + 1
386 dd_elem(nbddnod) = i
387 proc_rem(nbddnod) = p
388 !FLAGKIN array identities boundary nodes with kinematic constraints
389 !(FLAGKIN(N)=1 <=> old FRONT TAG=10)
390 !FLAGKIN(N) can be set to one only for first SPMD domain
391 IF(flagkin(i)==1.AND.(proc==1.OR.p==1))THEN
392 acckin(nbddnod) = 1
393 ELSE
394 acckin(nbddnod) = 0
395 ENDIF
396 isbound = 1
397 ENDIF
398 ENDDO
399 nbddboun = nbddboun + isbound
400 ENDDO
401
402 DEALLOCATE(plist)
403C
404 DO i = 1, nbddnod
405 itri(1,i) = proc_rem(i)
406 itri(2,i) = acckin(i)
407 itri(3,i) = dd_elem(i)
408 index(i) = i
409 ENDDO
410 CALL my_orders(0,work,itri,index,nbddnod,3)
411 DO i = 1, nbddnod
412 proc_rem(i)= itri(1,index(i))
413 acckin(i) = itri(2,index(i))
414 dd_elem(i) = nodlocal(itri(3,index(i)))
415 ENDDO
416C
417 DO p = 1, nspmd
418 isom(p) = 0
419 ENDDO
420 DO i = 1, nbddnod
421 p = proc_rem(i)
422 isom(p) = isom(p) + 1
423 ENDDO
424 iad_elem(1,1) = 1
425 iad_elem(2,1) = 1
426 DO p = 1, nspmd
427 iad_elem(1,p+1) = iad_elem(1,p) + isom(p)
428 iad_elem(2,p+1) = iad_elem(1,p+1)
429 ENDDO
430C
431C-- Domdec Multidomaines hmpp
432
433 IF ((nsubdom>0).AND.(iddom==0)) THEN
434 compts = 0
435 comptr = 0
436 isom_r2r_s = 0
437 isom_r2r_r = 0
438c
439 DO i = 1, nbddnod
440 p = proc_rem(i)
441 n = nodglob(dd_elem(i))
442 IF (frontb_r2r(n,proc)==-1) THEN
443 IF (frontb_r2r(n,p)>0) THEN
444 isom_r2r_s(p) = isom_r2r_s(p) + 1
445 compts = compts + 1
446 ENDIF
447 ELSEIF (frontb_r2r(n,proc)>0) THEN
448 IF (frontb_r2r(n,p)==-1) THEN
449 isom_r2r_r(p) = isom_r2r_r(p) + 1
450 comptr = comptr + 1
451 ENDIF
452 ENDIF
453 ENDDO
454C
455 dd_r2r(1,1:4) = 1
456 DO p = 1, nspmd
457 dd_r2r(p+1,1) = dd_r2r(p,1) + isom_r2r_s(p)
458 dd_r2r(p+1,2) = dd_r2r(p,2) + isom_r2r_r(p)
459 ENDDO
460C
461C-- specific exhcanges for Nlocal dof
462
463 IF (nloc_dmg%IMOD > 0) THEN
464 idxi => nloc_dmg%IDXI(1:numnod)
465 posi => nloc_dmg%POSI(1:nloc_dmg%NNOD)
466 ALLOCATE(isom_r2r_r_nl(nspmd))
467 ALLOCATE(isom_r2r_s_nl(nspmd))
468 isom_r2r_s_nl = 0
469 isom_r2r_r_nl = 0
470 comptr_nl = 0
471 compts_nl = 0
472 DO i = 1, nbddnod
473 p = proc_rem(i)
474 n = nodglob(dd_elem(i))
475 nn = idxi(n)
476 ndof_nlocal = posi(nn+1)-posi(nn)
477 IF (frontb_r2r(n,proc)==-1) THEN
478 IF (frontb_r2r(n,p)>0) THEN
479 isom_r2r_s_nl(p) = isom_r2r_s_nl(p) + ndof_nlocal
480 ENDIF
481 ENDIF
482 IF (frontb_r2r(n,proc)>0) THEN
483 IF (frontb_r2r(n,p)==-1) THEN
484 isom_r2r_r_nl(p) = isom_r2r_r_nl(p) + ndof_nlocal
485 ENDIF
486 ENDIF
487 ENDDO
488 DO p = 1, nspmd
489 compts_nl = compts_nl+isom_r2r_s_nl(p)
490 comptr_nl = compts_nl+isom_r2r_r_nl(p)
491 dd_r2r(p+1,3) = dd_r2r(p,3) + isom_r2r_s_nl(p)
492 dd_r2r(p+1,4) = dd_r2r(p,4) + isom_r2r_r_nl(p)
493 ENDDO
494 DEALLOCATE(isom_r2r_r_nl,isom_r2r_s_nl)
495 ELSE
496 DO p = 1, nspmd
497 dd_r2r(p+1,3) = 0
498 dd_r2r(p+1,4) = 0
499 ENDDO
500 ENDIF
501c
502 ALLOCATE (dd_r2r_elem(sdd_r2r_elem),stat=ierr)
503 dd_r2r_elem(1:sdd_r2r_elem) = 0
504 IF (ierr /= 0) THEN
505 WRITE(iout,*)' ** ERROR IN MEMORY ALLOCATION'
506 WRITE(istdo,*)' ** ERROR IN MEMORY ALLOCATION'
507 CALL arret(2)
508 ENDIF
509 offset = compts
510 comptr = 0
511 compts = 0
512 DO i = 1, nbddnod
513 n = nodglob(dd_elem(i))
514 p = proc_rem(i)
515 IF (frontb_r2r(n,proc)==-1) THEN
516 IF (frontb_r2r(n,p)>0) THEN
517 compts = compts+1
518 dd_r2r_elem(compts) = dd_elem(i)
519 ENDIF
520 ELSEIF (frontb_r2r(n,proc)>0) THEN
521 IF (frontb_r2r(n,p)==-1) THEN
522 comptr = comptr+1
523 dd_r2r_elem(offset+comptr) = dd_elem(i)
524 ENDIF
525 ENDIF
526 ENDDO
527C
528C-- specific exhcanges for Nlocal dof
529 IF (nloc_dmg%IMOD > 0) THEN
530 offset_s_nl = compts + comptr
531 offset_r_nl = compts + comptr + compts_nl
532 comptr_nl = 0
533 compts_nl = 0
534 DO i = 1, nbddnod
535 n = nodglob(dd_elem(i))
536 p = proc_rem(i)
537 nn = idxi(n)
538 ndof_nlocal = posi(nn+1)-posi(nn)
539 IF (frontb_r2r(n,proc)==-1) THEN
540 IF (frontb_r2r(n,p)>0) THEN
541 DO kk = 1,ndof_nlocal
542 compts_nl = compts_nl+1
543 dd_r2r_elem(offset_s_nl+compts_nl) = dd_elem(i)
544 ENDDO
545 ENDIF
546 ELSEIF (frontb_r2r(n,proc)>0) THEN
547 IF (frontb_r2r(n,p)==-1) THEN
548 DO kk = 1,ndof_nlocal
549 comptr_nl = comptr_nl+1
550 dd_r2r_elem(offset_r_nl+comptr_nl) = dd_elem(i)
551 ENDDO
552 ENDIF
553 ENDIF
554 ENDDO
555 ENDIF
556C
557 ENDIF
558C
559 IF (nspmd>1.AND.(nbddacc+nbddkin)>0) THEN
560 DO p = 1, nspmd
561 i = iad_elem(1,p)
562 iskin = 0
563 DO WHILE (iskin==0.AND.i<iad_elem(1,p+1))
564 iskin = acckin(i)
565 i = i + 1
566 ENDDO
567 IF(iskin==1) THEN
568 iad_elem(2,p) = i-1
569 ELSE
570 iad_elem(2,p) = iad_elem(1,p+1)
571 END IF
572 ENDDO
573 iad_elem(2,nspmd+1) = iad_elem(1,nspmd+1)
574 ENDIF
575 nbddproc = 0
576 DO p = 1, nspmd
577 IF(isom(p)>0)nbddproc=nbddproc+1
578 ENDDO
579C
580 DO i = 1, numnod_l
581 weight(i) = 0
582 n = nodglob(i)
583 DO p = 1, proc-1
584 IF(nlocal(n,p)==1)GOTO 10
585 ENDDO
586 weight(i) = 1
587 10 CONTINUE
588 ENDDO
589C
590C RBY specifique (POFF)
591C
592 nbrb = 0
593 DO n = 1, nrbykin
594 m=npby(1,n)
595 IF(nlocal(m,proc)==1)THEN
596 DO p = 1, nspmd
597 IF(p/=proc) THEN
598 IF(nlocal(m,p)==1) THEN
599 nbrb = nbrb + 1
600 dd_rby(nbrb) = m
601 proc_rem(nbrb) = p
602 ENDIF
603 ENDIF
604 ENDDO
605 ENDIF
606 ENDDO
607C
608
609 DO i = 1, nbrb
610 itri2(1,i) = proc_rem(i)
611 itri2(2,i) = dd_rby(i)
612 index2(i) = i
613 ENDDO
614 CALL my_orders(0,work,itri2,index2,nbrb,2)
615 DO i = 1, nbrb
616 proc_rem(i)= itri2(1,index2(i))
617 dd_rby(i) = nodlocal(itri2(2,index2(i)))
618 ENDDO
619C
620 DO p = 1, nspmd
621 isom(p) = 0
622 ENDDO
623 DO i = 1, nbrb
624 p = proc_rem(i)
625 isom(p) = isom(p) + 1
626 ENDDO
627 iad_rby(1) = 1
628 DO p = 1, nspmd
629 iad_rby(p+1) = iad_rby(p) + isom(p)
630 ENDDO
631C
632C
633C
634C
635C Rigid material specifique (POFF)
636C
637
638 nbrb = 0
639 DO n = 1, nrbym
640 m=irbym(1,n)
641 IF(mod(front_rm(m,proc),10)==1)THEN
642 DO p = 1, nspmd
643 IF(p/=proc) THEN
644 IF(mod(front_rm(m,p),10)==1) THEN
645 nbrb = nbrb + 1
646 dd_rbym(nbrb) = m
647 proc_rem1(nbrb) = p
648 ENDIF
649 ENDIF
650 ENDDO
651 ENDIF
652 ENDDO
653C
654 DO i = 1, nbrb
655 itri5(1,i) = proc_rem1(i)
656 itri5(2,i) = dd_rbym(i)
657 index5(i) = i
658 ENDDO
659 CALL my_orders(0,work,itri5,index5,nbrb,2)
660 DO i = 1, nbrb
661 proc_rem1(i)= itri5(1,index5(i))
662 dd_rbym(i) = itri5(2,index5(i))
663 ENDDO
664C
665 DO p = 1, nspmd
666 isom(p) = 0
667 ENDDO
668 DO i = 1, nbrb
669 p = proc_rem1(i)
670 isom(p) = isom(p) + 1
671 ENDDO
672 iad_rbym(1) = 1
673 DO p = 1, nspmd
674 iad_rbym(p+1) = iad_rbym(p) + isom(p)
675 ENDDO
676C
677C RWALL specifique type sliding
678C
679 dd_wall(1:nspmd+2,1:nrwall) = 0
680 do n=1,nrwall
681 dd_wall(1:nspmd+2,n) = constraint_struct%rwall%dd(1:nspmd+2,n)
682 enddo
683C
684C RBY Kin specifique rigid body (PON)
685C
686 DO p = 1, nspmd+1
687 iad_rby2(1,p) = 0
688 iad_rby2(2,p) = 0
689 iad_rby2(3,p) = 0
690 iad_rby2(4,p) = 0
691 ENDDO
692 k = 0
693 DO n = 1, nrbykin
694 msr = npby(1,n)
695 nsl = npby(2,n)
696C
697 imax = 0
698 pmain = 1
699 DO p = 1, nspmd
700 dd_p(p) = 0
701 IF(nlocal(msr,p)==1) THEN
702 DO kk = 1, nsl
703 nn = lpby(k+kk)
704 IF(nlocal(nn,p)==1)THEN
705 IF(ifront%P(1,ifront%IENTRY(nn)) >= p) dd_p(p) = dd_p(p) + 1
706 ENDIF
707 ENDDO
708 IF(dd_p(p)>imax)THEN
709 pmain = p
710 imax = dd_p(p)
711 ENDIF
712 ELSE
713 dd_p(p) = -1
714 ENDIF
715 ENDDO
716C
717 IF(nlocal(msr,proc)==1) THEN
718 dd_rby2(1,n) = dd_p(proc)
719 dd_rby2(2,n) = nsl
720 dd_rby2(3,n) = pmain
721 IF(pmain/=proc) THEN
722 iad_rby2(1,pmain) = iad_rby2(1,pmain) + dd_p(proc)
723 iad_rby2(4,pmain) = iad_rby2(4,pmain) + 1
724 ELSE
725 DO p = 1, nspmd
726 IF(p/=proc) THEN
727 IF(dd_p(p)/=-1) THEN
728 iad_rby2(2,p) = iad_rby2(2,p) + dd_p(p)
729 iad_rby2(3,p) = iad_rby2(3,p) + 1
730 ENDIF
731 ENDIF
732 ENDDO
733 ENDIF
734 ELSE
735C cas aucun noeuds de rby
736 dd_rby2(1,n) = 0
737 dd_rby2(2,n) = 0
738 dd_rby2(3,n) = pmain
739 ENDIF
740C
741 islocal = 0
742 DO p = 1, nspmd
743 IF(p/=pmain) THEN
744 IF(dd_p(p)/=-1) THEN
745 islocal = 1
746 ENDIF
747 ENDIF
748 ENDDO
749C tag DD_RBY(3) a negatif pour reperage des rb sans echange.
750 IF(islocal==0) dd_rby2(3,n) = -pmain
751C
752 k = k + nsl
753 ENDDO
754C
755C comptage des mains
756C
757 DO p = 1, nspmd
758 dd_p(p) = 0
759 ENDDO
760 DO n = 1, nrbykin
761 pmain = dd_rby2(3,n)
762C si rby decoupe
763 IF(pmain>0) dd_p(pmain) = dd_p(pmain)+1
764 ENDDO
765 DO p = 1, nspmd
766 IF(iad_rby2(3,p)/=0)THEN
767 iad_rby2(3,p) = dd_p(proc)
768 ENDIF
769 IF(iad_rby2(4,p)/=0)THEN
770 iad_rby2(4,p) = dd_p(p)
771 ENDIF
772 ENDDO
773C
774 DO p = 1, nspmd
775 iad_rby2(1,nspmd+1) = iad_rby2(1,nspmd+1) + iad_rby2(1,p)
776 iad_rby2(2,nspmd+1) = iad_rby2(2,nspmd+1) + iad_rby2(2,p)
777 iad_rby2(3,nspmd+1) = iad_rby2(3,nspmd+1) + iad_rby2(3,p)
778 iad_rby2(4,nspmd+1) = iad_rby2(4,nspmd+1) + iad_rby2(4,p)
779 END DO
780C
781C Rigid material specifique rigid body (PON)
782C
783 DO p = 1, nspmd+1
784 iad_rbym2(1,p) = 0
785 iad_rbym2(2,p) = 0
786 iad_rbym2(3,p) = 0
787 iad_rbym2(4,p) = 0
788 ENDDO
789 k = 0
790C
791 DO n = 1, nrbym
792 msr = irbym(1,n)
793 nsl = irbym(2,n)
794 imax = 0
795 pmain = 1
796 DO p = 1, nspmd
797 dd_p(p) = 0
798 IF(mod(front_rm(msr,p),10)==1) THEN
799 DO kk = 1, nsl
800 nn = lcrbym(k+kk)
801 IF(nlocal(nn,p)==1)THEN
802 DO pp = 1, p-1
803 IF(nlocal(nn,pp)==1) THEN
804 GOTO 111
805 ENDIF
806 ENDDO
807 dd_p(p) = dd_p(p) + 1
808 111 CONTINUE
809 ENDIF
810 ENDDO
811 IF(dd_p(p)>imax)THEN
812 pmain = p
813 imax = dd_p(p)
814 ENDIF
815 ELSE
816 dd_p(p) = -1
817 ENDIF
818 ENDDO
819C
820C
821 IF(mod(front_rm(msr,proc),10)==1) THEN
822 dd_rbym2(1,n) = dd_p(proc)
823 dd_rbym2(2,n) = nsl
824 dd_rbym2(3,n) = pmain
825
826 IF(pmain/=proc) THEN
827 iad_rbym2(1,pmain) = iad_rbym2(1,pmain) + dd_p(proc)
828 iad_rbym2(4,pmain) = iad_rbym2(4,pmain) + 1
829 ELSE
830 DO p = 1, nspmd
831 IF(p/=proc) THEN
832 IF(dd_p(p)/=-1) THEN
833 iad_rbym2(2,p) = iad_rbym2(2,p) + dd_p(p)
834 iad_rbym2(3,p) = iad_rbym2(3,p) + 1
835 ENDIF
836 ENDIF
837 ENDDO
838 ENDIF
839 ELSE
840C cas aucun noeuds rigid material
841 dd_rbym2(1,n) = 0
842 dd_rbym2(2,n) = 0
843 dd_rbym2(3,n) = pmain
844 ENDIF
845C
846 islocal = 0
847 DO p = 1, nspmd
848 IF(p/=pmain) THEN
849 IF(dd_p(p)/=-1) THEN
850 islocal = 1
851 ENDIF
852 ENDIF
853 ENDDO
854
855C tag DD_RBY(3) a negatif pour reperage des r material sans echange.
856 IF(islocal==0) dd_rbym2(3,n) = -pmain
857 k = k + nsl
858 ENDDO
859C
860C comptage des mains
861C
862 DO p = 1, nspmd
863 dd_p(p) = 0
864 ENDDO
865 DO n = 1, nrbym
866 pmain = dd_rbym2(3,n)
867C si rigid material decoupe
868 IF(pmain>0) dd_p(pmain) = dd_p(pmain)+1
869 ENDDO
870 DO p = 1, nspmd
871 IF(iad_rbym2(3,p)/=0)THEN
872 iad_rbym2(3,p) = dd_p(proc)
873 ENDIF
874 IF(iad_rbym2(4,p)/=0)THEN
875 iad_rbym2(4,p) = dd_p(p)
876 ENDIF
877 ENDDO
878C
879 DO p = 1, nspmd
880 iad_rbym2(1,nspmd+1) = iad_rbym2(1,nspmd+1) + iad_rbym2(1,p)
881 iad_rbym2(2,nspmd+1) = iad_rbym2(2,nspmd+1) + iad_rbym2(2,p)
882 iad_rbym2(3,nspmd+1) = iad_rbym2(3,nspmd+1) + iad_rbym2(3,p)
883 iad_rbym2(4,nspmd+1) = iad_rbym2(4,nspmd+1) + iad_rbym2(4,p)
884 END DO
885C
886C Specifique interface type 2 : on utilise les frontieres
887 DO p = 1, nspmd+1
888 iad_i2m(p) = 0
889 ENDDO
890 IF(nbddi2m>0) THEN
891 n = 1
892 DO p = 1, nspmd
893 ideb = iad_elem(1,p)
894 ifin = iad_elem(1,p+1)-1
895 iad_i2m(p) = n
896 DO i = ideb, ifin
897 IF(itabi2m(dd_elem(i))==1) THEN
898 dd_i2m(n) = dd_elem(i)
899 n = n + 1
900 ENDIF
901 ENDDO
902 ENDDO
903 iad_i2m(nspmd+1) = n
904 if(n-1/=nbddi2m)then
905 print*,'error decomp I2',n-1,nbddi2m
906 endif
907 ENDIF
908C
909C MV specifique
910C
911 offc = numels+numelq
912 offtg =numels+numelq+ numelc+numelt+numelp+numelr
913 k1 = 1
914 k6 = 0
915 ifv= 0
916 DO n = 1, nvolu
917 DO p = 1, nspmd+2
918 dd_mv(p,n) = 0
919 ENDDO
920C
921 is = monvol(k1+3)
922 nn = igrsurf(is)%NSEG
923 DO j = 1, nn
924 ity = igrsurf(is)%ELTYP(j)
925 i = igrsurf(is)%ELEM(j)
926 IF (ity==3) THEN
927 p = cep(i+offc) + 1
928 dd_mv(p,n) = dd_mv(p,n) + 1
929 ELSEIF (ity==7) THEN
930 p = cep(i+offtg) + 1
931 dd_mv(p,n) = dd_mv(p,n) + 1
932 ELSE
933 END IF
934 END DO
935 imax = 0
936 pmain = 1
937 DO p = 1, nspmd
938 IF(dd_mv(p,n)>imax)THEN
939 pmain = p
940 imax = dd_mv(p,n)
941 END IF
942 END DO
943 dd_mv(nspmd+1,n) = nn
944 dd_mv(nspmd+2,n) = pmain
945C
946c specific case for FVMBAG AND FVMBAG1, get PMAIN directly
947c from PMAIN computed in C_FVBAG
948 ity=monvol(k1-1+2)
949 IF (ity==6.OR.ity==8) THEN
950 ifv = ifv+1
951 pmain = fvspmd(ifv)%PMAIN
952 dd_mv(nspmd+2,n) = pmain
953 ENDIF
954
955 k1 = k1 + nimv
956 k6 = k6 + nn
957 ENDDO
958C
959C RLink specifique
960C
961 k = 0
962 DO i = 1, nlink
963 DO p = 1, nspmd+2
964 dd_ll(p,i) = 0
965 ENDDO
966C
967 nn = nnlink(1,i)
968 DO p = 1, nspmd
969 DO j = 1, nn
970 n = lllink(k+j)
971 IF (nlocal(n,p)==1)THEN
972 dd_ll(p,i) = dd_ll(p,i) + 1
973 ENDIF
974 END DO
975 END DO
976 k = k + nn
977C
978 imax = 0
979 pmain = 1
980 DO p = 1, nspmd
981 IF(dd_ll(p,i)>imax)THEN
982 pmain = p
983 imax = dd_ll(p,i)
984 END IF
985 END DO
986 dd_ll(nspmd+1,i) = nn
987 dd_ll(nspmd+2,i) = pmain
988C
989 ENDDO
990C
991C Cyl. JOINT specifique
992C
993 nbcj = 0
994 k = 1
995 DO n = 1, njoint
996 nsn=ljoint(k)
997 nbcj = nbcj + nsn
998 k = k + nsn + 1
999 ENDDO
1000 ALLOCATE( proc_rem_cyl_joint(nbcj) )
1001 k = 1
1002 nad = 1
1003 DO n = 1, njoint
1004 nbcj = 0
1005 nsn=ljoint(k)
1006 DO j = 1, nsn
1007 m = ljoint(k+j)
1008 IF(proc/=1) THEN
1009C proc <> 0, frontiere si noeud sur le proc
1010 IF(nlocal(m,proc)==1)THEN
1011 nbcj = nbcj + 1
1012 dd_cj(nad+nbcj-1) = m
1013 proc_rem_cyl_joint(nbcj) = 1
1014 END IF
1015 ELSE
1016C proc = 0, recherche des autres procs ayant le noeud
1017 DO p = 2, nspmd
1018 IF(nlocal(m,p)==1) THEN
1019 nbcj = nbcj + 1
1020 dd_cj(nad+nbcj-1) = m
1021 proc_rem_cyl_joint(nbcj) = p
1022 ENDIF
1023 END DO
1024 END IF
1025 END DO
1026C
1027 DO i = 1, nbcj
1028 itri3(1,i) = proc_rem_cyl_joint(i)
1029 itri3(2,i) = dd_cj(nad+i-1)
1030 index3(i) = i
1031 ENDDO
1032 CALL my_orders(0,work,itri3,index3,nbcj,2)
1033 DO i = 1, nbcj
1034 proc_rem_cyl_joint(i)= itri3(1,index3(i))
1035 dd_cj(nad+i-1) = nodlocal(itri3(2,index3(i)))
1036 ENDDO
1037C
1038 DO p = 1, nspmd
1039 isom(p) = 0
1040 ENDDO
1041 DO i = 1, nbcj
1042 p = proc_rem_cyl_joint(i)
1043 isom(p) = isom(p) + 1
1044 ENDDO
1045 iad_cj(1,n) = nad
1046 DO p = 1, nspmd
1047 iad_cj(p+1,n) = iad_cj(p,n) + isom(p)
1048 ENDDO
1049C
1050 nad = nad + iad_cj(nspmd+1,n) - iad_cj(1,n)
1051 k = k + nsn + 1
1052 ENDDO
1053 DEALLOCATE( proc_rem_cyl_joint )
1054C
1055C RBY MOU specifique (POFF)
1056C
1057 nbrb = 0
1058 iad_rbm(1) = 1
1059 DO p = 1, nspmd
1060 IF (p/=proc) THEN
1061 DO n = 1, nibvel
1062 m=ibvel(4,n)
1063 IF(nlocal(m,proc)==1.AND.
1064 + nlocal(m,p)==1) THEN
1065 nbrb = nbrb + 1
1066 dd_rbm(nbrb) = n
1067 END IF
1068 END DO
1069 END IF
1070 iad_rbm(p+1) = nbrb+1
1071 END DO
1072C
1073C RBM specifique (PON)
1074C
1075 DO p = 1, nspmd+1
1076 iad_rbm2(1,p) = 0
1077 iad_rbm2(2,p) = 0
1078 iad_rbm2(3,p) = 0
1079 iad_rbm2(4,p) = 0
1080 ENDDO
1081 k = 0
1082 DO n = 1, nibvel
1083 nsl = ibvel(3,n)
1084 msr = ibvel(4,n)
1085C
1086 imax = 0
1087 pmain = 1
1088 DO p = 1, nspmd
1089 dd_p(p) = 0
1090 IF(nlocal(msr,p)==1) THEN
1091 DO kk = 1, nsl
1092 nn = lbvel(k+kk)
1093 IF(nlocal(nn,p)==1)THEN
1094 DO pp = 1, p-1
1095 IF(nlocal(nn,pp)==1) THEN
1096 GOTO 1000
1097 ENDIF
1098 ENDDO
1099 dd_p(p) = dd_p(p) + 1
1100 1000 CONTINUE
1101 ENDIF
1102 ENDDO
1103 IF(dd_p(p)>imax)THEN
1104 pmain = p
1105 imax = dd_p(p)
1106 ENDIF
1107 ELSE
1108 dd_p(p) = -1
1109 ENDIF
1110 ENDDO
1111C
1112 IF(nlocal(msr,proc)==1) THEN
1113 dd_rbm2(1,n) = dd_p(proc)
1114 dd_rbm2(2,n) = nsl
1115 dd_rbm2(3,n) = pmain
1116 IF(pmain/=proc) THEN
1117 iad_rbm2(1,pmain) = iad_rbm2(1,pmain) + dd_p(proc)
1118 iad_rbm2(4,pmain) = iad_rbm2(4,pmain) + 1
1119 ELSE
1120 DO p = 1, nspmd
1121 IF(p/=proc) THEN
1122 IF(dd_p(p)/=-1) THEN
1123 iad_rbm2(2,p) = iad_rbm2(2,p) + dd_p(p)
1124 iad_rbm2(3,p) = iad_rbm2(3,p) + 1
1125 ENDIF
1126 ENDIF
1127 ENDDO
1128 ENDIF
1129 ELSE
1130C cas aucun noeuds de rby
1131 dd_rbm2(1,n) = 0
1132 dd_rbm2(2,n) = 0
1133 dd_rbm2(3,n) = pmain
1134 ENDIF
1135C
1136 islocal = 0
1137 DO p = 1, nspmd
1138 IF(p/=pmain) THEN
1139 IF(dd_p(p)/=-1) THEN
1140 islocal = 1
1141 ENDIF
1142 ENDIF
1143 ENDDO
1144C tag DD_RBY(3) a negatif pour reperage des rb sans echange.
1145 IF(islocal==0) dd_rbm2(3,n) = -pmain
1146C
1147 k = k + nsl
1148 ENDDO
1149C
1150C comptage des mains
1151C
1152 DO p = 1, nspmd
1153 dd_p(p) = 0
1154 ENDDO
1155 DO n = 1, nibvel
1156 pmain = dd_rbm2(3,n)
1157C si rbm decoupe
1158 IF(pmain>0) dd_p(pmain) = dd_p(pmain)+1
1159 ENDDO
1160 DO p = 1, nspmd
1161 IF(iad_rbm2(3,p)/=0)THEN
1162 iad_rbm2(3,p) = dd_p(proc)
1163 ENDIF
1164 IF(iad_rbm2(4,p)/=0)THEN
1165 iad_rbm2(4,p) = dd_p(p)
1166 ENDIF
1167 ENDDO
1168C
1169 DO p = 1, nspmd
1170 iad_rbm2(1,nspmd+1) = iad_rbm2(1,nspmd+1) + iad_rbm2(1,p)
1171 iad_rbm2(2,nspmd+1) = iad_rbm2(2,nspmd+1) + iad_rbm2(2,p)
1172 iad_rbm2(3,nspmd+1) = iad_rbm2(3,nspmd+1) + iad_rbm2(3,p)
1173 iad_rbm2(4,nspmd+1) = iad_rbm2(4,nspmd+1) + iad_rbm2(4,p)
1174 ENDDO
1175C
1176C RBE3 same than int2
1177C
1178 DO p = 1, nspmd+1
1179 iad_rbe3m(p) = 0
1180 ENDDO
1181 IF(nbddrbe3m>0) THEN
1182 n = 1
1183 DO p = 1, nspmd
1184 ideb = iad_elem(1,p)
1185 ifin = iad_elem(1,p+1)-1
1186 iad_rbe3m(p) = n
1187 DO i = ideb, ifin
1188 IF(itabrbe3m(dd_elem(i))>0) THEN
1189 dd_rbe3m(n) = dd_elem(i)
1190 dp_rbe3m(n) = itabrbe3m(dd_elem(i))
1191 n = n + 1
1192 ENDIF
1193 ENDDO
1194 ENDDO
1195 iad_rbe3m(nspmd+1) = n
1196 if(n-1/=nbddrbe3m)then
1197 print*,'error decomp RBE3',n-1,nbddrbe3m
1198 endif
1199 ENDIF
1200C
1201C RBE2
1202C
1203 DO p = 1, nspmd+1
1204 iad_rbe2(p) = 1
1205 ENDDO
1206 IF(nbddrbe2>0) THEN
1207 n = 1
1208 DO p = 1, nspmd
1209 ideb = iad_elem(1,p)
1210 ifin = iad_elem(1,p+1)-1
1211 iad_rbe2(p) = n
1212 DO i = ideb, ifin
1213 IF(itabrbe2m(dd_elem(i))>0) THEN
1214 dd_rbe2(n) = itabrbe2m(dd_elem(i))
1215 n = n + 1
1216 ENDIF
1217 ENDDO
1218 ENDDO
1219 iad_rbe2(nspmd+1) = n
1220 if(n-1/=nbddrbe2)then
1221 print*,'error decomp RBE2',n-1,nbddrbe2
1222 endif
1223 ENDIF
1224C
1225C Itet=2 of Tetra10 same than int2
1226C
1227 DO p = 1, nspmd+1
1228 iad_cndm(p) = 0
1229 ENDDO
1230 IF(nbddcndm>0) THEN
1231 n = 1
1232 DO p = 1, nspmd
1233 ideb = iad_elem(1,p)
1234 ifin = iad_elem(1,p+1)-1
1235 iad_cndm(p) = n
1236 DO i = ideb, ifin
1237 IF(itabcndm(dd_elem(i))>0) THEN
1238 dd_cndm(n) = dd_elem(i)
1239c DD_CNDM(N) = ITABCNDM(DD_ELEM(I))
1240 n = n + 1
1241 ENDIF
1242 ENDDO
1243 ENDDO
1244 iad_cndm(nspmd+1) = n
1245 if(n-1/=nbddcndm)then
1246 print*,'error decomp Itet2 of S10',n-1,nbddcndm
1247 endif
1248 ENDIF
1249C
1250C Section specifique
1251C
1252 nnl_l = 0
1253 nnt_l = 0
1254 IF (nsect>0) k0=nstrf(25)
1255 DO i = 1, nsect
1256 DO p = 1, nspmd+1
1257 dd_sec(p,i) = 0
1258 ENDDO
1259 IF(isecut*isp0==1)THEN
1260 DO p = 1, nspmd+2
1261 iad_cut(p,i) = 0
1262 ENDDO
1263 END IF
1264C
1265 typ= nstrf(k0)
1266 n1 = nstrf(k0+3)
1267 n2 = nstrf(k0+4)
1268 n3 = nstrf(k0+5)
1269 nnod = nstrf(k0+6)
1270 ifram = nstrf(k0+26)
1271 k2 = k0+30+nstrf(k0+14)
1272 IF (ifram<=10.OR.n1/=0) THEN
1273 IF(n1>0) THEN
1274 DO p = 1, nspmd
1275 IF (nlocal(n1,p)==1)THEN
1276 dd_sec(p,i) = dd_sec(p,i) + 1
1277 GOTO 2001
1278 END IF
1279 END DO
1280 2001 CONTINUE
1281 END IF
1282 IF(n2>0) THEN
1283 DO p = 1, nspmd
1284 IF (nlocal(n2,p)==1)THEN
1285 dd_sec(p,i) = dd_sec(p,i) + 1
1286 GOTO 2002
1287 END IF
1288 END DO
1289 2002 CONTINUE
1290 END IF
1291 IF(n3>0) THEN
1292 DO p = 1, nspmd
1293 IF (nlocal(n3,p)==1)THEN
1294 dd_sec(p,i) = dd_sec(p,i) + 1
1295 GOTO 2003
1296 END IF
1297 END DO
1298 2003 CONTINUE
1299 END IF
1300 END IF
1301 IF(mod(ifram,10)==1.OR.mod(ifram,10)==2) THEN
1302 DO p = 1, nspmd
1303 secvu(p) = 0
1304 END DO
1305 DO nn = 1, nnod
1306 DO p = 1, nspmd
1307 IF (nlocal(nstrf(k2+nn-1),p)==1)THEN
1308 secvu(p) = 1
1309 GOTO 2004
1310 END IF
1311 END DO
1312 2004 CONTINUE
1313 END DO
1314 DO p = 1, nspmd
1315 dd_sec(p,i) = dd_sec(p,i) + secvu(p)
1316 END DO
1317 END IF
1318C cut
1319 IF(isecut==1) THEN
1320 IF (typ>=1)THEN
1321 DO nn = 1, nnod
1322 IF (nlocal(nstrf(k2+nn-1),proc)==1)THEN
1323 nnl_l = nnl_l + 1
1324 rg_cut(nnl_l) = nn
1325 END IF
1326 END DO
1327 ENDIF
1328 IF(proc==1) THEN
1329 IF(typ>=1) THEN
1330 DO p = 1, nspmd
1331 nn_l = 0
1332 DO nn = 1, nnod
1333 k = nstrf(k2+nn-1)
1334 IF(nlocal(k,p)==1)THEN
1335 nn_l = nn_l + 1
1336 dd_cut(nnt_l+nn_l) = nn
1337 END IF
1338 END DO
1339 nnt_l = nnt_l + nn_l
1340 iad_cut(p,i) = nn_l
1341 iad_cut(nspmd+1,i) = iad_cut(nspmd+1,i)+nn_l
1342 END DO
1343 END IF
1344 iad_cut(nspmd+2,i) = nnod
1345 END IF
1346 END IF
1347C
1348 k0=nstrf(k0+24)
1349C
1350 imax = 0
1351 pmain = 1
1352 DO p = 1, nspmd
1353 IF(dd_sec(p,i)>imax)THEN
1354 pmain = p
1355 imax = dd_sec(p,i)
1356 END IF
1357 END DO
1358 dd_sec(nspmd+1,i) = pmain
1359 END DO
1360C
1361 DO p = 1, nspmd+1
1362 iad_sec(1,p) = 0
1363 iad_sec(2,p) = 0
1364 iad_sec(3,p) = 0
1365 iad_sec(4,p) = 0
1366 ENDDO
1367C noeuds N1, N2, N3 NNODE a echanger
1368 DO i = 1, nsect
1369 pmain = dd_sec(nspmd+1,i)
1370 IF(proc==pmain) THEN
1371 DO p = 1, nspmd
1372 IF(p/=pmain) THEN
1373 iad_sec(2,p) = iad_sec(2,p) + dd_sec(p,i)
1374 END IF
1375 END DO
1376 ELSE
1377 iad_sec(1,pmain) = iad_sec(1,pmain) + dd_sec(proc,i)
1378 END IF
1379 END DO
1380C renvoi des X N1, N2, N3 NNODE aux procs possedant des elements de sections
1381 DO p = 1, nspmd
1382 dd_p(p) = 0
1383 ENDDO
1384C
1385 ip = 30
1386 DO i = 1, nsect
1387 n1 = nstrf(ip+4)
1388 n2 = nstrf(ip+5)
1389 n3 = nstrf(ip+6)
1390 ifram = nstrf(ip+27)
1391 nnod_s = nstrf(ip+7)
1392 nsels_s = nstrf(ip+8)
1393 nselq_s = nstrf(ip+9)
1394 nselc_s = nstrf(ip+10)
1395 nselt_s = nstrf(ip+11)
1396 nselp_s = nstrf(ip+12)
1397 nselr_s = nstrf(ip+13)
1398 nseltg_s= nstrf(ip+14)
1399 nsint_s = nstrf(ip+15)
1400 ip = ip + 30 + nsint_s + nnod_s
1401 ip0 = ip
1402 pmain = dd_sec(nspmd+1,i)
1403C determination du nombre de noeuds a echange
1404 dd_p(pmain) = dd_p(pmain) + 1
1405 IF(proc==pmain) THEN
1406 DO p = 1, nspmd
1407 ip = ip0
1408 IF(p/=pmain) THEN
1409 imax = 0
1410 off = 0
1411 DO j = 1, nsels_s
1412 k = nstrf(ip + j*2 - 1)
1413 IF(cep(k+off)+1==p) imax = 1
1414 END DO
1415 IF(imax==1) GO TO 3000
1416 ip = ip + 2*nsels_s
1417 off = off+numels
1418 DO j = 1, nselq_s
1419 k = nstrf(ip + j*2 - 1)
1420 IF(cep(k+off)+1==p) imax = 1
1421 END DO
1422 IF(imax==1) GO TO 3000
1423 ip = ip + 2*nselq_s
1424 off = off+numelq
1425
1426 DO j = 1, nselc_s
1427 k = nstrf(ip + j*2 - 1)
1428 IF(cep(k+off)+1==p) imax = 1
1429 END DO
1430 IF(imax==1) GO TO 3000
1431 ip = ip + 2*nselc_s
1432 off = off + numelc
1433 DO j = 1, nselt_s
1434 k = nstrf(ip + j*2 - 1)
1435 IF(cep(k+off)+1==p) imax = 1
1436 END DO
1437 IF(imax==1) GO TO 3000
1438 ip = ip + 2*nselt_s
1439 off = off + numelt
1440 DO j = 1, nselp_s
1441 k = nstrf(ip + j*2 - 1)
1442 IF(cep(k+off)+1==p) imax = 1
1443 END DO
1444 IF(imax==1) GO TO 3000
1445 ip = ip + 2*nselp_s
1446 off = off + numelp
1447 DO j = 1, nselr_s
1448 k = nstrf(ip + j*2 - 1)
1449 IF(cep(k+off)+1==p) imax = 1
1450 END DO
1451 IF(imax==1) GO TO 3000
1452 ip = ip + 2*nselr_s
1453 off = off + numelr
1454 DO j = 1, nseltg_s
1455 k = nstrf(ip + j*2 - 1)
1456 IF(cep(k+off)+1==p) imax = 1
1457 END DO
1458 ip = ip + 2*nseltg_s
1459 3000 CONTINUE
1460C si element de la section present sur le proc
1461c IF(IMAX==1) THEN
1462 IF(imax==1.OR.isecut==1) THEN
1463c IAD_SEC(3,P) = IAD_SEC(3,P) + NN
1464 iad_sec(3,p) = iad_sec(3,p) + 1
1465 END IF
1466 END IF
1467 END DO
1468 ELSE
1469 ip = ip0
1470 imax = 0
1471 off = 0
1472 DO j = 1, nsels_s
1473 k = nstrf(ip + j*2 - 1)
1474 IF(cep(k+off)+1==proc) imax = 1
1475 END DO
1476 IF(imax==1) GO TO 4000
1477 ip = ip + 2*nsels_s
1478 off = off + numels
1479 DO j = 1, nselq_s
1480 k = nstrf(ip + j*2 - 1)
1481 IF(cep(k+off)+1==proc) imax = 1
1482 END DO
1483 IF(imax==1) GO TO 4000
1484 ip = ip + 2*nselq_s
1485 off = off + numelq
1486 DO j = 1, nselc_s
1487 k = nstrf(ip + j*2 - 1)
1488 IF(cep(k+off)+1==proc) imax = 1
1489 END DO
1490 IF(imax==1) GO TO 4000
1491 ip = ip + 2*nselc_s
1492 off = off + numelc
1493 DO j = 1, nselt_s
1494 k = nstrf(ip + j*2 - 1)
1495 IF(cep(k+off)+1==proc) imax = 1
1496 END DO
1497 IF(imax==1) GO TO 4000
1498 ip = ip + 2*nselt_s
1499 off = off + numelt
1500 DO j = 1, nselp_s
1501 k = nstrf(ip + j*2 - 1)
1502 IF(cep(k+off)+1==proc) imax = 1
1503 END DO
1504 IF(imax==1) GO TO 4000
1505 ip = ip + 2*nselp_s
1506 off = off + numelp
1507 DO j = 1, nselr_s
1508 k = nstrf(ip + j*2 - 1)
1509 IF(cep(k+off)+1==proc) imax = 1
1510 END DO
1511 IF(imax==1) GO TO 4000
1512 ip = ip + 2*nselr_s
1513 off = off + numelr
1514 DO j = 1, nseltg_s
1515 k = nstrf(ip + j*2 - 1)
1516 IF(cep(k+off)+1==proc) imax = 1
1517 END DO
1518 ip = ip + 2*nseltg_s
1519 4000 CONTINUE
1520C si element de la section present sur le proc
1521 IF(imax==1.OR.isecut==1) THEN
1522 iad_sec(4,pmain) = iad_sec(4,pmain) + 1
1523
1524 END IF
1525 END IF
1526 ip = ip0 + 2*(nsels_s+nselq_s+nselc_s+
1527 + nselt_s+nselp_s+nselr_s+nseltg_s)
1528 END DO
1529C
1530 DO p = 1, nspmd
1531 IF(iad_sec(3,p)/=0)THEN
1532 iad_sec(3,p) = dd_p(proc)
1533 ENDIF
1534 IF(iad_sec(4,p)/=0)THEN
1535 iad_sec(4,p) = dd_p(p)
1536 ENDIF
1537 ENDDO
1538C
1539 DO p = 1, nspmd
1540 iad_sec(1,nspmd+1) = iad_sec(1,nspmd+1) + iad_sec(1,p)
1541 iad_sec(2,nspmd+1) = iad_sec(2,nspmd+1) + iad_sec(2,p)
1542 iad_sec(3,nspmd+1) = iad_sec(3,nspmd+1) + iad_sec(3,p)
1543 iad_sec(4,nspmd+1) = iad_sec(4,nspmd+1) + iad_sec(4,p)
1544 ENDDO
1545C
1546C Couplage Madymo
1547C
1548 DO i = 1, nspmd+1
1549 dd_mad(1,i) = 0
1550 dd_mad(2,i) = 0
1551 dd_mad(3,i) = 0
1552 dd_mad(4,i) = 0
1553 dd_mad(5,i) = 0
1554 END DO
1555C
1556 dd_mad(5,1) = nconx
1557 dd_mad(5,nspmd+1) = nconx
1558C
1559 IF(nexmad/=0) THEN
1560C
1561C ELEM shell4
1562C
1563 DO p = 1, nspmd
1564 ideb = 1 + 7*nconx + nmadprt
1565 eshift = numels+numelq
1566 nmad_l = 0
1567 DO i = 1, nmadsh4
1568 k = iexmad(ideb+i-1)
1569 IF(cep(k+eshift)==p-1) THEN
1570 nmad_l = nmad_l+1
1571 END IF
1572 END DO
1573 dd_mad(1,p) = nmad_l
1574C
1575C Elem shell3
1576C
1577 ideb = ideb + nmadsh4
1578 eshift = numels+numelq+numelc+numelt+numelp+numelr
1579 nmad_l = 0
1580 DO i = 1, nmadsh3
1581 k = iexmad(ideb+i-1)
1582 IF(cep(k+eshift)==p-1) THEN
1583 nmad_l = nmad_l+1
1584 END IF
1585 END DO
1586 dd_mad(2,p) = nmad_l
1587C
1588C Elem solides
1589C
1590 ideb = ideb + nmadsh3
1591 eshift = 0
1592 nmad_l = 0
1593 DO i = 1, nmadsol
1594 k = iexmad(ideb+i-1)
1595 IF(cep(k+eshift)==p-1) THEN
1596 nmad_l = nmad_l+1
1597 END IF
1598 END DO
1599 dd_mad(3,p) = nmad_l
1600C
1601C Noeuds
1602C
1603 ideb = ideb + nmadsol
1604 nmad_l = 0
1605 DO i = 1, nmadnod
1606 k = iexmad(ideb+i-1)
1607 IF(nlocal(k,p)==1) THEN
1608 DO pp = 1, p-1
1609 IF(nlocal(k,pp)==1) GOTO 888
1610 END DO
1611 nmad_l = nmad_l+1
1612 END IF
1613 888 CONTINUE
1614 END DO
1615 dd_mad(4,p) = nmad_l
1616 END DO
1617 dd_mad(1,nspmd+1) = nmadsh4
1618 dd_mad(2,nspmd+1) = nmadsh3
1619 dd_mad(3,nspmd+1) = nmadsol
1620 dd_mad(4,nspmd+1) = nmadnod
1621 END IF
1622C
1623C NEWFRONT
1624C
1625 DO i = 1, ninter
1626 newfront(i) = 0
1627 END DO
1628C
1629C Frontieres CFD
1630C
1631 IF(iale+ieuler+itherm+ialelag/=0)THEN
1632C
1633C Partie nodale LNRCVOIS
1634C
1635 nr_l = 0
1636 ns_l = 0
1637 nf_l = 0
1638 ii = 0
1639 jj = 0
1640 DO p = 1, nspmd+1
1641 nbrcvois(p) = 0
1642 npsegcom(p) = 0
1643 nbsdvois(p) = 0
1644 nercvois(p) = 0
1645 nesdvois(p) = 0
1646 END DO
1647 DO i = 1, numnod
1648 tag(i) = 0
1649 END DO
1650 DO i = 1, numel
1651 tage(i) = 0
1652 END DO
1653C
1654 DO p = 1, nspmd
1655 IF(p/=proc)THEN
1656 DO i = 1, numel_l
1657 tage_l(p,i) = 0
1658 END DO
1659 DO i = 1, numnod_l
1660 tag_l(p,i) = 0
1661 END DO
1662 END IF
1663 DO i = 1, segindx
1664 tags(p,i) = 0
1665 END DO
1666 END DO
1667C
1668 DO ng=1,ngroup
1669 jtur=iparg(12,ng)
1670 jthe=iparg(13,ng)
1671C test agrad0
1672 IF(iparg(32,ng)+1==proc) THEN
1673 nel = iparg(2,ng)
1674 nft = iparg(3,ng)
1675 ity = iparg(5,ng)
1676C voir autres types solides
1677 isolnod = iparg(28,ng)
1678C 3D
1679 IF(ity==1) THEN
1680 DO i = 1, nel
1681 ie = i+nft
1682 ie_loc = cel(ie)
1683C IVOIS
1684 iad1 = ale_connectivity%ee_connect%iad_connect(ie)
1685 lgth = ale_connectivity%ee_connect%iad_connect(ie+1)-ale_connectivity%ee_connect%iad_connect(ie)
1686 DO j = 1, lgth
1687 iv = ale_connectivity%ee_connect%connected(iad1 + j - 1)
1688 IF (iv>0) THEN
1689 proc2 = cep(iv)+1
1690 IF(proc2/=proc) THEN
1691 IF(tage(iv)==0) THEN
1692 ii = ii + 1
1693 tager(ii)=iv
1694 cpulocaler(ii)=proc2
1695C no elt frontiere > no elt interne
1696 lercvois(ii) = numels_l+ii
1697 tage(iv) = proc2
1698 nercvois(proc2) = nercvois(proc2)+1
1699 END IF
1700 IF(tage_l(proc2,ie_loc)==0)THEN
1701 jj = jj+1
1702 tages(jj)=ie
1703 cpulocales(jj)=proc2
1704 lesdvois(jj) = ie_loc
1705 tage_l(proc2,ie_loc)=proc2
1706 nesdvois(proc2) = nesdvois(proc2)+1
1707 END IF
1708 END IF
1709 ELSEIF(proc/=1.AND.iv<0)THEN
1710C IV < 0 : SEGMENT INT12
1711 IF(tags(1,-iv)==0)THEN
1712 nf_l = nf_l + 1
1713 lsegcom(nf_l) = -iv
1714 cpulocalf(nf_l)=1
1715 tags(1,-iv) = 1
1716 npsegcom(1) = npsegcom(1)+1
1717 END IF
1718 END IF
1719 END DO
1720 END DO
1721C 2D
1722 ELSEIF(ity==2) THEN
1723 DO i = 1, nel
1724 ie = i+nft
1725 ie_loc = cel(ie)
1726 iad1 = ale_connectivity%ee_connect%iad_connect(ie)
1727 lgth = ale_connectivity%ee_connect%iad_connect(ie+1)-ale_connectivity%ee_connect%iad_connect(ie)
1728C IVOIS
1729 DO j = 1, lgth
1730 iv = ale_connectivity%ee_connect%connected(iad1 + j - 1)
1731 IF (iv>0) THEN
1732 proc2 = cep(iv)+1
1733 IF(proc2/=proc) THEN
1734 IF(tage(iv)==0) THEN
1735 ii = ii + 1
1736 tager(ii)=iv
1737 cpulocaler(ii)=proc2
1738C no elt frontiere > no elt interne
1739 lercvois(ii) = numelq_l+ii
1740 tage(iv) = proc2
1741 nercvois(proc2) = nercvois(proc2)+1
1742 END IF
1743 IF(tage_l(proc2,ie_loc)==0)THEN
1744 jj = jj+1
1745 tages(jj)=ie
1746 cpulocales(jj)=proc2
1747 lesdvois(jj) = ie_loc
1748 tage_l(proc2,ie_loc)=proc2
1749 nesdvois(proc2) = nesdvois(proc2)+1
1750 END IF
1751 END IF
1752 END IF
1753 END DO
1754 END DO
1755C 2D -> triangles
1756 ELSEIF(ity==7 .AND. (n2d /= 0 .AND. multi_fvm%IS_USED)) THEN
1757 DO i = 1, nel
1758 ie = i+nft
1759 ie_loc = cel(ie)
1760 iad1 = ale_connectivity%ee_connect%iad_connect(ie)
1761 lgth = ale_connectivity%ee_connect%iad_connect(ie+1)-ale_connectivity%ee_connect%iad_connect(ie)
1762C IVOIS
1763 DO j = 1, lgth
1764 iv = ale_connectivity%ee_connect%connected(iad1 + j - 1)
1765 IF (iv>0) THEN
1766 proc2 = cep(iv)+1
1767 IF(proc2/=proc) THEN
1768 IF(tage(iv)==0) THEN
1769 ii = ii + 1
1770 tager(ii)=iv
1771 cpulocaler(ii)=proc2
1772C no elt frontiere > no elt interne
1773 lercvois(ii) = numeltg_l+ii
1774 tage(iv) = proc2
1775 nercvois(proc2) = nercvois(proc2)+1
1776 END IF
1777 IF(tage_l(proc2,ie_loc)==0)THEN
1778 jj = jj+1
1779 tages(jj)=ie
1780 cpulocales(jj)=proc2
1781 lesdvois(jj) = ie_loc
1782 tage_l(proc2,ie_loc)=proc2
1783 nesdvois(proc2) = nesdvois(proc2)+1
1784 END IF
1785 END IF
1786 END IF
1787 END DO
1788 END DO
1789 END IF
1790C
1791 ELSEIF(segindx>0.AND.proc==1)THEN ! IPARG(32,NG)+1/=PROC
1792 nel = iparg(2,ng)
1793 nft = iparg(3,ng)
1794 ity = iparg(5,ng)
1795 p = iparg(32,ng)+1
1796 IF(p/=proc) THEN
1797C voir autres types solides
1798 isolnod = iparg(28,ng)
1799C 3D
1800 IF(ity==1) THEN
1801 DO i = 1, nel
1802 ie = i+nft
1803C IVOIS
1804 iad1 = ale_connectivity%ee_connect%iad_connect(ie)
1805 lgth = ale_connectivity%ee_connect%iad_connect(ie+1)-ale_connectivity%ee_connect%iad_connect(ie)
1806 DO j = 1, lgth
1807 iv = ale_connectivity%ee_connect%connected(iad1 + j - 1)
1808 IF(iv<0)THEN
1809C IV < 0 : SEGMENT INT12
1810 IF(tags(p,-iv)==0)THEN
1811 nf_l = nf_l + 1
1812 lsegcom(nf_l) = -iv
1813 cpulocalf(nf_l)=p
1814 tags(p,-iv) = 1
1815 npsegcom(p) = npsegcom(p)+1
1816 END IF
1817 END IF
1818 END DO
1819 END DO
1820 END IF
1821 END IF
1822 END IF
1823 END DO
1824C
1825C
1826C Traitement supplementaire Couplage Fluide/Structure
1827C
1828! Don't use here PLIST_IFRONT instead of NLOCAL
1829! because it increases cpu time
1830 DO i=1,numels
1831 DO j=1,8
1832 ns = ixs(j+1,i)
1833 IF ( (nodlocal(ns)/=0) .AND. (nodlocal(ns)<=numnod_l) ) THEN
1834 iad1 = ale_connectivity%ee_connect%iad_connect(i)
1835 lgth = ale_connectivity%ee_connect%iad_connect(i+1)-ale_connectivity%ee_connect%iad_connect(i)
1836 DO k=1,lgth
1837 ie = ale_connectivity%ee_connect%connected(iad1 + k - 1)
1838 IF (ie>0) THEN
1839 DO l = 1,8
1840 n = ixs(l+1,ie)
1841 IF(tag(n)==0) THEN
1842 IF ( (nodlocal(n)==0).OR.(nodlocal(n)>numnod_l) ) THEN
1843 nr_l = nr_l + 1
1844 lnrcvois(nr_l) = n
1845 tag(n) = 1
1846
1847 psearch = .true.
1848 iad = ifront%IENTRY(n)
1849 IF(iad <= 0) psearch = .false.
1850C loop over all processors that have node N
1851C Two iterations max because of GOTO
1852 DO WHILE(psearch)
1853 proc2 = ifront%P(1,iad)
1854 IF(proc2/=proc)THEN
1855 cpulocalr(nr_l) = proc2
1856 nbrcvois(proc2) = nbrcvois(proc2)+1
1857 psearch = .false.
1858 ENDIF ! proc2/=proc
1859 IF(ifront%P(2,iad)==0) psearch = .false.
1860 iad = ifront%P(2,iad)
1861 END DO
1862 ENDIF ! nlocal(n,proc)=0
1863 ENDIF ! tag(n)=0
1864 ENDDO
1865 END IF
1866 ENDDO
1867 ENDIF
1868 ENDDO
1869 ENDDO
1870
1871 DO ijk=1,size_ale_elm
1872 i = ale_elm%SOL_ID(ijk)
1873 iad1 = ale_connectivity%ee_connect%iad_connect(i)
1874 lgth = ale_connectivity%ee_connect%iad_connect(i+1)-ale_connectivity%ee_connect%iad_connect(i)
1875 DO j=1,8
1876 ns = ixs(j+1,i)
1877 DO k=1,lgth
1878 solv = ale_connectivity%ee_connect%connected(iad1 + k - 1)
1879 IF (solv>0) THEN
1880 DO l=1,8
1881 n = ixs(l+1,solv)
1882 IF ( (nodlocal(n)/=0).AND.(nodlocal(n)<=numnod_l) ) THEN
1883 IF( ifront%IENTRY(n) /=0) THEN
1884 IF( ifront%P(1,ifront%IENTRY(n)) < proc) GOTO 1111
1885 ENDIF
1886
1887 psearch = .true.
1888 iad = ifront%IENTRY(ns)
1889 IF(iad <= 0) psearch = .false.
1890 DO WHILE(psearch)
1891 p = ifront%P(1,iad)
1892 IF(p/=proc) THEN
1893 IF(tag_l(p,nodlocal(n))==0) THEN
1894 IF(nlocal(n,p)==0) THEN
1895 ns_l = ns_l + 1
1896 lnsdvois(ns_l) = n
1897 cpulocals(ns_l) = p
1898 nbsdvois(p) = nbsdvois(p)+1
1899 tag_l(p,nodlocal(n)) = 1
1900 END IF ! nlocal(n,p) = 0
1901 ENDIF ! tag_l = 0
1902 ENDIF ! p/=proc
1903 IF(ifront%P(2,iad)==0) psearch = .false.
1904 iad = ifront%P(2,iad)
1905 END DO
1906 1111 CONTINUE
1907 END IF
1908 ENDDO
1909 ENDIF
1910 ENDDO
1911 END DO
1912 ENDDO
1913 DO i=1,numelq
1914 iad1 = ale_connectivity%ee_connect%iad_connect(i)
1915 lgth = ale_connectivity%ee_connect%iad_connect(i+1)-ale_connectivity%ee_connect%iad_connect(i)
1916 DO j=1,4
1917 ns = ixq(j+1,i)
1918 IF ( (nodlocal(ns)/=0).AND.(nodlocal(ns)<=numnod_l) ) THEN
1919 DO k=1,lgth
1920 ie = ale_connectivity%ee_connect%connected(iad1 + k - 1)
1921 IF (ie>0) THEN
1922 DO l = 1,4
1923 n = ixq(l+1,ie)
1924 IF(tag(n)==0) THEN
1925 IF ( (nodlocal(n)==0).OR.(nodlocal(n)>numnod_l) ) THEN
1926 nr_l = nr_l + 1
1927 lnrcvois(nr_l) = n
1928 tag(n) = 1
1929 DO proc2 = 1, nspmd
1930 IF(proc2/=proc) THEN
1931 IF(nlocal(n,proc2)==1) THEN
1932 cpulocalr(nr_l) = proc2
1933 nbrcvois(proc2) = nbrcvois(proc2)+1
1934 GOTO 2112
1935 ENDIF ! nlocal(n,proc2)=1
1936 END IF ! proc2/=proc
1937 END DO
1938 2112 CONTINUE
1939 ENDIF ! nlocal(n,proc)=0
1940 ENDIF ! tag(n)=0
1941 ENDDO
1942 END IF
1943 ENDDO
1944 ENDIF
1945 ENDDO
1946
1947 DO j=1,4
1948 ns = ixq(j+1,i)
1949 DO k=1,lgth
1950 solv = ale_connectivity%ee_connect%connected(iad1 + k - 1)
1951 IF (solv>0) THEN
1952 DO l=1,4
1953 n = ixq(l+1,solv)
1954 IF ( (nodlocal(n)/=0).AND.(nodlocal(n)<=numnod_l) ) THEN
1955 DO proc2 = 1, proc-1
1956 IF(nlocal(n,proc2)==1)GOTO 1112
1957 END DO
1958 DO p = 1, nspmd
1959 IF(p/=proc) THEN
1960 IF(tag_l(p,nodlocal(n))==0) THEN
1961 IF(nlocal(ns,p)==1) THEN
1962 IF(nlocal(n,p)==0) THEN
1963 ns_l = ns_l + 1
1964 lnsdvois(ns_l) = n
1965 cpulocals(ns_l) = p
1966 nbsdvois(p) = nbsdvois(p)+1
1967 tag_l(p,nodlocal(n)) = 1
1968 ENDIF ! nlocal(n,p)=0
1969 END IF ! nlocal(ns,p)=1
1970 ENDIF ! tag_l = 0
1971 ENDIF ! p/=proc
1972 END DO
1973 1112 CONTINUE
1974 END IF
1975 ENDDO
1976 ENDIF
1977 ENDDO
1978 END DO
1979 ENDDO
1980C 2D --> triangles
1981 IF (n2d /= 0 .AND. multi_fvm%IS_USED) THEN
1982 DO i=1,numeltg
1983 iad1 = ale_connectivity%ee_connect%iad_connect(i)
1984 lgth = ale_connectivity%ee_connect%iad_connect(i+1)-ale_connectivity%ee_connect%iad_connect(i)
1985 DO j=1,3
1986 ns = ixtg(j+1,i)
1987 IF ( (nodlocal(ns)/=0).AND.(nodlocal(ns)<=numnod_l) ) THEN
1988 DO k=1,lgth
1989 ie = ale_connectivity%ee_connect%connected(iad1 + k - 1)
1990 IF (ie>0) THEN
1991 DO l = 1,3
1992 n = ixtg(l+1,ie)
1993 IF(tag(n)==0) THEN
1994 IF ( (nodlocal(n)==0).OR.(nodlocal(n)>numnod_l) ) THEN
1995 nr_l = nr_l + 1
1996 lnrcvois(nr_l) = n
1997 tag(n) = 1
1998 DO proc2 = 1, nspmd
1999 IF(proc2/=proc) THEN
2000 IF(nlocal(n,proc2)==1) THEN
2001 cpulocalr(nr_l) = proc2
2002 nbrcvois(proc2) = nbrcvois(proc2)+1
2003 GOTO 2113
2004 ENDIF ! nlocal(n,proc2)=1
2005 END IF ! proc2/=proc
2006 END DO
2007 2113 CONTINUE
2008 ENDIF ! nlocal(n,proc)=0
2009 ENDIF ! tag(n)=0
2010 ENDDO
2011 END IF
2012 ENDDO
2013 ENDIF
2014 ENDDO
2015
2016 DO j=1,3
2017 ns = ixtg(j+1,i)
2018 DO k=1,lgth
2019 solv = ale_connectivity%ee_connect%connected(iad1 + k - 1)
2020 IF (solv>0) THEN
2021 DO l=1,3
2022 n = ixtg(l+1,solv)
2023 IF ( (nodlocal(n)/=0).AND.(nodlocal(n)<=numnod_l) ) THEN
2024 DO proc2 = 1, proc-1
2025 IF(nlocal(n,proc2)==1)GOTO 1113
2026 END DO
2027 DO p = 1, nspmd
2028 IF(p/=proc) THEN
2029 IF(tag_l(p,nodlocal(n))==0) THEN
2030 IF(nlocal(ns,p)==1) THEN
2031 IF(nlocal(n,p)==0) THEN
2032 ns_l = ns_l + 1
2033 lnsdvois(ns_l) = n
2034 cpulocals(ns_l) = p
2035 nbsdvois(p) = nbsdvois(p)+1
2036 tag_l(p,nodlocal(n)) = 1
2037 ENDIF ! nlocal(n,p)=0
2038 END IF ! nlocal(ns,p)=1
2039 ENDIF ! tag_l = 0
2040 ENDIF ! p/=proc
2041 END DO
2042 1113 CONTINUE
2043 END IF
2044 ENDDO
2045 ENDIF
2046 ENDDO
2047 END DO
2048 ENDDO
2049 ENDIF
2050C
2051C Tris LNRCVOIS + renumerotation locale
2052C
2053 if(nr_l/=nrcvvois)print*,'error cfd node boundaries:',nr_l,
2054 . nrcvvois
2055 DO i = 1, nrcvvois
2056 itri4(1,i) = cpulocalr(i)
2057 itri4(2,i) = lnrcvois(i)
2058 END DO
2059 CALL my_orders(0,work,itri4,index4,nrcvvois,2)
2060C
2061 DO i = 1, nrcvvois
2062 lnrcvois(i) = nodlocal(itri4(2,index4(i)))
2063 END DO
2064C
2065C Tris LNSDVOIS + renumerotation locale
2066C
2067 if(ns_l/=nsndvois)print*,'error cfd node boundaries :',ns_l,
2068 . nsndvois
2069 DO i = 1, nsndvois
2070 itri4(1,i) = cpulocals(i)
2071 itri4(2,i) = lnsdvois(i)
2072 END DO
2073 CALL my_orders(0,work,itri4,index4,nsndvois,2)
2074C
2075 DO i = 1, nsndvois
2076 lnsdvois(i) = nodlocal(itri4(2,index4(i)))
2077 END DO
2078
2079C
2080C Tris LERCVOIS
2081C
2082 if(ii/=nervois)print*,'error cfd elem boundaries:',ii,
2083 . nervois
2084 DO i = 1, nervois
2085 itri4(1,i) = cpulocaler(i)
2086 itri4(2,i) = tager(i)
2087 END DO
2088 CALL my_orders(0,work,itri4,index4,nervois,2)
2089 DO i = 1, nervois
2090 itri4(2,i) = lercvois(i)
2091 END DO
2092 DO i = 1, nervois
2093 lercvois(i) = itri4(2,index4(i))
2094 END DO
2095C
2096C Tris LESDVOIS
2097C
2098 if(jj/=nesvois)print*,'error cfd elem boundaries :',jj,
2099 . nesvois
2100 DO i = 1, nesvois
2101 itri4(1,i) = cpulocales(i)
2102 itri4(2,i) = tages(i)
2103 END DO
2104 CALL my_orders(0,work,itri4,index4,nesvois,2)
2105 DO i = 1, nesvois
2106 itri4(2,i) = lesdvois(i)
2107 END DO
2108 DO i = 1, nesvois
2109 lesdvois(i) = itri4(2,index4(i))
2110 END DO
2111C
2112C Tris LSEGCOM
2113C
2114 if(nf_l/=nsegfl_l)print*,'error cfd segment boundaries:',nf_l,
2115 . nsegfl_l
2116 DO i = 1, nsegfl_l
2117 itri4(1,i) = cpulocalf(i)
2118 itri4(2,i) = lsegcom(i)
2119 END DO
2120 CALL my_orders(0,work,itri4,index4,nsegfl_l,2)
2121C
2122 DO i = 1, nsegfl_l
2123 lsegcom(i) = itri4(2,index4(i))
2124 END DO
2125C
2126 DO p = 1, nspmd
2127 npsegcom(nspmd+1)=npsegcom(nspmd+1)+npsegcom(p)
2128 nbrcvois(nspmd+1)=nbrcvois(nspmd+1)+nbrcvois(p)
2129 nbsdvois(nspmd+1)=nbsdvois(nspmd+1)+nbsdvois(p)
2130 nercvois(nspmd+1)=nercvois(nspmd+1)+nercvois(p)
2131 nesdvois(nspmd+1)=nesdvois(nspmd+1)+nesdvois(p)
2132 END DO
2133C
2134C Porosite
2135C
2136 IF(numpor>0)THEN
2137 nad=0
2138 nad_l=0
2139 DO ig = 1, numgeo
2140 nporgeo(ig)=0
2141 IF(int(geo(12,ig))==15)THEN
2142 n=int(geo(31,ig))
2143 IF(n>0)THEN
2144 nn_l = 0
2145 DO j = nad+1, nad+n
2146 nn = pornod(j)
2147 IF ( nodlocal(nn)/=0.AND.nodlocal(nn)<=numnod_l ) THEN
2148 nn_l = nn_l + 1
2149 lnodpor(nad_l+nn_l)=j-nad
2150 END IF
2151 END DO
2152 nporgeo(ig)=nn_l
2153 nad = nad + n
2154 nad_l=nad_l+nn_l
2155 END IF
2156 END IF
2157 END DO
2158 END IF
2159 END IF
2160C
2161C Interface 18
2162C
2163 IF(nbi18_l>0)THEN
2164 nn = 0
2165 DO n=1,ninter
2166 ity = ipari(7,n)
2167 inacti = ipari(22,n)
2168 IF((ity==7.OR.ity==22).AND.inacti==7)THEN ! interface 18
2169 nn = nn + 1
2170 DO p = 1, nspmd
2171 dd_i18(p,nn) = 0
2172 END DO
2173 nrts = ipari(3,n)
2174 nrtm = ipari(4,n)
2175 DO k=1,nrtm
2176C TAGE flag servant pour inacti
2177 n1 = intbuf_tab(n)%IRECTM(4*(k-1)+1)
2178 n2 = intbuf_tab(n)%IRECTM(4*(k-1)+2)
2179 n3 = intbuf_tab(n)%IRECTM(4*(k-1)+3)
2180 n4 = intbuf_tab(n)%IRECTM(4*(k-1)+4)
2181 DO p = 1, nspmd
2182 IF(nlocal(n1,p)==1) THEN
2183 IF(nlocal(n2,p)==1) THEN
2184 IF(nlocal(n3,p)==1) THEN
2185 IF(nlocal(n4,p)==1) THEN
2186 dd_i18(p,nn) = dd_i18(p,nn) + 1
2187 GOTO 1300
2188 ENDIF ! N4
2189 ENDIF ! N3
2190 ENDIF ! N2
2191 END IF ! N1
2192 END DO
2193 1300 CONTINUE
2194 END DO
2195C nb total de segments
2196 dd_i18(nspmd+1,nn) = nrtm
2197C PMAIN
2198 pmain = 1
2199 DO p = 2, nspmd
2200 IF(dd_i18(p,nn)>dd_i18(pmain,nn))THEN
2201 pmain = p
2202 END IF
2203 END DO
2204 dd_i18(nspmd+2,nn) = pmain
2205 END IF
2206 END DO
2207 END IF
2208C
2209 IF ((nr2rlnk>0).AND.(nsubdom==0)) THEN
2210 DO n=1,nr2rlnk
2211 nn = iexlnk(1,n)
2212 nng = igrnod(nn)%NENTITY
2213 DO p = 1, nspmd
2214 dd_r2r(p,n) = 0
2215 END DO
2216 dd_r2r(nspmd+1,n) = nng
2217 DO i = 1, nng
2218 nod = igrnod(nn)%ENTITY(i)
2219 DO p = 1, nspmd
2220 IF(nlocal(nod,p)==1)THEN
2221 dd_r2r(p,n) = dd_r2r(p,n) + 1
2222 GO TO 1400
2223 END IF
2224 END DO
2225 1400 CONTINUE
2226 END DO
2227 END DO
2228 END IF
2229C
2230C Frontiere LAG MULT
2231C
2232 DO p = 1, nspmd
2233 dd_lagf(1,nspmd+1) = dd_lagf(1,nspmd+1)+dd_lagf(1,p) ! deja calcule ds routines de split
2234 dd_lagf(2,nspmd+1) = dd_lagf(2,nspmd+1)+dd_lagf(2,p) ! deja calcule ds routines de split
2235 END DO
2236C
2237 DO p = 1, nspmd+1
2238 dd_lagf(3,p) = 0
2239 END DO
2240C
2241 IF(lag_ncf>0) THEN
2242 DO n = 1, numnod
2243 tag(n) = 0
2244 END DO
2245c NLAGF = 0
2246 DO ic = 1, lag_ncf
2247 ik0 = iadll(ic)
2248 ikn = iadll(ic+1)-1
2249 DO ik = ik0,ikn
2250 n = lll(ik)
2251 IF(tag(n)==0) THEN
2252 tag(n) = 1
2253 DO p = 1, nspmd
2254 IF(nlocal(n,p)==1)THEN
2255 dd_lagf(3,p) = dd_lagf(3,p) + 1
2256 IF(p==proc)THEN
2257 llagf(dd_lagf(3,p)) = nodlocal(n)
2258 END IF
2259 GOTO 5000
2260 END IF
2261 END DO
2262 5000 CONTINUE
2263 END IF
2264 END DO
2265 END DO
2266 IF(dd_lagf(3,proc)/=nlagf_l)print*,
2267 + 'error : wrong lag mult decomposition !'
2268 DO p = 1, nspmd
2269 dd_lagf(3,nspmd+1) = dd_lagf(3,nspmd+1)+dd_lagf(3,p)
2270 END DO
2271 END IF
2272C-------------------------
2273C xfem edge boundary treatment
2274 IF(icrack3d > 0)THEN
2275C
2276 DO p = 1, nspmd+1
2277 iad_edge(p) = 0
2278 fr_nbedge(p) = 0
2279 ENDDO
2280C
2281C tag front edges (local)
2282C
2283 IF(nbddedge_l > 0)THEN
2284 ALLOCATE(tag_ied_fr0(2,nbddedge_l))
2285 tag_ied_fr0 = 0
2286 ELSE
2287 ALLOCATE(tag_ied_fr0(0,0))
2288 ENDIF
2289C
2290 ied_fr = 0
2291 DO p = 1,nspmd
2292 DO ied_gl=1,numedges
2293cc IF(EDGELOCAL(IED_GL) > 0.AND.IEDGE_TMP(1,IED_GL) > 1)THEN
2294 IF(iedge_tmp(3,ied_gl) < 0)THEN
2295 n1 = nodedge(1,ied_gl)
2296 n2 = nodedge(2,ied_gl)
2297 IF((nlocal(n1,proc)==1).AND.
2298 . (nlocal(n2,proc)==1))THEN
2299 IF(p/=proc)THEN
2300 IF((nlocal(n1,p)==1).AND.
2301 . (nlocal(n2,p)==1))THEN
2302C---
2303 ied_fr = ied_fr + 1
2304 tag_ied_fr0(1,ied_fr) = ied_gl
2305 tag_ied_fr0(2,ied_fr) = p
2306 fr_nbedge(p) = fr_nbedge(p) + 1
2307C---
2308 ENDIF
2309 ENDIF
2310 ENDIF
2311 ENDIF
2312 ENDDO ! DO IED_GL=1,NUMEDGES
2313 ENDDO ! DO P = 1,NSPMD
2314C
2315 nb_fredge = ied_fr
2316cc IF(NB_FREDGE == 0)GOTO 113
2317C
2318 IF(nb_fredge > 0)THEN
2319 ALLOCATE(fr_edge(nb_fredge))
2320 fr_edge = 0
2321 ELSE
2322 ALLOCATE(fr_edge(0))
2323 ENDIF
2324C
2325 IF(nb_fredge == 0)GOTO 113
2326 ied_fr = 0
2327 DO p = 1,nspmd
2328 IF(p /= proc)THEN
2329 DO i=1,nb_fredge
2330 IF(tag_ied_fr0(2,i) == p)THEN
2331 ied_gl = tag_ied_fr0(1,i)
2332 ied_fr = ied_fr + 1
2333c IED_FR = IEDGE_TMP(1,IED_GL)
2334 fr_edge(ied_fr) = edgelocal(ied_gl)
2335 ENDIF
2336 ENDDO
2337 ENDIF
2338 ENDDO
2339cc IAD_EDGE(1) = 1
2340cc DO I=2,NSPMD
2341cc IAD_EDGE(I)=IAD_EDGE(I-1)+FR_NBEDGE(P)
2342cc ENDDO
2343C
2344 113 CONTINUE
2345C
2346 iad_edge(1) = 1
2347 DO i=1,nspmd
2348 iad_edge(i+1)=iad_edge(i)+fr_nbedge(i)
2349 ENDDO
2350C
2351 DO p = 1, nspmd
2352 fr_nbedge(nspmd+1) = fr_nbedge(nspmd+1) + fr_nbedge(p)
2353 ENDDO
2354C
2355cc 113 CONTINUE
2356C
2357 IF(ALLOCATED(tag_ied_fr0))DEALLOCATE(tag_ied_fr0)
2358 ENDIF ! IF(ICRACK3D > 0)
2359
2360C
2361C Frontiers vs vertices
2362 lcsrect_l = 0
2363 IF(ninter25/=0)THEN
2364
2365 ni25=0
2366 ishift=0
2367 lshift=0
2368
2369 nl=1
2370 addcsrect_l(nl)=1
2371
2372 DO ni=1,ninter
2373 nty=ipari(7,ni)
2374 IF(nty/=25) cycle
2375
2376 nbddnor = 0
2377
2378 ni25=ni25+1
2379 nrtm =ipari(4,ni)
2380 nadmsr=ipari(67,ni)
2381 ALLOCATE(tag_sm(nadmsr),tag_ms(nadmsr))
2382 tag_sm(1:nadmsr)=0
2383
2384 nadmsr_l=0
2385 DO k=1,nrtm
2386 IF(intercep(1,ni)%P(k)==proc)THEN
2387 n1 = intbuf_tab(ni)%ADMSR(4*(k-1)+1)
2388 n2 = intbuf_tab(ni)%ADMSR(4*(k-1)+2)
2389 n3 = intbuf_tab(ni)%ADMSR(4*(k-1)+3)
2390 n4 = intbuf_tab(ni)%ADMSR(4*(k-1)+4)
2391 IF(tag_sm(n1)==0)THEN
2392 nadmsr_l=nadmsr_l+1
2393 tag_sm(n1)=nadmsr_l
2394 END IF
2395 IF(tag_sm(n2)==0)THEN
2396 nadmsr_l=nadmsr_l+1
2397 tag_sm(n2)=nadmsr_l
2398 END IF
2399 IF(tag_sm(n3)==0)THEN
2400 nadmsr_l=nadmsr_l+1
2401 tag_sm(n3)=nadmsr_l
2402 END IF
2403 IF(tag_sm(n4)==0)THEN
2404 nadmsr_l=nadmsr_l+1
2405 tag_sm(n4)=nadmsr_l
2406 END IF
2407 ENDIF
2408 ENDDO
2409
2410
2411 DO i = 1, nadmsr
2412 k = tag_sm(i)
2413 IF(k/=0)THEN
2414 tag_ms(k)=i
2415 END IF
2416 END DO
2417
2418 DO i = 1, nadmsr_l
2419 n = tag_ms(i) + ishift
2420
2421 nb = 0
2422 tagp(1:nspmd)=0
2423 DO j = addcsrect(n), addcsrect(n+1)-1
2424 k = csrect(j)
2425 p = intercep(1,ni)%P(k)
2426 IF(p /= proc.AND.tagp(p)==0) THEN
2427 nbddnor = nbddnor + 1
2428 fr_nor(lshift+nbddnor) = tag_ms(i)
2429 proc_rem25(nbddnor) = p
2430 tagp(p)=1
2431 ENDIF
2432 lcsrect_l = lcsrect_l + 1
2433 procnor(lcsrect_l)=p
2434 nb = nb +1
2435 ENDDO
2436 addcsrect_l(nl+1)=addcsrect_l(nl)+nb
2437 nl = nl + 1
2438 ENDDO
2439C
2440 DO i = 1, nbddnor
2441 itri25(1,i) = proc_rem25(i)
2442 itri25(2,i) = fr_nor(lshift+i)
2443 itri25(3,i) = 0 ! unused
2444 index25(i) = i
2445 ENDDO
2446 CALL my_orders(0,work,itri25,index25,nbddnor,3)
2447 DO i = 1, nbddnor
2448 proc_rem25(i)= itri25(1,index25(i))
2449 fr_nor(lshift+i) = tag_sm(itri25(2,index25(i)))
2450 ENDDO
2451C
2452 DO p = 1, nspmd
2453 isom(p) = 0
2454 ENDDO
2455 DO i = 1, nbddnor
2456 p = proc_rem25(i)
2457 isom(p) = isom(p) + 1
2458 ENDDO
2459 iad_frnor(ni25,1) = lshift + 1
2460 DO p = 1, nspmd
2461 iad_frnor(ni25,p+1) = iad_frnor(ni25,p) + isom(p)
2462 ENDDO
2463
2464 DEALLOCATE(tag_sm,tag_ms)
2465
2466 ishift=ishift+nadmsr
2467 lshift=lshift+nbddnor
2468 END DO
2469 ELSE
2470 addcsrect_l(1:numnor_l+1)=0
2471 END IF ! NINTER25/=0
2472C
2473C Frontiers vs edges
2474 IF(ninter25/=0)THEN
2475
2476 ni25=0
2477 lshift=0
2478
2479 DO ni=1,ninter
2480 nty=ipari(7,ni)
2481 IF(nty/=25) cycle
2482
2483 nbddedg = 0
2484
2485 ni25=ni25+1
2486 nrtm =ipari(4,ni)
2487 ALLOCATE(tag_sm(nrtm),tag_ms(nrtm))
2488 tag_sm(1:nrtm)=0
2489
2490 nrtm_l=0
2491 DO k=1,nrtm
2492 IF(intercep(1,ni)%P(k)==proc)THEN
2493 nrtm_l=nrtm_l+1
2494 tag_sm(k)=nrtm_l
2495 ENDIF
2496 ENDDO
2497
2498 DO i = 1, nrtm
2499 k = tag_sm(i)
2500 IF(k/=0)THEN
2501 tag_ms(k)=i
2502 END IF
2503 END DO
2504
2505 DO i = 1, nrtm_l
2506 n = tag_ms(i)
2507 DO j = 1,4
2508 k = intbuf_tab(ni)%MVOISIN(4*(n-1)+j)
2509 IF(k/=0)THEN
2510 p = intercep(1,ni)%P(k)
2511 IF(p /= proc) THEN
2512 nbddedg = nbddedg + 1
2513 fr_sav(1,nbddedg) = i ! tri par no global croissant
2514 fr_sav(2,nbddedg) = j
2515 proc_rem25(nbddedg) = p
2516 ! Tri des aretes frontieres vs S1, S2 <=> ordre unique
2517 itri25_normal(1,nbddedg) = p
2518 n1=intbuf_tab(ni)%ADMSR(4*(n-1)+j)
2519 n2=intbuf_tab(ni)%ADMSR(4*(n-1)+mod(j,4)+1)
2520C there seems to be a bug in ADMSR. N1 and N2 may not be symmetric here
2521C in case of T shape. This causes a wrong behaviour in SPMD
2522C (send and reception buffers are not symmetric)
2523C A workaround is to add the sorting keys on the
2524C id of the two segments.
2525 itri25_normal(2,nbddedg) = min(k,n)
2526 itri25_normal(3,nbddedg) = max(k,n)
2527 itri25_normal(4,nbddedg) = min(n1,n2)
2528 itri25_normal(5,nbddedg) = max(n1,n2)
2529 ENDIF
2530 END IF
2531 ENDDO
2532 ENDDO
2533C
2534 DO i = 1, nbddedg
2535 index25(i) = i
2536 ENDDO
2537 CALL my_orders(0,work,itri25_normal,index25,nbddedg,5)
2538 DO i = 1, nbddedg
2539 proc_rem25(i) = itri25_normal(1,index25(i))
2540 fr_edg(1,lshift+i) = fr_sav(1,index25(i))
2541 fr_edg(2,lshift+i) = fr_sav(2,index25(i))
2542 ENDDO
2543C
2544 DO p = 1, nspmd
2545 isom(p) = 0
2546 ENDDO
2547 DO i = 1, nbddedg
2548 p = proc_rem25(i)
2549 isom(p) = isom(p) + 1
2550 ENDDO
2551 iad_fredg(ni25,1) = lshift + 1
2552 DO p = 1, nspmd
2553 iad_fredg(ni25,p+1) = iad_fredg(ni25,p) + isom(p)
2554 ENDDO
2555
2556 DEALLOCATE(tag_sm,tag_ms)
2557
2558 lshift=lshift+nbddedg
2559 END DO
2560
2561 END IF ! NINTER25/=0
2562C
2563C-------------------------
2564C
2565C Ecriture frontiere
2566C
2567 CALL write_i_c(dd_mv,nvolu*(nspmd+2))
2568 len_ia = len_ia + nvolu*(nspmd+2)
2569 CALL write_i_c(iad_elem,2*(nspmd+1))
2570 len_ia = len_ia + 2*(nspmd+1)
2571 CALL write_i_c(iad_rby,nspmd+1)
2572 len_ia = len_ia + nspmd+1
2573 CALL write_i_c(iad_rby2,4*(nspmd+1))
2574 len_ia = len_ia + 4*(nspmd+1)
2575 CALL write_i_c(iad_i2m,nspmd+1)
2576 len_ia = len_ia + nspmd+1
2577 CALL write_i_c(iad_cj,(nspmd+1)*njoint)
2578 len_ia = len_ia + nspmd+1
2579 CALL write_i_c(iad_rbm,nspmd+1)
2580 len_ia = len_ia + nspmd+1
2581 CALL write_i_c(iad_rbm2,4*(nspmd+1))
2582 len_ia = len_ia + 4*(nspmd+1)
2583C
2584 CALL write_i_c(iad_rbe2,nspmd+1)
2585 len_ia = len_ia + nspmd+1
2586 CALL write_i_c(iad_rbe3m,nspmd+1)
2587 len_ia = len_ia + nspmd+1
2588 CALL write_i_c(iad_sec,4*(nspmd+1))
2589 len_ia = len_ia + 4*(nspmd+1)
2590 CALL write_i_c(iad_cut,isecut*isp0*nsect*(nspmd+2))
2591 len_ia = len_ia + isecut*isp0*nsect*(nspmd+2)
2592C
2593 CALL write_i_c(iad_rbym,nspmd+1)
2594 len_ia = len_ia + nspmd+1
2595 CALL write_i_c(iad_rbym2,4*(nspmd+1))
2596 len_ia = len_ia + 4*(nspmd+1)
2597c
2598 CALL write_i_c(dd_elem,nbddacc+nbddkin)
2599 len_ia = len_ia + nbddacc+nbddkin
2600 CALL write_i_c(dd_rby,nbddnrb)
2601 len_ia = len_ia + nbddnrb
2602 CALL write_i_c(dd_wall,nrwall*(nspmd+2))
2603 len_ia = len_ia + nrwall*(nspmd+2)
2604 CALL write_i_c(dd_rby2,3*nrbykin)
2605 len_ia = len_ia + 3*nrbykin
2606 CALL write_i_c(dd_i2m,nbddi2m)
2607 len_ia = len_ia + nbddi2m
2608 CALL write_i_c(dd_ll,nlink*(nspmd+2))
2609 len_ia = len_ia + nlink*(nspmd+2)
2610 CALL write_i_c(dd_cj,nbddncj)
2611 len_ia = len_ia + nbddncj
2612 CALL write_i_c(dd_rbm,nbddnrbm)
2613 len_ia = len_ia + nbddnrbm
2614 CALL write_i_c(dd_rbm2,3*nibvel)
2615 len_ia = len_ia + 3*nibvel
2616C
2617 CALL write_i_c(dd_rbe2,nbddrbe2)
2618 len_ia = len_ia + nbddrbe2
2619 CALL write_i_c(dd_rbe3m,nbddrbe3m)
2620 len_ia = len_ia + nbddrbe3m
2621 CALL write_i_c(dp_rbe3m,nbddrbe3m)
2622 len_ia = len_ia + nbddrbe3m
2623 CALL write_i_c(dd_sec,(nspmd+1)*nsect)
2624 len_ia = len_ia + (nspmd+1)*nsect
2625 CALL write_i_c(dd_cut,nnodt_l)
2626 len_ia = len_ia + nnodt_l
2627 CALL write_i_c(rg_cut,nnodl_l)
2628 len_ia = len_ia + nnodl_l
2629 CALL write_i_c(dd_mad,5*(nspmd+1))
2630 len_ia = len_ia + 5*(nspmd+1)
2631 CALL write_i_c(dd_i18,(nspmd+2)*nbi18_l)
2632 len_ia = len_ia + (nspmd+2)*nbi18_l
2633 CALL write_i_c(dd_r2r,(nspmd+1)*nl_ddr2r)
2634 len_ia = len_ia + (nspmd+1)*nl_ddr2r
2635 IF(sdd_r2r_elem > 0) THEN
2636 CALL write_i_c(dd_r2r_elem,sdd_r2r_elem)
2637 len_ia = len_ia + sdd_r2r_elem
2638 ENDIF
2639C
2640 CALL write_i_c(dd_rbym,nbddnrbym)
2641 len_ia = len_ia + nbddnrbym
2642 CALL write_i_c(dd_rbym2,3*nrbym)
2643 len_ia = len_ia + 3*nrbym
2644C
2645 CALL write_i_c(addcsrect_l,numnor_l+1)
2646 len_ia = len_ia + numnor_l+1
2647 CALL write_i_c(fr_nor,nbddnort)
2648 len_ia = len_ia + nbddnort
2649 CALL write_i_c(iad_frnor,(nspmd+1)*ninter25)
2650 len_ia = len_ia + (nspmd+1)*ninter25
2651 if(lcsrect_l /= nbccnor) print *,'internal error'
2652 CALL write_i_c(procnor,lcsrect_l)
2653 len_ia = len_ia + lcsrect_l
2654 CALL write_i_c(fr_edg,2*nbddedgt)
2655 len_ia = len_ia + 2*nbddedgt
2656 CALL write_i_c(iad_fredg,(nspmd+1)*ninter25)
2657 len_ia = len_ia + (nspmd+1)*ninter25
2658C
2659 IF(numskw>0)THEN
2660 CALL write_i_c(iskwp,numskw+1)
2661 CALL write_i_c(nskwp,nspmd)
2662 CALL write_i_c(iskwp_l,nskwp(proc))
2663 len_ia = len_ia + nspmd + numskw+1 + nskwp(proc)
2664 END IF
2665 IF(nsensor>0)THEN
2666 CALL write_i_c(isensp,2*nsensor)
2667 CALL write_i_c(nsensp,nspmd)
2668 len_ia = len_ia + 2*nsensor + nspmd
2669 END IF
2670 IF(naccelm>0)THEN
2671 CALL write_i_c(iaccp,naccelm)
2672 CALL write_i_c(naccp,nspmd)
2673 len_ia = len_ia +naccelm +nspmd
2674 END IF
2675 IF(nbgauge>0)THEN
2676 CALL write_i_c(igaup,nbgauge)
2677 CALL write_i_c(ngaup,nspmd)
2678 len_ia = len_ia +nbgauge +nspmd
2679 END IF
2680C
2681 CALL write_i_c(dd_lagf,3*(nspmd+1))
2682 len_ia = len_ia + 3*(nspmd+1)
2683 CALL write_i_c(newfront,ninter)
2684 len_ia = len_ia + ninter
2685C
2686C Ecriture frontiere ALE/CFD
2687C
2688 IF(iale+ieuler+itherm+ialelag/=0)THEN
2689 CALL write_i_c(nbrcvois,nspmd+1)
2690 len_ia = len_ia + nspmd+1
2691 CALL write_i_c(lnrcvois,nrcvvois)
2692 len_ia = len_ia + nrcvvois
2693 CALL write_i_c(nbsdvois,nspmd+1)
2694 len_ia = len_ia + nspmd+1
2695 CALL write_i_c(lnsdvois,nsndvois)
2696 len_ia = len_ia + nsndvois
2697 CALL write_i_c(nercvois,nspmd+1)
2698 len_ia = len_ia + nspmd+1
2699 CALL write_i_c(lercvois,nervois)
2700 len_ia = len_ia + nervois
2701 CALL write_i_c(nesdvois,nspmd+1)
2702 len_ia = len_ia + nspmd+1
2703 CALL write_i_c(lesdvois,nesvois)
2704 len_ia = len_ia + nesvois
2705 IF(segindx>0) THEN
2706 CALL write_i_c(npsegcom,nspmd+1)
2707 len_ia = len_ia + nspmd+1
2708 CALL write_i_c(lsegcom,nsegfl_l)
2709 len_ia = len_ia + nsegfl_l
2710 END IF
2711 IF(numpor>0)THEN
2712 CALL write_i_c(nporgeo,numgeo)
2713 len_ia = len_ia + numgeo
2714 CALL write_i_c(lnodpor,numpor_l)
2715 len_ia = len_ia + numpor_l
2716 END IF
2717 END IF
2718C
2719 CALL write_i_c(llagf,nlagf_l)
2720 len_ia = len_ia + nlagf_l
2721C
2722 IF ((nsubdom>0).AND.(iddom==0)) THEN
2723 DEALLOCATE(dd_r2r_elem)
2724 ENDIF
2725C
2726 IF(icrack3d > 0)THEN
2727 CALL write_i_c(iad_edge,nspmd+1)
2728 len_ia = len_ia + nspmd+1
2729 CALL write_i_c(fr_edge,nb_fredge)
2730 len_ia = len_ia + nb_fredge
2731 CALL write_i_c(fr_nbedge,nspmd+1)
2732 len_ia = len_ia + nspmd+1
2733 IF(ALLOCATED(fr_edge))DEALLOCATE(fr_edge)
2734 ENDIF
2735C
2736 CALL write_i_c(iad_cndm,nspmd+1)
2737 len_ia = len_ia + nspmd+1
2738 CALL write_i_c(dd_cndm,nbddcndm) ! ISKY
2739 len_ia = len_ia + nbddcndm
2740C
2741 DEALLOCATE( acckin )!(NBDDACC+NBDDKIN)
2742 DEALLOCATE( addcsrect_l )!(NUMNOR_L+1)
2743 DEALLOCATE( cpulocaler )!(nervois)
2744 DEALLOCATE( cpulocales )!(NESVOIS)
2745 DEALLOCATE( cpulocalf )!(NSEGFL_L)
2746 DEALLOCATE( cpulocalr )!(NRCVVOIS)
2747 DEALLOCATE( cpulocals )!(NSNDVOIS)
2748 DEALLOCATE( dd_cj )!(NBDDNCJ)
2749 DEALLOCATE( dd_cndm )!(NBDDCNDM)
2750 DEALLOCATE( dd_cut )!(NNODT_L)
2751 DEALLOCATE( dd_elem )!(NBDDACC+NBDDKIN)
2752 DEALLOCATE( dd_i2m )!(NBDDI2M)
2753 DEALLOCATE( dd_p )!(NSPMD)
2754 DEALLOCATE( dd_rbe2 )!(NBDDRBE2)
2755 DEALLOCATE( dd_rbe3m )!(NBDDRBE3M)
2756 DEALLOCATE( dd_rbm )!(NBDDNRBM)
2757 DEALLOCATE( dd_rby )!(NBDDNRB)
2758 DEALLOCATE( dd_rbym )!(NBDDNRBYM)
2759 DEALLOCATE( dp_rbe3m )!(NBDDRBE3M)
2760 DEALLOCATE( d_rby )!(NSPMD+1)
2761 DEALLOCATE( fr_nor )!(NBDDNORT)
2762 DEALLOCATE( iad_cndm )!(NSPMD+1)
2763 DEALLOCATE( iad_i2m )!(NSPMD+1)
2764 DEALLOCATE( iad_rbe2 )!(NSPMD+1)
2765 DEALLOCATE( iad_rbe3 )!(NSPMD+1)
2766 DEALLOCATE( iad_rbe3m )!(NSPMD+1)
2767 DEALLOCATE( iad_rbm )!(NSPMD+1)
2768 DEALLOCATE( iad_rby )!(NSPMD+1)
2769 DEALLOCATE( iad_rbym )!(NSPMD+1)
2770 DEALLOCATE( index )!(2*(NBDDACC+NBDDKIN))
2771 DEALLOCATE( index2 )!(2*(NBDDNRB))
2772 DEALLOCATE( index3 )!(2*NBDDNCJ)
2773 DEALLOCATE( index4 )!(2*NBCFD)
2774 DEALLOCATE( index5 )!(2*(NBDDNRBYM))
2775 DEALLOCATE( isom )!(NSPMD)
2776 DEALLOCATE( isom_r2r_r )!(NSPMD)
2777 DEALLOCATE( isom_r2r_s )!(NSPMD)
2778 DEALLOCATE( lercvois )!(NERVOIS)
2779 DEALLOCATE( lesdvois )!(NESVOIS)
2780 DEALLOCATE( llagf )!(NLAGF_L)
2781 DEALLOCATE( lnodpor )!(NUMPOR_L)
2782 DEALLOCATE( lnrcvois )!(NRCVVOIS)
2783 DEALLOCATE( lnsdvois )!(NSNDVOIS)
2784 DEALLOCATE( lsegcom )!(nsegfl_l)
2785 DEALLOCATE( nbrcvois )!(NSPMD+1)
2786 DEALLOCATE( nbsdvois )!(NSPMD+1)
2787 DEALLOCATE( nercvois )!(NSPMD+1)
2788 DEALLOCATE( nesdvois )!(NSPMD+1)
2789 DEALLOCATE( nporgeo )!(NUMGEO)
2790 DEALLOCATE( npsegcom )!(NSPMD+1)
2791 DEALLOCATE( procnor )!(ADDCSRECT(NUMNOR+1))
2792 DEALLOCATE( proc_rem )!(NBDDACC+NBDDKIN)
2793 DEALLOCATE( proc_rem1 )!(NBDDNRBYM)
2794 DEALLOCATE( rg_cut )!(NNODL_L)
2795 DEALLOCATE( secvu )!(NSPMD)
2796 DEALLOCATE( work )!(70000)
2797 DEALLOCATE( dd_i18 )!(NSPMD+2,NBI18_L)
2798 DEALLOCATE( dd_ll )!(NSPMD+2,NLINK)
2799 DEALLOCATE( dd_mad )!(5,NSPMD+1)
2800 DEALLOCATE( dd_mv )!(NSPMD+2,NVOLU)
2801 DEALLOCATE( dd_r2r )!(nspmd+1,nl_ddr2r)
2802 DEALLOCATE( dd_sec )!(NSPMD+1,NSECT)
2803 DEALLOCATE( dd_wall )!(NSPMD+2,NRWALL)
2804 DEALLOCATE( fr_edg )!(2,NBDDEDGT)
2805 DEALLOCATE( fr_sav )!(2,NBDDEDG_MAX)
2806 DEALLOCATE( iad_cj )!(NSPMD+1,NJOINT)
2807 DEALLOCATE( iad_cut )!(NSPMD+2,NSECT*ISECUT*ISP0)
2808 DEALLOCATE( iad_elem )!(2,NSPMD+1)
2809 DEALLOCATE( iad_fredg )!(NINTER25,NSPMD+1)
2810 DEALLOCATE( iad_frnor )!(NINTER25,NSPMD+1)
2811 DEALLOCATE( iad_rbm2 )!(4,NSPMD+1)
2812 DEALLOCATE( iad_rby2 )!(4,NSPMD+1)
2813 DEALLOCATE( iad_rbym2 )!(4,NSPMD+1)
2814 DEALLOCATE( iad_sec )!(4,NSPMD+1)
2815 DEALLOCATE( index25 )!(2*MAX(NBDDNOR_MAXNBDDEDG_MAX))
2816 DEALLOCATE( itri )!(3,NBDDACC+NBDDKIN)
2817 DEALLOCATE( itri2 )!(2,NBDDNRB)
2818 DEALLOCATE( itri25 )!(3,MAX(NBDDNOR_MAX,NBDDEDG_MAX))
2819 DEALLOCATE( itri25_normal )!(5,MAX(NBDDNOR_MAX,NBDDEDG_MAX))
2820 DEALLOCATE( itri3 )!(2,NBDDNCJ)
2821 DEALLOCATE( itri4 )!(2,NBCFD)
2822 DEALLOCATE( itri5 )!(2,NBDDNRBYM)
2823 DEALLOCATE( proc_rem25 )!(MAX(NBDDNOR_MAXNBDDEDG_MAX))
2824
2825C
2826! -----------------------------------
2827! deallocate 1d arrays
2828 DEALLOCATE( weight,tage )
2829 DEALLOCATE( newfront,tag )
2830 DEALLOCATE( tager,tages )
2831! deallocate 2d arrays
2832 DEALLOCATE( tage_l,tag_l )
2833! -----------------------------------
2834 RETURN
2835 END
my_real
#define my_real
Definition cppsort.cpp:32
plist_ifront
subroutine plist_ifront(tab, n, cpt)
Definition ddtools.F:153
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
front_mod
Definition front_mod.F:84
front_mod::flagkin
integer, dimension(:), allocatable flagkin
Definition front_mod.F:105
front_mod::ifront
type(my_front) ifront
Definition front_mod.F:93
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::fvspmd
type(fvbag_spmd), dimension(:), allocatable fvspmd
Definition fvbag_mod.F:129
groupdef_mod
Definition groupdef_mod.F:662
nlocal_reg_mod
Definition nlocal_reg_mod.F:117
split_cfd_mod
Definition split_cfd_mod.F:33
user_windows_mod
Definition user_windows_mod.F:48
pornod
subroutine pornod(geo, ixs, ixq, nodpor, icode, itab, npby, lpby, igeo)
Definition pornod.F:35
arret
subroutine arret(nn)
Definition arret.F:87
w_front
subroutine w_front(proc, nbddacc, nbddkin, nodlocal, nbddproc, nbddboun, nodglob, numnod_l, nbddnrb, npby, lpby, nprw, lprw, len_ia, dd_rby2, itabi2m, nbddi2m, cep, monvol, nnlink, lllink, ljoint, nbddncj, ibvel, lbvel, nbddnrbm, dd_rbm2, nstrf, nnodt_l, nnodl_l, iexmad, isp0, nrcvvois, nsndvois, nervois, nesvois, nsegfl_l, iparg, numel, ale_connectivity, nbcfd, ixs, ixq, ixtg, numels_l, numelq_l, numeltg_l, cel, geo, pornod, numpor_l, numel_l, ipari, intbuf_tab, nbi18_l, iexlnk, igrnod, dd_lagf, nlagf_l, iadll, lll, iskwp, nskwp, isensp, nsensp, iaccp, naccp, irbe3, lrbe3, itabrbe3m, nbddrbe3m, irbym, lcrbym, front_rm, dd_rbym2, nbddnrbym, irbe2, lrbe2, nbddrbe2, itabrbe2m, iedge_tmp, nodedge, edgelocal, nbddedge_l, igaup, ngaup, frontb_r2r, sdd_r2r_elem, addcsrect, csrect, nbddnort, nbddnor_max, nbccfr25, nbccnor, numnor_l, nbddedgt, nbddedg_max, intercep, nbddcndm, itabcndm, multi_fvm, igrsurf, iskwp_l, ale_elm, size_ale_elm, nsensor, nloc_dmg, constraint_struct, itherm)
Definition w_front.F:61
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645