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