OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inter_tools.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_intbuf_size ../starter/source/restart/ddsplit/inter_tools.F
25!||--- called by ------------------------------------------------------
26!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
27!||--- calls -----------------------------------------------------
28!|| arret ../starter/source/system/arret.f
29!||--- uses -----------------------------------------------------
30!||====================================================================
31 SUBROUTINE w_intbuf_size(INTBUF_TAB_L)
32c
33c write on disk all sizes of INTBUF_TAB arrays (INTEGERs then REALs)
34c
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE intbufdef_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "units_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 TYPE(intbuf_struct_) INTBUF_TAB_L
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 INTEGER, DIMENSION(:),ALLOCATABLE :: INTBUF_SIZE
55 INTEGER N,L_INTBUF_SIZE
56C ----------------------------------------
57 ALLOCATE(intbuf_size(l_intbuf_size_max))
58 intbuf_size(1:l_intbuf_size_max) = 0
59
60 n = 1
61C=======================================================================
62C integer arrays sizes
63C=======================================================================
64 intbuf_size(n) = intbuf_tab_l%S_IRECTS
65 n = n+1
66 intbuf_size(n) = intbuf_tab_l%S_IRECTM
67 n = n+1
68 intbuf_size(n) = intbuf_tab_l%S_NSV
69 n = n+1
70 intbuf_size(n) = intbuf_tab_l%S_MSR
71 n = n+1
72 intbuf_size(n) = intbuf_tab_l%S_IRTLM
73 n = n+1
74 intbuf_size(n) = intbuf_tab_l%S_IRUPT
75 n = n+1
76 intbuf_size(n) = intbuf_tab_l%S_INORM
77 n = n+1
78 intbuf_size(n) = intbuf_tab_l%S_IELEC
79 n = n+1
80 intbuf_size(n) = intbuf_tab_l%S_IELES
81 n = n+1
82 intbuf_size(n) = intbuf_tab_l%S_LISUB
83 n = n+1
84 intbuf_size(n) = intbuf_tab_l%S_TYPSUB
85 n = n+1
86 intbuf_size(n) = intbuf_tab_l%S_ADDSUBS
87 n = n+1
88 intbuf_size(n) = intbuf_tab_l%S_ADDSUBM
89 n = n+1
90 intbuf_size(n) = intbuf_tab_l%S_LISUBS
91 n = n+1
92 intbuf_size(n) = intbuf_tab_l%S_LISUBM
93 n = n+1
94 intbuf_size(n) = intbuf_tab_l%S_INFLG_SUBS
95 n = n+1
96 intbuf_size(n) = intbuf_tab_l%S_INFLG_SUBM
97 n = n+1
98 intbuf_size(n) = intbuf_tab_l%S_ADDSUBE
99 n = n+1
100 intbuf_size(n) = intbuf_tab_l%S_LISUBE
101 n = n+1
102 intbuf_size(n) = intbuf_tab_l%S_INFLG_SUBE
103 n = n+1
104 intbuf_size(n) = intbuf_tab_l%S_MSEGTYP
105 n = n+1
106 intbuf_size(n) = intbuf_tab_l%S_CAND_E
107 n = n+1
108 intbuf_size(n) = intbuf_tab_l%S_CAND_N
109 n = n+1
110 intbuf_size(n) = intbuf_tab_l%S_I_STOK
111 n = n+1
112 intbuf_size(n) = intbuf_tab_l%S_I_STOK_E
113 n = n+1
114 intbuf_size(n) = intbuf_tab_l%S_IFPEN
115 n = n+1
116 intbuf_size(n) = intbuf_tab_l%S_KREMNODE
117 n = n+1
118 intbuf_size(n) = intbuf_tab_l%S_REMNODE
119 n = n+1
120 intbuf_size(n) = intbuf_tab_l%S_KREMNOR
121 n = n+1
122 intbuf_size(n) = intbuf_tab_l%S_REMNOR
123 n = n+1
124 intbuf_size(n) = intbuf_tab_l%S_ADCCM
125 n = n+1
126 intbuf_size(n) = intbuf_tab_l%S_CHAIN
127 n = n+1
128 intbuf_size(n) = intbuf_tab_l%S_NIGE
129!type20
130 n = n+1
131 intbuf_size(n) = intbuf_tab_l%S_DAANC6
132 n = n+1
133 intbuf_size(n) = intbuf_tab_l%S_NBINFLG
134 n = n+1
135 intbuf_size(n) = intbuf_tab_l%S_MBINFLG
136 n = n+1
137 intbuf_size(n) = intbuf_tab_l%S_EBINFLG
138 n = n+1
139 intbuf_size(n) = intbuf_tab_l%S_NLG
140 n = n+1
141 intbuf_size(n) = intbuf_tab_l%S_ISLINS
142 n = n+1
143 intbuf_size(n) = intbuf_tab_l%S_ISLINM
144 n = n+1
145 intbuf_size(n) = intbuf_tab_l%S_IXLINS
146 n = n+1
147 intbuf_size(n) = intbuf_tab_l%S_IXLINM
148 n = n+1
149 intbuf_size(n) = intbuf_tab_l%S_NSVL
150 n = n+1
151 intbuf_size(n) = intbuf_tab_l%S_MSRL
152 n = n+1
153 intbuf_size(n) = intbuf_tab_l%S_LCAND_N
154 n = n+1
155 intbuf_size(n) = intbuf_tab_l%S_LCAND_S
156 n = n+1
157 intbuf_size(n) = intbuf_tab_l%S_ADCCM20
158 n = n+1
159 intbuf_size(n) = intbuf_tab_l%S_CHAIN20
160!type1
161 n = n+1
162 intbuf_size(n) = intbuf_tab_l%S_ILOCS
163 n = n+1
164 intbuf_size(n) = intbuf_tab_l%S_NSEGM
165 n = n+1
166 intbuf_size(n) = intbuf_tab_l%S_NRT
167!type2
168 n = n+1
169 intbuf_size(n) = intbuf_tab_l%S_MSEGTYP2
170!type3
171 n = n+1
172 intbuf_size(n) = intbuf_tab_l%S_IRTLS
173 n = n+1
174 intbuf_size(n) = intbuf_tab_l%S_ILOCM
175 n = n+1
176 intbuf_size(n) = intbuf_tab_l%S_IRTLOM
177 n = n+1
178 intbuf_size(n) = intbuf_tab_l%S_IRTLOS
179 n = n+1
180 intbuf_size(n) = intbuf_tab_l%S_NSEGS
181 n = n+1
182 intbuf_size(n) = intbuf_tab_l%S_LNSV
183 n = n+1
184 intbuf_size(n) = intbuf_tab_l%S_LMSR
185!type4
186 n = n+1
187 intbuf_size(n) = intbuf_tab_l%S_IELEM
188!type12
189 n = n+1
190 intbuf_size(n) = intbuf_tab_l%S_FCOUNT
191!type14
192 n = n+1
193 intbuf_size(n) = intbuf_tab_l%S_KSURF
194 n = n+1
195 intbuf_size(n) = intbuf_tab_l%S_IMPACT
196!type21
197 n = n+1
198 intbuf_size(n) = intbuf_tab_l%S_MSR21
199 n = n+1
200 intbuf_size(n) = intbuf_tab_l%S_MNDD
201 n = n+1
202 intbuf_size(n) = intbuf_tab_l%S_MSR_L
203!type24 & 25
204 n = n+1
205 intbuf_size(n) = intbuf_tab_l%S_MVOISIN
206 n = n+1
207 intbuf_size(n) = intbuf_tab_l%S_NVOISIN
208 n = n+1
209 intbuf_size(n) = intbuf_tab_l%S_MSEGLO
210 n = n+1
211 intbuf_size(n) = intbuf_tab_l%S_MSEGTYP24
212 n = n+1
213 intbuf_size(n) = intbuf_tab_l%S_ISEADD
214 n = n+1
215 intbuf_size(n) = intbuf_tab_l%S_ISEDGE
216 n = n+1
217 intbuf_size(n) = intbuf_tab_l%S_CAND_T
218 n = n+1
219 intbuf_size(n) = intbuf_tab_l%S_ISEG_PXFEM
220 n = n+1
221 intbuf_size(n) = intbuf_tab_l%S_ISEG_PLY
222 n = n+1
223 intbuf_size(n) = intbuf_tab_l%S_ICONT_I
224 n = n+1
225 intbuf_size(n) = intbuf_tab_l%S_IRTSE
226 n = n+1
227 intbuf_size(n) = intbuf_tab_l%S_IS2SE
228 n = n+1
229 intbuf_size(n) = intbuf_tab_l%S_IS2PT
230 n = n+1
231 intbuf_size(n) = intbuf_tab_l%S_ISPT2
232 n = n+1
233 intbuf_size(n) = intbuf_tab_l%S_ISEGPT
234 n = n+1
235 intbuf_size(n) = intbuf_tab_l%S_IS2ID
236!type25
237 n = n+1
238 intbuf_size(n) = intbuf_tab_l%S_EVOISIN
239 n = n+1
240 intbuf_size(n) = intbuf_tab_l%S_ADMSR
241 n = n+1
242 intbuf_size(n) = intbuf_tab_l%S_LEDGE
243 n = n+1
244 intbuf_size(n) = intbuf_tab_l%S_LBOUND
245 n = n+1
246 intbuf_size(n) = intbuf_tab_l%S_ACTNOR
247 n = n+1
248 intbuf_size(n) = intbuf_tab_l%S_FARM
249 n = n+1
250 intbuf_size(n) = intbuf_tab_l%S_ADSKYN
251 n = n+1
252 intbuf_size(n) = intbuf_tab_l%S_IADNOR
253 n = n+1
254 intbuf_size(n) = intbuf_tab_l%S_ISLIDE
255 n = n+1
256 intbuf_size(n) = intbuf_tab_l%S_KNOR2MSR
257 n = n+1
258 intbuf_size(n) = intbuf_tab_l%S_NOR2MSR
259 n = n+1
260 intbuf_size(n) = intbuf_tab_l%S_CAND_OPT_N
261 n = n+1
262 intbuf_size(n) = intbuf_tab_l%S_CAND_OPT_E
263 n = n+1
264 intbuf_size(n) = intbuf_tab_l%S_IF_ADH
265 n = n+1
266 intbuf_size(n) = intbuf_tab_l%S_CANDM_E2E
267 n = n+1
268 intbuf_size(n) = intbuf_tab_l%S_CANDS_E2E
269 n = n+1
270 intbuf_size(n) = intbuf_tab_l%S_CANDM_E2S
271 n = n+1
272 intbuf_size(n) = intbuf_tab_l%S_CANDS_E2S
273 n = n+1
274 intbuf_size(n) = intbuf_tab_l%S_IFPEN_E
275 n = n+1
276 intbuf_size(n) = intbuf_tab_l%S_IFPEN_E2S
277!Friction
278 n = n+1
279 intbuf_size(n) = intbuf_tab_l%S_IPARTFRICS
280 n = n+1
281 intbuf_size(n) = intbuf_tab_l%S_IPARTFRICM
282 n = n+1
283 intbuf_size(n) = intbuf_tab_l%S_IPARTFRIC_E
284 n = n+1
285 intbuf_size(n) = intbuf_tab_l%S_IELNRTS
286 n = n+1
287 intbuf_size(n) = intbuf_tab_l%S_ADRECTS
288 n = n+1
289 intbuf_size(n) = intbuf_tab_l%S_FACNRTS
290 n = n+1
291 intbuf_size(n) = intbuf_tab_l%S_IREP_FRICM
292 n = n+1
293 intbuf_size(n) = intbuf_tab_l%S_E2S_ACTNOR
294 n = n+1
295 intbuf_size(n) = intbuf_tab_l%S_KREMNODE_EDG
296 n = n+1
297 intbuf_size(n) = intbuf_tab_l%S_REMNODE_EDG
298 n = n+1
299 intbuf_size(n) = intbuf_tab_l%S_KREMNODE_E2S
300 n = n+1
301 intbuf_size(n) = intbuf_tab_l%S_REMNODE_E2S
302 n = n+1
303 intbuf_size(n) = intbuf_tab_l%S_IELEM_M
304 n = n+1
305 intbuf_size(n) = intbuf_tab_l%S_PROC_MVOISIN
306
307C=======================================================================
308C real arrays sizes
309C=======================================================================
310 n = n+1
311 intbuf_size(n) = intbuf_tab_l%S_STFAC
312 n = n+1
313 intbuf_size(n) = intbuf_tab_l%S_VARIABLES
314 n = n+1
315 intbuf_size(n) = intbuf_tab_l%S_CSTS
316 n = n+1
317 intbuf_size(n) = intbuf_tab_l%S_DPARA
318 n = n+1
319 intbuf_size(n) = intbuf_tab_l%S_NMAS
320 n = n+1
321 intbuf_size(n) = intbuf_tab_l%S_AREAS2
322 n = n+1
323 intbuf_size(n) = intbuf_tab_l%S_SMAS
324 n = n+1
325 intbuf_size(n) = intbuf_tab_l%S_SINER
326 n = n+1
327 intbuf_size(n) = intbuf_tab_l%S_UVAR
328 n = n+1
329 intbuf_size(n) = intbuf_tab_l%S_XM0
330 n = n+1
331 intbuf_size(n) = intbuf_tab_l%S_SPENALTY
332 n = n+1
333 intbuf_size(n) = intbuf_tab_l%S_STFR_PENALTY
334 n = n+1
335 intbuf_size(n) = intbuf_tab_l%S_SKEW
336 n = n+1
337 intbuf_size(n) = intbuf_tab_l%S_DSM
338 n = n+1
339 intbuf_size(n) = intbuf_tab_l%S_FSM
340 n = n+1
341 intbuf_size(n) = intbuf_tab_l%S_RUPT
342 n = n+1
343 intbuf_size(n) = intbuf_tab_l%S_FINI
344 n = n+1
345 intbuf_size(n) = intbuf_tab_l%S_STFNS
346 n = n+1
347 intbuf_size(n) = intbuf_tab_l%S_STFM
348 n = n+1
349 intbuf_size(n) = intbuf_tab_l%S_STFS
350 n = n+1
351 intbuf_size(n) = intbuf_tab_l%S_PENIM
352 n = n+1
353 intbuf_size(n) = intbuf_tab_l%S_PENIS
354 n = n+1
355 intbuf_size(n) = intbuf_tab_l%S_STIFMSDT_S
356 n = n+1
357 intbuf_size(n) = intbuf_tab_l%S_STIFMSDT_M
358 n = n+1
359 intbuf_size(n) = intbuf_tab_l%S_GAP_M
360 n = n+1
361 intbuf_size(n) = intbuf_tab_l%S_GAP_S
362 n = n+1
363 intbuf_size(n) = intbuf_tab_l%S_XSAV
364 n = n+1
365 intbuf_size(n) = intbuf_tab_l%S_CRIT
366 n = n+1
367 intbuf_size(n) = intbuf_tab_l%S_FRIC_P
368 n = n+1
369 intbuf_size(n) = intbuf_tab_l%S_XFILTR
370 n = n+1
371 intbuf_size(n) = intbuf_tab_l%S_AREAS
372 n = n+1
373 intbuf_size(n) = intbuf_tab_l%S_AREAM
374 n = n+1
375 intbuf_size(n) = intbuf_tab_l%S_GAP_ML
376 n = n+1
377 intbuf_size(n) = intbuf_tab_l%S_GAP_SL
378 n = n+1
379 intbuf_size(n) = intbuf_tab_l%S_CAND_P
380 n = n+1
381 intbuf_size(n) = intbuf_tab_l%S_CAND_PS
382 n = n+1
383
384 intbuf_size(n) = intbuf_tab_l%S_GAPE
385 n = n+1
386 intbuf_size(n) = intbuf_tab_l%S_GAP_E_L
387 n = n+1
388 intbuf_size(n) = intbuf_tab_l%S_STFE
389 n = n+1
390 intbuf_size(n) = intbuf_tab_l%S_STIFMSDT_EDG
391 n = n+1
392 intbuf_size(n) = intbuf_tab_l%S_FTSAVX
393 n = n+1
394 intbuf_size(n) = intbuf_tab_l%S_FTSAVY
395 n = n+1
396 intbuf_size(n) = intbuf_tab_l%S_FTSAVZ
397 n = n+1
398 intbuf_size(n) = intbuf_tab_l%S_RIGE
399 n = n+1
400 intbuf_size(n) = intbuf_tab_l%S_XIGE
401 n = n+1
402 intbuf_size(n) = intbuf_tab_l%S_VIGE
403 n = n+1
404 intbuf_size(n) = intbuf_tab_l%S_MASSIGE
405!type10
406 n = n+1
407 intbuf_size(n) = intbuf_tab_l%S_CAND_F
408!type20
409 n = n+1
410 intbuf_size(n) = intbuf_tab_l%S_XA
411 n = n+1
412 intbuf_size(n) = intbuf_tab_l%S_VA
413 n = n+1
414 intbuf_size(n) = intbuf_tab_l%S_STFA
415 n = n+1
416 intbuf_size(n) = intbuf_tab_l%S_AVX_ANCR
417 n = n+1
418 intbuf_size(n) = intbuf_tab_l%S_GAP_SH
419 n = n+1
420 intbuf_size(n) = intbuf_tab_l%S_CAND_FX
421 n = n+1
422 intbuf_size(n) = intbuf_tab_l%S_CAND_FY
423 n = n+1
424 intbuf_size(n) = intbuf_tab_l%S_CAND_FZ
425 n = n+1
426 intbuf_size(n) = intbuf_tab_l%S_GAP_SE
427 n = n+1
428 intbuf_size(n) = intbuf_tab_l%S_GAP_ME
429 n = n+1
430 intbuf_size(n) = intbuf_tab_l%S_STF
431 n = n+1
432 intbuf_size(n) = intbuf_tab_l%S_STFNE
433 n = n+1
434 intbuf_size(n) = intbuf_tab_l%S_CRITX
435 n = n+1
436 intbuf_size(n) = intbuf_tab_l%S_PENISE
437 n = n+1
438 intbuf_size(n) = intbuf_tab_l%S_PENIME
439 n = n+1
440 intbuf_size(n) = intbuf_tab_l%S_PENIA
441 n = n+1
442 intbuf_size(n) = intbuf_tab_l%S_ALPHAK
443 n = n+1
444!type1
445 intbuf_size(n) = intbuf_tab_l%S_N
446!type 3,4,5,9
447 n = n+1
448 intbuf_size(n) = intbuf_tab_l%S_CSTM
449 n = n+1
450 intbuf_size(n) = intbuf_tab_l%S_EE
451 n = n+1
452 intbuf_size(n) = intbuf_tab_l%S_STFNM
453 n = n+1
454 intbuf_size(n) = intbuf_tab_l%S_FRICOS
455 n = n+1
456 intbuf_size(n) = intbuf_tab_l%S_FRICOM
457 n = n+1
458 intbuf_size(n) = intbuf_tab_l%S_FTSAV
459!type 6
460 n = n+1
461 intbuf_size(n) = intbuf_tab_l%S_FCONT
462 n = n+1
463 intbuf_size(n) = intbuf_tab_l%S_FS
464 n = n+1
465 intbuf_size(n) = intbuf_tab_l%S_FM
466 n = n+1
467 intbuf_size(n) = intbuf_tab_l%S_RMAS
468 n = n+1
469 intbuf_size(n) = intbuf_tab_l%S_ANSMX0
470!type 8
471 n = n+1
472 intbuf_size(n) = intbuf_tab_l%S_T8
473 n = n+1
474 intbuf_size(n) = intbuf_tab_l%S_GAPN
475 n = n+1
476 intbuf_size(n) = intbuf_tab_l%S_STF8
477 n = n+1
478!type 14
479 intbuf_size(n) = intbuf_tab_l%S_CIMP
480 n = n+1
481 intbuf_size(n) = intbuf_tab_l%S_NIMP
482!type 15
483 n = n+1
484 intbuf_size(n) = intbuf_tab_l%S_IOLD
485 n = n+1
486 intbuf_size(n) = intbuf_tab_l%S_HOLD
487 n = n+1
488 intbuf_size(n) = intbuf_tab_l%S_NOLD
489 n = n+1
490 intbuf_size(n) = intbuf_tab_l%S_DOLD
491!type 17
492 n = n+1
493 intbuf_size(n) = intbuf_tab_l%S_KS
494 n = n+1
495 intbuf_size(n) = intbuf_tab_l%S_KM
496 n = n+1
497 intbuf_size(n) = intbuf_tab_l%S_FROTS
498 n = n+1
499 intbuf_size(n) = intbuf_tab_l%S_FROTM
500!type 21
501 n = n+1
502 intbuf_size(n) = intbuf_tab_l%S_NOD_NORMAL
503 n = n+1
504 intbuf_size(n) = intbuf_tab_l%S_RCURV
505 n = n+1
506 intbuf_size(n) = intbuf_tab_l%S_ANGLM
507 n = n+1
508 intbuf_size(n) = intbuf_tab_l%S_FROT_P
509 n = n+1
510 intbuf_size(n) = intbuf_tab_l%S_ALPHA0
511 n = n+1
512 intbuf_size(n) = intbuf_tab_l%S_AS
513 n = n+1
514 intbuf_size(n) = intbuf_tab_l%S_BS
515 n = n+1
516 intbuf_size(n) = intbuf_tab_l%S_THKNOD0
517!type 24 & 25
518 n = n+1
519 intbuf_size(n) = intbuf_tab_l%S_GAPN_M
520 n = n+1
521 intbuf_size(n) = intbuf_tab_l%S_SECND_FR
522 n = n+1
523 intbuf_size(n) = intbuf_tab_l%S_PENE_OLD
524 n = n+1
525 intbuf_size(n) = intbuf_tab_l%S_STIF_OLD
526 n = n+1
527 intbuf_size(n) = intbuf_tab_l%S_TIME_S
528 n = n+1
529 intbuf_size(n) = intbuf_tab_l%S_GAP_NM
530 n = n+1
531 intbuf_size(n) = intbuf_tab_l%S_EDGE8L2
532 n = n+1
533 intbuf_size(n) = intbuf_tab_l%S_NOD_2RY_LGTH
534 n = n+1
535 intbuf_size(n) = intbuf_tab_l%S_NOD_MAS_LGTH
536 n = n+1
537 intbuf_size(n) = intbuf_tab_l%S_GAP_N0
538 n = n+1
539 intbuf_size(n) = intbuf_tab_l%S_DGAP_NM
540 n = n+1
541 intbuf_size(n) = intbuf_tab_l%S_DGAP_M
542 n = n+1
543 intbuf_size(n) = intbuf_tab_l%S_DELTA_PMAX_DGAP
544 n = n+1
545 intbuf_size(n) = intbuf_tab_l%S_XFIC
546 n = n+1
547 intbuf_size(n) = intbuf_tab_l%S_VFIC
548 n = n+1
549 intbuf_size(n) = intbuf_tab_l%S_MSFIC
550!type 25
551 n = n+1
552 intbuf_size(n) = intbuf_tab_l%S_EDGE_BISECTOR
553 n = n+1
554 intbuf_size(n) = intbuf_tab_l%S_PENM
555 n = n+1
556 intbuf_size(n) = intbuf_tab_l%S_DISTM
557 n = n+1
558 intbuf_size(n) = intbuf_tab_l%S_LBM
559 n = n+1
560 intbuf_size(n) = intbuf_tab_l%S_LCM
561 n = n+1
562 intbuf_size(n) = intbuf_tab_l%S_VTX_BISECTOR
563 n = n+1
564 intbuf_size(n) = intbuf_tab_l%S_FTSAVX_E
565 n = n+1
566 intbuf_size(n) = intbuf_tab_l%S_FTSAVY_E
567 n = n+1
568 intbuf_size(n) = intbuf_tab_l%S_FTSAVZ_E
569 n = n+1
570 intbuf_size(n) = intbuf_tab_l%S_FTSAVX_E2S
571 n = n+1
572 intbuf_size(n) = intbuf_tab_l%S_FTSAVY_E2S
573 n = n+1
574 intbuf_size(n) = intbuf_tab_l%S_FTSAVZ_E2S
575!type2
576 n = n+1
577 intbuf_size(n) = intbuf_tab_l%S_CSTS_BIS
578!type7 24 25
579 n = n+1
580 intbuf_size(n) = intbuf_tab_l%S_DIR_FRICM
581!type25
582 n = n+1
583 intbuf_size(n) = intbuf_tab_l%S_GAPMSAV
584 n = n+1
585 intbuf_size(n) = intbuf_tab_l%S_E2S_NOD_NORMAL
586
587C=======================================================================
588C write all INTBUF_TAB arrays sizes on disk
589C=======================================================================
590 l_intbuf_size = n
591 IF(l_intbuf_size > l_intbuf_size_max)THEN
592 WRITE(istdo,'(A,/,A)')
593 . ' ** Internal error in routine W_INTBUF_SIZE:',
594 . ' Hard coded value for L_INTBUF_SIZE_MAX needs to be updated'
595 CALL arret(2)
596 END IF
597C=======================================================================
598 CALL write_i_c(l_intbuf_size,1)
599 CALL write_i_c(intbuf_size,l_intbuf_size)
600
601 DEALLOCATE(intbuf_size)
602
603 RETURN
604 END
605
606C=======================================================================
607C GENERIC ROUTINES TO SPLIT & WRITE ON DISK
608C=======================================================================
609
610!||====================================================================
611!|| split_node_ival ../starter/source/restart/ddsplit/inter_tools.F
612!||--- called by ------------------------------------------------------
613!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
614!||--- calls -----------------------------------------------------
615!||--- uses -----------------------------------------------------
616!||====================================================================
617 SUBROUTINE split_node_ival(TAB,DIM1,DIM2,TAG)
618c
619c split & write node array (type INTEGER) with global value
620c (see SPLIT_NODE_NODLOC for local values)
621c
622C-----------------------------------------------
623C M o d u l e s
624C-----------------------------------------------
625 USE intbufdef_mod
626C-----------------------------------------------
627C I m p l i c i t T y p e s
628C-----------------------------------------------
629#include "implicit_f.inc"
630C-----------------------------------------------
631C D u m m y A r g u m e n t s
632C-----------------------------------------------
633 INTEGER TAB(*),TAG(*),DIM1,DIM2
634C-----------------------------------------------
635C L o c a l V a r i a b l e s
636C-----------------------------------------------
637 INTEGER I,J,K
638 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
639C ----------------------------------------
640 ALLOCATE(ibuf(dim1*dim2))
641
642 DO i=1, dim1
643 k=tag(i)
644 DO j=1,dim2
645 ibuf(dim2*(i-1)+j) = tab(dim2*(k-1)+j)
646 ENDDO
647 ENDDO
648
649 CALL write_i_c(ibuf,dim1*dim2)
650
651 DEALLOCATE(ibuf)
652
653 RETURN
654 END
655!||====================================================================
656!|| filter_node_nodloc ../starter/source/restart/ddsplit/inter_tools.F
657!||--- called by ------------------------------------------------------
658!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
659!||--- calls -----------------------------------------------------
660!||--- uses -----------------------------------------------------
661!||====================================================================
662 SUBROUTINE filter_node_nodloc(TAB,DIM1,TAG,NODLOCAL)
663c
664c Filter & write node array (type INTEGER) with local value
665c
666C-----------------------------------------------
667C M o d u l e s
668C-----------------------------------------------
669 USE intbufdef_mod
670C-----------------------------------------------
671C I m p l i c i t T y p e s
672C-----------------------------------------------
673#include "implicit_f.inc"
674C-----------------------------------------------
675C D u m m y A r g u m e n t s
676C-----------------------------------------------
677 INTEGER TAB(*),TAG(*),DIM1,NODLOCAL(*)
678C-----------------------------------------------
679C L o c a l V a r i a b l e s
680C-----------------------------------------------
681 INTEGER I,K
682 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
683C ----------------------------------------
684 ALLOCATE(ibuf(dim1))
685 DO i=1, dim1
686 k = tag(i)
687 IF(k > 0) THEN
688 ibuf(i) = nodlocal(tab(i))
689 ELSE
690 ibuf(i) = -1
691 ENDIF
692 ENDDO
693c WRITE(6,*) __FILE__,__LINE__,IBUF(1:DIM1)
694 CALL write_i_c(ibuf,dim1)
695 DEALLOCATE(ibuf)
696
697 RETURN
698 END
699!||====================================================================
700!|| copy_node_nodloc ../starter/source/restart/ddsplit/inter_tools.F
701!||--- called by ------------------------------------------------------
702!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
703!||--- calls -----------------------------------------------------
704!||--- uses -----------------------------------------------------
705!||====================================================================
706 SUBROUTINE copy_node_nodloc(TAB,DIM1,NODLOCAL)
707c
708c Copy & write node array (type INTEGER) with local value
709c (see SPLIT_NODE_IVAL for global values)
710c
711C-----------------------------------------------
712C M o d u l e s
713C-----------------------------------------------
714 USE intbufdef_mod
715C-----------------------------------------------
716C I m p l i c i t T y p e s
717C-----------------------------------------------
718#include "implicit_f.inc"
719C-----------------------------------------------
720C D u m m y A r g u m e n t s
721C-----------------------------------------------
722 INTEGER TAB(*),DIM1,NODLOCAL(*)
723C-----------------------------------------------
724C L o c a l V a r i a b l e s
725C-----------------------------------------------
726 INTEGER I
727 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
728C ----------------------------------------
729 ALLOCATE(ibuf(dim1))
730 DO i=1, dim1
731 ibuf(i) = nodlocal(tab(i))
732 ENDDO
733
734c
735 CALL write_i_c(ibuf,dim1)
736 DEALLOCATE(ibuf)
737
738 RETURN
739 END
740
741!||====================================================================
742!|| split_node_nodloc ../starter/source/restart/ddsplit/inter_tools.F
743!||--- called by ------------------------------------------------------
744!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
745!||--- calls -----------------------------------------------------
746!||--- uses -----------------------------------------------------
747!||====================================================================
748 SUBROUTINE split_node_nodloc(TAB,DIM1,TAG,NODLOCAL)
749c
750c split & write node array (type INTEGER) with local value
751c (see SPLIT_NODE_IVAL for global values)
752c
753C-----------------------------------------------
754C M o d u l e s
755C-----------------------------------------------
756 USE intbufdef_mod
757C-----------------------------------------------
758C I m p l i c i t T y p e s
759C-----------------------------------------------
760#include "implicit_f.inc"
761C-----------------------------------------------
762C D u m m y A r g u m e n t s
763C-----------------------------------------------
764 INTEGER TAB(*),TAG(*),DIM1,NODLOCAL(*)
765C-----------------------------------------------
766C L o c a l V a r i a b l e s
767C-----------------------------------------------
768 INTEGER I,K
769 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
770C ----------------------------------------
771 ALLOCATE(ibuf(dim1))
772 DO i=1, dim1
773 k = tag(i)
774 ibuf(i) = nodlocal(tab(k))
775 ENDDO
776! WRITE(6,*) __FILE__,__LINE__,IBUF(1:DIM1)
777 CALL write_i_c(ibuf,dim1)
778 DEALLOCATE(ibuf)
779
780 RETURN
781 END
782!||====================================================================
783!|| split_node_rval ../starter/source/restart/ddsplit/inter_tools.F
784!||--- called by ------------------------------------------------------
785!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
786!||--- calls -----------------------------------------------------
787!||--- uses -----------------------------------------------------
788!||====================================================================
789 SUBROUTINE split_node_rval(TAB,DIM1,DIM2,TAG)
790c
791c split & write node array (type REAL) with global value
792c
793C-----------------------------------------------
794C M o d u l e s
795C-----------------------------------------------
796 USE intbufdef_mod
797C-----------------------------------------------
798C I m p l i c i t T y p e s
799C-----------------------------------------------
800#include "implicit_f.inc"
801C-----------------------------------------------
802C D u m m y A r g u m e n t s
803C-----------------------------------------------
804 INTEGER TAG(*),DIM1,DIM2
805
806 my_real tab(*)
807C-----------------------------------------------
808C L o c a l V a r i a b l e s
809C-----------------------------------------------
810 INTEGER I,J,K
811
812 my_real, DIMENSION(:),ALLOCATABLE :: rbuf
813C ----------------------------------------
814 ALLOCATE(rbuf(dim1*dim2))
815 DO i=1, dim1
816 k=tag(i)
817 DO j=1,dim2
818 rbuf(dim2*(i-1)+j) = tab(dim2*(k-1)+j)
819 ENDDO
820 ENDDO
821
822 CALL write_db(rbuf,dim1*dim2)
823 DEALLOCATE(rbuf)
824
825 RETURN
826 END
827!||====================================================================
828!|| split_node_rval_dummy ../starter/source/restart/ddsplit/inter_tools.F
829!||--- called by ------------------------------------------------------
830!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
831!||--- calls -----------------------------------------------------
832!||--- uses -----------------------------------------------------
833!||====================================================================
834 SUBROUTINE split_node_rval_dummy(DIM1,DIM2,TAG)
835c
836c split & write node array (type REAL) with global value
837c
838C-----------------------------------------------
839C M o d u l e s
840C-----------------------------------------------
841 USE intbufdef_mod
842C-----------------------------------------------
843C I m p l i c i t T y p e s
844C-----------------------------------------------
845#include "implicit_f.inc"
846C-----------------------------------------------
847C D u m m y A r g u m e n t s
848C-----------------------------------------------
849 INTEGER TAG(*),DIM1,DIM2
850C-----------------------------------------------
851C L o c a l V a r i a b l e s
852C-----------------------------------------------
853 INTEGER I,J,K
854
855 my_real, DIMENSION(:),ALLOCATABLE :: rbuf
856C ----------------------------------------
857 ALLOCATE(rbuf(dim1*dim2))
858 DO i=1, dim1
859 k=tag(i)
860 DO j=1,dim2
861 rbuf(dim2*(i-1)+j) = 0
862 ENDDO
863 ENDDO
864
865 !CALL WRITE_DB(RBUF,DIM1*DIM2)
866 IF(dim1*dim2 > 0) CALL compress_r_nnz(rbuf,dim1*dim2)
867 DEALLOCATE(rbuf)
868
869 RETURN
870 END
871
872!||====================================================================
873!|| split_seg_nodloc ../starter/source/restart/ddsplit/inter_tools.F
874!||--- called by ------------------------------------------------------
875!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
876!||--- calls -----------------------------------------------------
877!||--- uses -----------------------------------------------------
878!||====================================================================
879 SUBROUTINE split_seg_nodloc(TAB,DIM1,DIM2,TAG_SEG,NODLOCAL)
880c
881c split & write segments array (type INTEGER) with local value
882c
883C-----------------------------------------------
884C M o d u l e s
885C-----------------------------------------------
886 USE intbufdef_mod
887C-----------------------------------------------
888C I m p l i c i t T y p e s
889C-----------------------------------------------
890#include "implicit_f.inc"
891C-----------------------------------------------
892C D u m m y A r g u m e n t s
893C-----------------------------------------------
894 INTEGER TAB(*),TAG_SEG(*),DIM1,DIM2,NODLOCAL(*)
895C-----------------------------------------------
896C L o c a l V a r i a b l e s
897C-----------------------------------------------
898 INTEGER I,J,K,NOD
899 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
900C ----------------------------------------
901 ALLOCATE(ibuf(dim1*dim2))
902 ibuf = 0
903 DO i=1, dim1
904 k=tag_seg(i)
905 DO j=1,dim2
906 nod = tab(dim2*(k-1)+j)
907 IF (nod > 0) THEN
908 ibuf(dim2*(i-1)+j) = nodlocal(nod)
909 ENDIF
910 ENDDO
911 ENDDO
912 CALL write_i_c(ibuf,dim1*dim2)
913! WRITE(6,*) __FILE__,__LINE__,IBUF(1)
914 DEALLOCATE(ibuf)
915
916 RETURN
917 END
918!||====================================================================
919!|| split_seg_segloc ../starter/source/restart/ddsplit/inter_tools.F
920!||--- called by ------------------------------------------------------
921!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
922!||--- calls -----------------------------------------------------
923!||--- uses -----------------------------------------------------
924!||====================================================================
925 SUBROUTINE split_seg_segloc(TAB,DIM1,DIM2,TAG_SEG,SEGLOCAL)
926c
927c split & write segments array (type INTEGER) with local value
928c
929C-----------------------------------------------
930C M o d u l e s
931C-----------------------------------------------
932 USE intbufdef_mod
933C-----------------------------------------------
934C I m p l i c i t T y p e s
935C-----------------------------------------------
936#include "implicit_f.inc"
937C-----------------------------------------------
938C D u m m y A r g u m e n t s
939C-----------------------------------------------
940 INTEGER TAB(*),TAG_SEG(*),DIM1,DIM2,SEGLOCAL(*)
941C-----------------------------------------------
942C L o c a l V a r i a b l e s
943C-----------------------------------------------
944 INTEGER I,J,K,GLOB
945 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
946C ----------------------------------------
947 ALLOCATE(ibuf(dim1*dim2))
948 DO i=1, dim1
949 k=tag_seg(i)
950 DO j=1,dim2
951 glob=tab(dim2*(k-1)+j)
952 IF(glob/=0)THEN
953 IF(seglocal(glob)/=0)THEN
954 ibuf(dim2*(i-1)+j) = seglocal(glob) ! local if same proc
955 ELSE
956 ibuf(dim2*(i-1)+j) = -glob
957 END IF
958 ELSE
959 ibuf(dim2*(i-1)+j) = 0
960 END IF
961 ENDDO
962 ENDDO
963
964 CALL write_i_c(ibuf,dim1*dim2)
965! WRITE(6,*) __FILE__,__LINE__,IBUF(1)
966 DEALLOCATE(ibuf)
967
968 RETURN
969 END
970
971!||====================================================================
972!|| copy_ival ../starter/source/restart/ddsplit/inter_tools.F
973!||--- called by ------------------------------------------------------
974!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
975!||--- calls -----------------------------------------------------
976!||--- uses -----------------------------------------------------
977!||====================================================================
978 SUBROUTINE copy_ival(TAB,DIM1,DIM2)
979c
980c copy and write array value (type INTEGER)
981c
982C-----------------------------------------------
983C M o d u l e s
984C-----------------------------------------------
985 USE intbufdef_mod
986C-----------------------------------------------
987C I m p l i c i t T y p e s
988C-----------------------------------------------
989#include "implicit_f.inc"
990C-----------------------------------------------
991C D u m m y A r g u m e n t s
992C-----------------------------------------------
993 INTEGER TAB(*),DIM1,DIM2
994C-----------------------------------------------
995C L o c a l V a r i a b l e s
996C-----------------------------------------------
997 INTEGER I,J
998 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
999C ----------------------------------------
1000 ALLOCATE(ibuf(dim1*dim2))
1001
1002 DO i=1, dim1
1003 DO j=1, dim2
1004 ibuf(dim2*(i-1)+j) = tab(dim2*(i-1)+j)
1005 ENDDO
1006 ENDDO
1007
1008 CALL write_i_c(ibuf,dim1*dim2)
1009 DEALLOCATE(ibuf)
1010
1011 RETURN
1012 END
1013!||====================================================================
1014!|| copy_ival_dummy ../starter/source/restart/ddsplit/inter_tools.F
1015!||--- called by ------------------------------------------------------
1016!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
1017!||--- calls -----------------------------------------------------
1018!||--- uses -----------------------------------------------------
1019!||====================================================================
1020 SUBROUTINE copy_ival_dummy(DIM1,DIM2)
1021c
1022c copy and write array value (type INTEGER)
1023c
1024C-----------------------------------------------
1025C M o d u l e s
1026C-----------------------------------------------
1027 USE intbufdef_mod
1028C-----------------------------------------------
1029C I m p l i c i t T y p e s
1030C-----------------------------------------------
1031#include "implicit_f.inc"
1032C-----------------------------------------------
1033C D u m m y A r g u m e n t s
1034C-----------------------------------------------
1035 INTEGER DIM1,DIM2
1036C-----------------------------------------------
1037C L o c a l V a r i a b l e s
1038C-----------------------------------------------
1039 INTEGER I,J
1040 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
1041C ----------------------------------------
1042 ALLOCATE(ibuf(dim1*dim2))
1043
1044 DO i=1, dim1
1045 DO j=1, dim2
1046 ibuf(dim2*(i-1)+j) = 0
1047 ENDDO
1048 ENDDO
1049 IF(dim1*dim2 >0) CALL compress_i_nnz(ibuf,dim1*dim2)
1050 DEALLOCATE(ibuf)
1051
1052 RETURN
1053 END
1054
1055!||====================================================================
1056!|| copy_ival_igeo ../starter/source/restart/ddsplit/inter_tools.F
1057!||--- called by ------------------------------------------------------
1058!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
1059!||--- calls -----------------------------------------------------
1060!||--- uses -----------------------------------------------------
1061!||====================================================================
1062 SUBROUTINE copy_ival_igeo(TAB,DIM1,DIM2,OFFSET)
1063c
1064c copy and write array value (type INTEGER)
1065c
1066C-----------------------------------------------
1067C M o d u l e s
1068C-----------------------------------------------
1069 USE intbufdef_mod
1070C-----------------------------------------------
1071C I m p l i c i t T y p e s
1072C-----------------------------------------------
1073#include "implicit_f.inc"
1074C-----------------------------------------------
1075C D u m m y A r g u m e n t s
1076C-----------------------------------------------
1077 INTEGER TAB(*),DIM1,DIM2,OFFSET
1078C-----------------------------------------------
1079C L o c a l V a r i a b l e s
1080C-----------------------------------------------
1081 INTEGER I,J
1082 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
1083C ----------------------------------------
1084 ALLOCATE(ibuf(dim1*dim2))
1085
1086 DO i=1, dim1
1087 DO j=1, dim2
1088 ibuf(dim2*(i-1)+j) = tab(dim2*(i-1)+j+offset)
1089 ENDDO
1090 ENDDO
1091
1092 CALL write_i_c(ibuf,dim1*dim2)
1093 DEALLOCATE(ibuf)
1094
1095 RETURN
1096 END
1097!||====================================================================
1098!|| copy_rval ../starter/source/restart/ddsplit/inter_tools.F
1099!||--- called by ------------------------------------------------------
1100!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
1101!||--- calls -----------------------------------------------------
1102!||--- uses -----------------------------------------------------
1103!||====================================================================
1104 SUBROUTINE copy_rval(TAB,DIM1,DIM2)
1105c
1106c copy and write array value (type REAL)
1107c
1108C-----------------------------------------------
1109C M o d u l e s
1110C-----------------------------------------------
1111 USE intbufdef_mod
1112C-----------------------------------------------
1113C I m p l i c i t T y p e s
1114C-----------------------------------------------
1115#include "implicit_f.inc"
1116C-----------------------------------------------
1117C D u m m y A r g u m e n t s
1118C-----------------------------------------------
1119 INTEGER DIM1,DIM2
1120
1121 my_real
1122 . tab(*)
1123C-----------------------------------------------
1124C L o c a l V a r i a b l e s
1125C-----------------------------------------------
1126 INTEGER I,J
1127 my_real, DIMENSION(:),ALLOCATABLE :: rbuf
1128C ----------------------------------------
1129 ALLOCATE(rbuf(dim1*dim2))
1130
1131 DO i=1, dim1
1132 DO j=1, dim2
1133 rbuf(dim2*(i-1)+j) = tab(dim2*(i-1)+j)
1134 ENDDO
1135 ENDDO
1136
1137 CALL write_db(rbuf,dim1*dim2)
1138 DEALLOCATE(rbuf)
1139
1140 RETURN
1141 END
1142!||====================================================================
1143!|| split_node_nodloc_p0 ../starter/source/restart/ddsplit/inter_tools.F
1144!||--- called by ------------------------------------------------------
1145!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.f
1146!||--- calls -----------------------------------------------------
1147!||--- uses -----------------------------------------------------
1148!||====================================================================
1149 SUBROUTINE split_node_nodloc_p0(TAB,DIM1,DIM2,NODLOCAL)
1150c
1151c same routine as SPLIT_NODE_NODLOC for interfaces splited
1152c only on proc 1 (no TAG array used)
1153c
1154C-----------------------------------------------
1155C M o d u l e s
1156C-----------------------------------------------
1157 USE intbufdef_mod
1158C-----------------------------------------------
1159C I m p l i c i t T y p e s
1160C-----------------------------------------------
1161#include "implicit_f.inc"
1162C-----------------------------------------------
1163C D u m m y A r g u m e n t s
1164C-----------------------------------------------
1165 INTEGER TAB(*),DIM1,DIM2,NODLOCAL(*)
1166C-----------------------------------------------
1167C L o c a l V a r i a b l e s
1168C-----------------------------------------------
1169 INTEGER I,J
1170 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
1171C ----------------------------------------
1172 ALLOCATE(ibuf(dim1*dim2))
1173 DO i=1, dim1
1174 DO j=1, dim2
1175 ibuf(dim2*(i-1)+j) = nodlocal(tab(dim2*(i-1)+j))
1176 ENDDO
1177 ENDDO
1178
1179 CALL write_i_c(ibuf,dim1*dim2)
1180 DEALLOCATE(ibuf)
1181
1182 RETURN
1183 END
1184!||====================================================================
1185!|| prepare_split_cand ../starter/source/restart/ddsplit/inter_tools.F
1186!||--- called by ------------------------------------------------------
1187!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
1188!||--- uses -----------------------------------------------------
1189!||====================================================================
1190 SUBROUTINE prepare_split_cand(INTBUF_TAB, TAG_SEGM2, II_STOK, TAG_II)
1191C-----------------------------------------------
1192C M o d u l e s
1193C-----------------------------------------------
1194 USE intbufdef_mod
1195C-----------------------------------------------
1196C I m p l i c i t T y p e s
1197C-----------------------------------------------
1198#include "implicit_f.inc"
1199C-----------------------------------------------
1200C D u m m y A r g u m e n t s
1201C-----------------------------------------------
1202 INTEGER TAG_SEGM2(*),TAG_II(*),II_STOK
1203
1204 TYPE(intbuf_struct_) :: INTBUF_TAB
1205C-----------------------------------------------
1206C L o c a l V a r i a b l e s
1207C-----------------------------------------------
1208 INTEGER
1209 . K,E,C_II
1210C ----------------------------------------
1211
1212! prepare split candidates
1213 c_ii = 0
1214 DO k = 1, ii_stok
1215 e = intbuf_tab%CAND_E(k)
1216 IF (tag_segm2(e)/=0) THEN
1217 c_ii = c_ii + 1
1218 tag_ii(c_ii) = k
1219 ENDIF
1220 ENDDO
1221
1222 RETURN
1223 END
1224!||====================================================================
1225!|| split_cand_ival ../starter/source/restart/ddsplit/inter_tools.F
1226!||--- called by ------------------------------------------------------
1227!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
1228!||--- calls -----------------------------------------------------
1229!||--- uses -----------------------------------------------------
1230!||====================================================================
1231 SUBROUTINE split_cand_ival(TAB , II_STOK_L, TAG_II,
1232 . MULTIMP, NCONT )
1233c
1234c split & write candidates (INTEGERs arrays sized MULTIMP*NCONT)
1235c
1236C-----------------------------------------------
1237C M o d u l e s
1238C-----------------------------------------------
1239 USE intbufdef_mod
1240C-----------------------------------------------
1241C I m p l i c i t T y p e s
1242C-----------------------------------------------
1243#include "implicit_f.inc"
1244C-----------------------------------------------
1245C D u m m y A r g u m e n t s
1246C-----------------------------------------------
1247 INTEGER TAB(*),TAG_II(*),II_STOK_L,MULTIMP,NCONT
1248C-----------------------------------------------
1249C L o c a l V a r i a b l e s
1250C-----------------------------------------------
1251 INTEGER I,K
1252 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
1253C ----------------------------------------
1254 ALLOCATE(ibuf(multimp*ncont))
1255 ibuf(1:multimp*ncont) = 0
1256
1257 DO i=1, ii_stok_l
1258 k=tag_ii(i)
1259 ibuf(i) = tab(k)
1260 ENDDO
1261
1262 CALL write_i_c(ibuf,multimp*ncont)
1263 DEALLOCATE(ibuf)
1264
1265 RETURN
1266 END
1267!||====================================================================
1268!|| split_cand_rval ../starter/source/restart/ddsplit/inter_tools.F
1269!||--- called by ------------------------------------------------------
1270!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
1271!||--- calls -----------------------------------------------------
1272!||--- uses -----------------------------------------------------
1273!||====================================================================
1274 SUBROUTINE split_cand_rval(TAB,II_STOK_L,TAG_II,MULTIMP,NCONT)
1275c
1276c split & write candidates (REALs arrays sized MULTIMP*NCONT)
1277c
1278C-----------------------------------------------
1279C M o d u l e s
1280C-----------------------------------------------
1281 USE intbufdef_mod
1282C-----------------------------------------------
1283C I m p l i c i t T y p e s
1284C-----------------------------------------------
1285#include "implicit_f.inc"
1286C-----------------------------------------------
1287C D u m m y A r g u m e n t s
1288C-----------------------------------------------
1289 INTEGER TAG_II(*),II_STOK_L,MULTIMP,NCONT
1290
1291 my_real tab(*)
1292C-----------------------------------------------
1293C L o c a l V a r i a b l e s
1294C-----------------------------------------------
1295 INTEGER I,K
1296 my_real, DIMENSION(:),ALLOCATABLE :: rbuf
1297C ----------------------------------------
1298 ALLOCATE(rbuf(multimp*ncont))
1299 rbuf(1:multimp*ncont) = 0
1300
1301 DO i=1, ii_stok_l
1302 k=tag_ii(i)
1303 rbuf(i) = tab(k)
1304 ENDDO
1305
1306 CALL write_db(rbuf,multimp*ncont)
1307 DEALLOCATE(rbuf)
1308
1309 RETURN
1310 END
1311!||====================================================================
1312!|| split_cand_rval_dummy ../starter/source/restart/ddsplit/inter_tools.F
1313!||--- called by ------------------------------------------------------
1314!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
1315!||--- calls -----------------------------------------------------
1316!||--- uses -----------------------------------------------------
1317!||====================================================================
1318 SUBROUTINE split_cand_rval_dummy(II_STOK_L,TAG_II,MULTIMP,NCONT)
1319c
1320c split & write candidates (REALs arrays sized MULTIMP*NCONT)
1321c
1322C-----------------------------------------------
1323C M o d u l e s
1324C-----------------------------------------------
1325 USE intbufdef_mod
1326C-----------------------------------------------
1327C I m p l i c i t T y p e s
1328C-----------------------------------------------
1329#include "implicit_f.inc"
1330C-----------------------------------------------
1331C D u m m y A r g u m e n t s
1332C-----------------------------------------------
1333 INTEGER TAG_II(*),II_STOK_L,MULTIMP,NCONT
1334
1335C-----------------------------------------------
1336C L o c a l V a r i a b l e s
1337C-----------------------------------------------
1338 INTEGER I,K
1339 my_real, DIMENSION(:),ALLOCATABLE :: rbuf
1340C ----------------------------------------
1341 ALLOCATE(rbuf(multimp*ncont))
1342 rbuf(1:multimp*ncont) = 0
1343
1344 DO i=1, ii_stok_l
1345 k=tag_ii(i)
1346 rbuf(i) = 0
1347 ENDDO
1348
1349 !CALL WRITE_DB(RBUF,MULTIMP*NCONT)
1350
1351 IF(multimp * ncont > 0) CALL compress_r_nnz(rbuf,multimp*ncont)
1352 DEALLOCATE(rbuf)
1353
1354 RETURN
1355 END
1356
1357
1358C=======================================================================
1359C END GENERIC ROUTINES TO SPLIT & WRITE ON DISK
1360C=======================================================================
1361
1362C=======================================================================
1363C SPECIFIC ROUTINES INT2
1364C=======================================================================
1365!||====================================================================
1366!|| prepare_split_i2 ../starter/source/restart/ddsplit/inter_tools.F
1367!||--- called by ------------------------------------------------------
1368!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
1369!||--- uses -----------------------------------------------------
1370!|| front_mod ../starter/share/modules1/front_mod.F
1371!||====================================================================
1372 SUBROUTINE prepare_split_i2(PROC, INTBUF_TAB , NSN , NMN ,
1373 + NRTM, TAG_NODE_2RY, TAG_SEGM, TAG_SEGM2,
1374 + TAG_IRTL, TAG , ITABI2M , NODLOCAL ,
1375 + NBDDI2M , NIR ,NUMNOD_L)
1376C-----------------------------------------------
1377C M o d u l e s
1378C-----------------------------------------------
1379 USE intbufdef_mod
1380 USE front_mod
1381C-----------------------------------------------
1382C I m p l i c i t T y p e s
1383C-----------------------------------------------
1384#include "implicit_f.inc"
1385C-----------------------------------------------
1386C D u m m y A r g u m e n t s
1387C-----------------------------------------------
1388 INTEGER
1389 . NSN,NRTM,NMN
1390 INTEGER, INTENT(IN) :: NUMNOD_L
1391
1392 INTEGER PROC,TAG_NODE_2RY(*),TAG_SEGM(*),TAG_SEGM2(*),TAG(*),
1393 . TAG_IRTL(*),ITABI2M(*),NBDDI2M,NIR
1394 INTEGER, DIMENSION(*), INTENT(IN) :: NODLOCAL
1395! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
1396! NODLOCAL : integer, dimension=NUMNOD
1397! gives the local ID of a global element
1398! --> used here to avoid NLOCAL call (the NLOCAL perf is bad)
1399! NODLOCAL /= 0 if the element is on the current domain/processor
1400! and =0 if the element is not on the current domain
1401! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
1402
1403 TYPE(intbuf_struct_) :: INTBUF_TAB
1404C-----------------------------------------------
1405C F u n c t i o n
1406C-----------------------------------------------
1407! INTEGER NLOCAL
1408! EXTERNAL NLOCAL
1409C-----------------------------------------------
1410C L o c a l V a r i a b l e s
1411C-----------------------------------------------
1412 INTEGER
1413 . I,K,L,M,N,JJ,
1414 . CNRTM_L,CNSN_L,CNMN_L,MY_NODE
1415C ----------------------------------------
1416 DO k=1,nsn
1417 my_node = intbuf_tab%NSV(k)
1418 IF( nodlocal( my_node )/=0.AND.nodlocal( my_node )<=numnod_l ) THEN
1419 l = intbuf_tab%IRTLM(k)
1420 tag(l) = 1
1421 ENDIF
1422 ENDDO
1423
1424 cnrtm_l = 0
1425 DO k=1,nrtm
1426 IF(tag(k)==1) THEN
1427 cnrtm_l = cnrtm_l + 1
1428 tag_segm(cnrtm_l) = k
1429 tag_segm2(k) = cnrtm_l
1430
1431 END IF
1432 ENDDO
1433
1434 cnsn_l = 0
1435 DO k=1, nsn
1436 my_node = intbuf_tab%NSV(k)
1437 IF( nodlocal( my_node )/=0.AND.nodlocal( my_node )<=numnod_l ) THEN
1438 cnsn_l = cnsn_l+1
1439 tag_node_2ry(cnsn_l) = k
1440 ENDIF
1441 ENDDO
1442
1443 cnmn_l = 0
1444 DO k = 1, nmn
1445 n = intbuf_tab%MSR(k)
1446 IF( nodlocal( n )/=0.AND.nodlocal( n )<=numnod_l ) THEN
1447 IF(nbddi2m>0)itabi2m(nodlocal(n)) = 1
1448 cnmn_l = cnmn_l + 1
1449 tag_irtl(cnmn_l) = k
1450 ENDIF
1451 END DO
1452
1453 RETURN
1454 END
1455!||====================================================================
1456!|| split_node_ival2 ../starter/source/restart/ddsplit/inter_tools.F
1457!||--- called by ------------------------------------------------------
1458!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
1459!||--- calls -----------------------------------------------------
1460!||--- uses -----------------------------------------------------
1461!||====================================================================
1462 SUBROUTINE split_node_ival2(TAB,DIM1,DIM2,TAG_SEGM2,TAG_NODE_2RY)
1463c specific type2, need use of 2 TAG arrays (one for main segment, one for secnd node)
1464C-----------------------------------------------
1465C M o d u l e s
1466C-----------------------------------------------
1467 USE intbufdef_mod
1468C-----------------------------------------------
1469C I m p l i c i t T y p e s
1470C-----------------------------------------------
1471#include "implicit_f.inc"
1472C-----------------------------------------------
1473C D u m m y A r g u m e n t s
1474C-----------------------------------------------
1475 INTEGER TAB(*),TAG_SEGM2(*),TAG_NODE_2RY(*),DIM1,DIM2
1476C-----------------------------------------------
1477C L o c a l V a r i a b l e s
1478C-----------------------------------------------
1479 INTEGER I,J,K
1480 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
1481C ----------------------------------------
1482 ALLOCATE(IBUF(DIM1*DIM2))
1483
1484 DO i=1, dim1
1485 k=tag_node_2ry(i)
1486 DO j=1,dim2
1487 ibuf(dim2*(i-1)+j) = tag_segm2(tab(dim2*(k-1)+j))
1488 ENDDO
1489 ENDDO
1490
1491 CALL write_i_c(ibuf,dim1*dim2)
1492 DEALLOCATE(ibuf)
1493
1494 RETURN
1495 END
1496!||====================================================================
1497!|| split_seg_ival2 ../starter/source/restart/ddsplit/inter_tools.F
1498!||--- called by ------------------------------------------------------
1499!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
1500!||--- calls -----------------------------------------------------
1501!||--- uses -----------------------------------------------------
1502!||====================================================================
1503 SUBROUTINE split_seg_ival2(TAB,DIM1,TAG,TAG2)
1504c
1505c split segment array with global value specific type2
1506c
1507C-----------------------------------------------
1508C M o d u l e s
1509C-----------------------------------------------
1510 USE intbufdef_mod
1511C-----------------------------------------------
1512C I m p l i c i t T y p e s
1513C-----------------------------------------------
1514#include "implicit_f.inc"
1515C-----------------------------------------------
1516C D u m m y A r g u m e n t s
1517C-----------------------------------------------
1518 INTEGER TAB(*),DIM1,TAG(*),TAG2(*)
1519C-----------------------------------------------
1520C L o c a l V a r i a b l e s
1521C-----------------------------------------------
1522 INTEGER I,K,N
1523 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
1524C ----------------------------------------
1525 ALLOCATE(IBUF(DIM1))
1526
1527 DO i=1, dim1
1528 k=tag(i)
1529 ibuf(i) = tab(k)
1530 ENDDO
1531
1532 CALL write_i_c(ibuf,dim1)
1533 DEALLOCATE(ibuf)
1534
1535 RETURN
1536 END
1537C=======================================================================
1538C END SPECIFIC ROUTINES INT2
1539C=======================================================================
1540
1541
1542C=======================================================================
1543C SPECIFIC ROUTINES INT7
1544C=======================================================================
1545!||====================================================================
1546!|| prepare_split_i7 ../starter/source/restart/ddsplit/inter_tools.F
1547!||--- called by ------------------------------------------------------
1548!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
1549!||--- uses -----------------------------------------------------
1550!|| front_mod ../starter/share/modules1/front_mod.F
1551!|| i7i10splitmod ../starter/share/modules1/i710split_mod.F
1552!||====================================================================
1553 SUBROUTINE prepare_split_i7(PROC , INTBUF_TAB , IPARI ,
1554 . INTERCEP , TAG_NODE_2RY, TAG_SEGM ,
1555 . TAG_SEGM2, TAG_NM , TAG_NODE_MSR,
1556 . TAG_SCRATCH, NI, CEP, MULTI_FVM,I710XSAV,
1557 . NINDX_NM , INDX_NM,NINDX_SCRT,INDX_SCRT,NODLOCAL,
1558 . NUMNOD_L)
1559C-----------------------------------------------
1560C M o d u l e s
1561C-----------------------------------------------
1562 USE intbufdef_mod
1563 USE front_mod
1564 USE i7i10splitmod
1565 USE multi_fvm_mod
1566C-----------------------------------------------
1567C I m p l i c i t T y p e s
1568C-----------------------------------------------
1569#include "implicit_f.inc"
1570C-----------------------------------------------
1571C D u m m y A r g u m e n t s
1572C-----------------------------------------------
1573 TYPE(INTBUF_STRUCT_) :: INTBUF_TAB
1574 TYPE(intersurfp) :: INTERCEP
1575 TYPE(MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
1576
1577 INTEGER NI,PROC,IPARI(*),
1578 . TAG_NODE_2RY(*),TAG_SEGM(*),TAG_NM(*),TAG_NODE_MSR(*),
1579 . TAG_SEGM2(*),TAG_SCRATCH(*),CEP(*)
1580 INTEGER, INTENT(INOUT) :: NINDX_NM,NINDX_SCRT
1581 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_NM,INDX_SCRT
1582 INTEGER, DIMENSION(*), INTENT(IN) :: NODLOCAL
1583 INTEGER, INTENT(IN) :: NUMNOD_L
1584 INTEGER I710XSAV(*)
1585! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
1586! INDX_XXX : size = NUMNOD
1587! index of non-zero TAG_XXX value
1588! used for optimize the initialization
1589! of TAG_XXX array (XXX = NM or SCRT for SCRATCH)
1590! allocated array in lectur and threadprivate array
1591! NINDX_XXX : number of non-zero TAG_XXX value
1592! TAG_XXX : size = NUMNOD
1593! array used to tag an element for
1594! a given interface ; allocated in lectur
1595! allocated array in lectur and threadprivate array
1596! NODLOCAL : integer, dimension=NUMNOD
1597! gives the local ID of a global element
1598! --> used here to avoid NLOCAL call (the NLOCAL perf is bad)
1599! NODLOCAL /= 0 if the element is on the current domain/processor
1600! and =0 if the element is not on the current domain
1601! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
1602 .
1603C-----------------------------------------------
1604C F u n c t i o n
1605C-----------------------------------------------
1606! INTEGER NLOCAL
1607! EXTERNAL NLOCAL
1608C-----------------------------------------------
1609C L o c a l V a r i a b l e s
1610C-----------------------------------------------
1611 INTEGER
1612 . NSN,NRTM,NMN,
1613 . I,J,K,N,N1,N2,N3,N4,E,
1614 . CNSN_L,CNRTM_L,CNMN_L,NSN0,
1615 . NSN_FE, NSN_IGE
1616C ----------------------------------------
1617 IF(IPARI(7) == 7) then
1618 nrtm = ipari(4)
1619 nsn = ipari(5)
1620 nsn_ige = ipari(77)
1621 nmn = ipari(6)
1622 nsn0 = nsn - nsn_ige
1623 ELSE
1624 nrtm = ipari(4)
1625 nsn = ipari(5)
1626 nmn = ipari(6)
1627 nsn0 = nsn
1628 nsn_ige = 0
1629 ENDIF
1630
1631 cnsn_l = 0
1632 IF (multi_fvm%IS_USED .AND. abs(ipari(22)) == 7) THEN
1633C Interface type 18 law 151
1634 DO k=1, nsn0
1635 n=intbuf_tab%NSV(k)
1636 IF(cep(n) == proc .AND.tag_scratch(n)==0) THEN
1637 cnsn_l = cnsn_l+1
1638 tag_node_2ry(cnsn_l) = k
1639 tag_scratch(n)=1
1640 nindx_scrt = nindx_scrt + 1
1641 indx_scrt(nindx_scrt) = n
1642 ENDIF
1643 ENDDO
1644 ELSE
1645 DO k=1, nsn0
1646 n=intbuf_tab%NSV(k)
1647 IF( (nodlocal(n)/=0.AND.nodlocal( n )<=numnod_l)
1648 + .AND.tag_scratch(n)==0) THEN
1649 cnsn_l = cnsn_l+1
1650 tag_node_2ry(cnsn_l) = k
1651 tag_scratch(n)=1
1652 nindx_scrt = nindx_scrt + 1
1653 indx_scrt(nindx_scrt) = n
1654 ENDIF
1655 ENDDO
1656 DO k=nsn0+1, nsn0 + nsn_ige ! Specifique surface IGEO
1657 n=intbuf_tab%NSV(k)
1658 IF(tag_scratch(n)==0) THEN
1659 cnsn_l = cnsn_l+1
1660 tag_node_2ry(cnsn_l) = k
1661 tag_scratch(n)=1
1662 nindx_scrt = nindx_scrt + 1
1663 indx_scrt(nindx_scrt) = n
1664 ENDIF
1665 ENDDO
1666 ENDIF
1667 !reflush to zero only part of TAG_SCRATCH that has been used
1668#include "vectorize.inc"
1669 DO k=1,nindx_scrt
1670 n = indx_scrt(k)
1671 tag_scratch(n) = 0
1672 ENDDO
1673 nindx_scrt = 0
1674
1675! prepare SPLIT_NRTM_R
1676 cnrtm_l = 0
1677 cnmn_l = 0
1678 DO k=1,nrtm
1679 IF(intercep%P(k)==proc+1)THEN
1680 n1 = intbuf_tab%IRECTM(4*(k-1)+1)
1681 n2 = intbuf_tab%IRECTM(4*(k-1)+2)
1682 n3 = intbuf_tab%IRECTM(4*(k-1)+3)
1683 n4 = intbuf_tab%IRECTM(4*(k-1)+4)
1684
1685 cnrtm_l = cnrtm_l + 1
1686 tag_segm(cnrtm_l) = k
1687 tag_segm2(k) = cnrtm_l
1688 IF(tag_nm(n1)==0)THEN
1689 tag_nm(n1)=1
1690 cnmn_l = cnmn_l +1
1691 ! modif specific
1692 i710xsav(cnmn_l) = n1
1693 nindx_nm = nindx_nm + 1
1694 indx_nm(nindx_nm) = n1
1695 ENDIF
1696 IF(tag_nm(n2)==0)THEN
1697 tag_nm(n2)=1
1698 cnmn_l = cnmn_l +1
1699 i710xsav(cnmn_l) = n2
1700 nindx_nm = nindx_nm + 1
1701 indx_nm(nindx_nm) = n2
1702 ENDIF
1703 IF(tag_nm(n3)==0)THEN
1704 tag_nm(n3)=1
1705 cnmn_l = cnmn_l +1
1706 i710xsav(cnmn_l) = n3
1707 nindx_nm = nindx_nm + 1
1708 indx_nm(nindx_nm) = n3
1709 ENDIF
1710 IF(tag_nm(n4)==0)THEN
1711 tag_nm(n4)=1
1712 cnmn_l = cnmn_l +1
1713 i710xsav(cnmn_l) = n4
1714 nindx_nm = nindx_nm + 1
1715 indx_nm(nindx_nm) = n4
1716 ENDIF
1717 ENDIF
1718 ENDDO
1719
1720 cnmn_l = 0
1721 DO i=1,nmn
1722 n = intbuf_tab%MSR(i)
1723 IF(tag_nm(n)==1)THEN
1724 cnmn_l = cnmn_l + 1
1725 tag_node_msr(cnmn_l) = i
1726 ENDIF
1727 ENDDO
1728
1729 RETURN
1730 END
1731!||====================================================================
1732!|| split_cand_i7 ../starter/source/restart/ddsplit/inter_tools.F
1733!||--- called by ------------------------------------------------------
1734!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
1735!||--- calls -----------------------------------------------------
1736!|| ancmsg ../starter/source/output/message/message.F
1737!|| nlocal ../starter/source/spmd/node/ddtools.F
1738!|| plist_ifront ../starter/source/spmd/node/ddtools.F
1739!||--- uses -----------------------------------------------------
1740!|| message_mod ../starter/share/message_module/message_mod.F
1741!||====================================================================
1742 SUBROUTINE split_cand_i7(PROC , INTBUF_TAB, NSN , NSN_L ,
1743 . TAG_SEGM2, II_STOK , MULTIMP, NCONT ,
1744 . NOINT , INACTI , TAG_SCRATCH ,
1745 . II_STOK_L, ITYP ,NINDX_SCRT,INDX_SCRT , NODLOCAL,
1746 . NUMNOD_L,NUMNOD,NUMELS,LEN_CEP,CEP,TYPE18_LAW151)
1747C-----------------------------------------------
1748C M o d u l e s
1749C-----------------------------------------------
1750 USE message_mod
1751 USE intbufdef_mod
1752C-----------------------------------------------
1753C I m p l i c i t T y p e s
1754C-----------------------------------------------
1755#include "implicit_f.inc"
1756C-----------------------------------------------
1757C C o m m o n B l o c k s
1758C-----------------------------------------------
1759#include "com01_c.inc"
1760C-----------------------------------------------
1761C D u m m y A r g u m e n t s
1762C-----------------------------------------------
1763 INTEGER PROC,NSN,NSN_L,II_STOK,MULTIMP,NCONT,
1764 . tag_segm2(*),noint,inacti,
1765 . tag_scratch(*) , ii_stok_l, ityp
1766 INTEGER, INTENT(IN) :: NUMNOD_L !< number of node of the current proc
1767 INTEGER, INTENT(INOUT) :: NINDX_SCRT
1768 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_SCRT
1769 INTEGER, DIMENSION(*), INTENT(IN) :: NODLOCAL
1770 INTEGER, INTENT(IN) :: NUMNOD !< total number of node
1771 INTEGER, INTENT(in) :: NUMELS !< number of solid element
1772 INTEGER, INTENT(in) :: LEN_CEP !< size of CEP array
1773 INTEGER, DIMENSION(LEN_CEP), INTENT(in) :: CEP !< element -> proc connectivity array
1774 LOGICAL, INTENT(in) :: TYPE18_LAW151
1775 TYPE(INTBUF_STRUCT_) :: INTBUF_TAB
1776! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
1777! INDX_SCRT : size = NUMNOD + NUMELS + I24MAXNSNE2
1778! index of non-zero TAG_XXX value
1779! used for optimize the initialization
1780! of TAG_XXX array (XXX = NM or SCRT for SCRATCH)
1781! allocated array in lectur and threadprivate array
1782! NINDX_SCRT : number of non-zero TAG_XXX value
1783! TAG_SCRATCH : size = NUMNOD + NUMELS + I24MAXNSNE2
1784! array used to tag an element for
1785! a given interface ; allocated in lectur
1786! allocated array in lectur and threadprivate array
1787! nodlocal : integer, dimension=numnod
1788! gives the local ID of a global element
1789! --> used here to avoid NLOCAL call (the NLOCAL perf is bad)
1790! nodlocal /= 0 if the element is on the current domain/processor
1791! and =0 if the element is not on the current domain
1792! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
1793C-----------------------------------------------
1794C F u n c t i o n
1795C-----------------------------------------------
1796 INTEGER NLOCAL
1797 EXTERNAL NLOCAL
1798C-----------------------------------------------
1799C L o c a l V a r i a b l e s
1800C-----------------------------------------------
1801 INTEGER I,J,K,N,P,E,MULTOK,MSGID,
1802 . SPLIST,C_NSNR,MY_NODE
1803 INTEGER NUMP(NSPMD),WORK(70000)
1804
1805 INTEGER, DIMENSION(:),ALLOCATABLE ::
1806 . IBUF_E,IBUF_N,NSNLOCAL,CPULOCAL,CANDR,PLIST,
1807 . INDEX
1808
1809 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ITRI
1810C ----------------------------------------
1811 ALLOCATE(ibuf_e(multimp*ncont),ibuf_n(multimp*ncont))
1812 ibuf_e(1:multimp*ncont) = 0
1813 ibuf_n(1:multimp*ncont) = 0
1814 ii_stok_l = 0 !mandatory in case of inacti ne 5,6,7
1815
1816 IF(ityp==23.OR.inacti==5.OR.inacti==6.OR.inacti==7) THEN
1817 IF(nsn>0) THEN
1818 ALLOCATE(nsnlocal(nsn))
1819 ALLOCATE(cpulocal(nsn))
1820 ALLOCATE(candr(nsn))
1821 END IF
1822 nump(1:nspmd) = 0
1823
1824 ALLOCATE(plist(nspmd))
1825 plist(1:nspmd) = -1
1826 DO k=1,nsn
1827 n = intbuf_tab%NSV(k)
1828c IF(N>NUMNOD) CYCLE
1829 nsnlocal(k) = 0
1830 IF(tag_scratch(n)==0) THEN
1831 splist=0
1832 ! ---------------------
1833 ! law151 + interface type 18 : N is a brick id N € [1;NUMELS]
1834 !
1835 IF(type18_law151) THEN
1836 p = cep(n) + 1
1837 nump(p) = nump(p)+1
1838 IF(p==proc+1) THEN
1839 nsnlocal(k) = nump(p)
1840 cpulocal(k) = p
1841 ENDIF
1842 ! ---------------------
1843 ! other kind of interface : N is a node id N € [1;NUMNOD]
1844 ELSE
1845 CALL plist_ifront(plist,n,splist)
1846 DO i=1,splist
1847 p=plist(i)
1848 nump(p) = nump(p)+1
1849 ENDDO
1850 IF( nodlocal(n)/=0.AND.nodlocal(n)<=numnod_l ) THEN
1851 nsnlocal(k) = nump(proc+1)
1852 cpulocal(k) = proc+1
1853 ELSE
1854 p=plist(1)
1855 nsnlocal(k) = nump(p)
1856 cpulocal(k) = p
1857 ENDIF
1858 ENDIF
1859 ! ---------------------
1860 tag_scratch(n) = 1
1861 nindx_scrt = nindx_scrt + 1
1862 indx_scrt(nindx_scrt) = n
1863 ENDIF
1864 ENDDO
1865 DEALLOCATE(plist)
1866
1867 !reflush TAG_SCRATCH to zero only when value has changes
1868#include "vectorize.inc"
1869 DO k=1,nindx_scrt
1870 n = indx_scrt(k)
1871 tag_scratch(n) = 0
1872 ENDDO
1873 nindx_scrt = 0
1874C
1875C Reperage des candidats se trouvant sur des procs distants
1876C
1877 c_nsnr = 0
1878
1879 DO k = 1, ii_stok
1880 e = intbuf_tab%CAND_E(k)
1881 IF (tag_segm2(e)/=0) THEN
1882 n = intbuf_tab%CAND_N(k)
1883 IF(tag_scratch(n)==0) THEN
1884 tag_scratch(n) = 1
1885 nindx_scrt = nindx_scrt + 1
1886 indx_scrt(nindx_scrt) = n
1887 my_node = intbuf_tab%NSV(n)
1888c IF(INTBUF_TAB%NSV(N)>NUMNOD) CYCLE
1889 IF(type18_law151) THEN
1890 IF(cep(my_node)/=proc) THEN
1891 c_nsnr = c_nsnr + 1
1892 candr(c_nsnr) = n
1893 ENDIF
1894 ELSE
1895 IF( nodlocal( my_node )==0.OR.nodlocal(my_node)>numnod_l ) THEN
1896 c_nsnr = c_nsnr + 1
1897 candr(c_nsnr) = n
1898 END IF
1899 ENDIF
1900 END IF
1901 ENDIF
1902 ENDDO
1903
1904 !reflush TAG_SCRATCH to zero only when value has changes
1905! DO K=1, II_STOK
1906! E = INTBUF_TAB%CAND_E(K)
1907! IF (TAG_SEGM2(E)/=0) THEN
1908! N = INTBUF_TAB%CAND_N(K)
1909! TAG_SCRATCH(N) = 0
1910! ENDIF
1911! ENDDO
1912#include "vectorize.inc"
1913 DO k=1,nindx_scrt
1914 n = indx_scrt(k)
1915 tag_scratch(n) = 0
1916 ENDDO
1917 nindx_scrt = 0
1918C
1919C Tris des candidats remote par proc et par nsv local croissant
1920C
1921 IF(c_nsnr>0) THEN
1922 ALLOCATE(index(2*c_nsnr))
1923 ALLOCATE(itri(2,c_nsnr))
1924 END IF
1925 DO i = 1, c_nsnr
1926 n = candr(i)
1927 itri(1,i) = cpulocal(n)
1928 itri(2,i) = nsnlocal(n)
1929 ENDDO
1930 CALL my_orders(0,work,itri,index,c_nsnr,2)
1931C
1932 DO i = 1, c_nsnr
1933 index(c_nsnr+index(i)) = i
1934 ENDDO
1935 DO i = 1, c_nsnr
1936 index(i)=index(c_nsnr+i)
1937 ENDDO
1938C
1939 ii_stok_l = 0
1940
1941 c_nsnr = 0
1942 DO k = 1, ii_stok
1943 e = intbuf_tab%CAND_E(k)
1944 IF (tag_segm2(e)/=0) THEN
1945 ii_stok_l = ii_stok_l + 1
1946 END IF
1947 END DO
1948
1949 IF(ii_stok_l>multimp*ncont)THEN
1950 multok= ii_stok_l/ncont
1951 CALL ancmsg(msgid=626,
1952 . msgtype=msgerror,
1953 . anmode=aninfo,
1954 . i1=multok,
1955 . i2=noint)
1956 ELSE
1957 ii_stok_l = 0
1958C
1959 DO k = 1, ii_stok
1960 e = intbuf_tab%CAND_E(k)
1961 IF (tag_segm2(e)/=0) THEN
1962 n = intbuf_tab%CAND_N(k)
1963 ii_stok_l = ii_stok_l + 1
1964 ibuf_e(ii_stok_l)=tag_segm2(e)
1965c IF(INTBUF_TAB%NSV(N)>NUMNOD) CYCLE
1966 my_node = intbuf_tab%NSV(n)
1967 IF( nodlocal( my_node )/=0.AND.nodlocal(my_node)<=numnod_l ) THEN
1968 ibuf_n(ii_stok_l)=nsnlocal(n)
1969 ELSE
1970C noeud remote : numerotation pre calculee ci-dessus
1971c IF(TAG(N)==0) THEN
1972 IF(tag_scratch(n)==0) THEN
1973 c_nsnr = c_nsnr + 1
1974 ibuf_n(ii_stok_l)=index(c_nsnr)+nsn_l
1975 tag_scratch(n) = index(c_nsnr)+nsn_l
1976 nindx_scrt = nindx_scrt + 1
1977 indx_scrt(nindx_scrt) = n
1978 ELSE
1979 ibuf_n(ii_stok_l) = tag_scratch(n)
1980 END IF ! TAG(N)==0
1981 END IF ! NODLOCAL/=0
1982 ENDIF !TAG_SEGM_2(E)/=0
1983 ENDDO !K = 1, II_STOK
1984 END IF !ii_stok_l>multimp*ncont
1985
1986 !reflush TAG_SCRATCH to zero only when value has changes
1987! DO K=1, II_STOK
1988! E = INTBUF_TAB%CAND_E(K)
1989! IF (TAG_SEGM2(E)/=0) THEN
1990! N = INTBUF_TAB%CAND_N(K)
1991! TAG_SCRATCH(N) = 0
1992! ENDIF
1993! ENDDO
1994#include "vectorize.inc"
1995 DO k=1,nindx_scrt
1996 n = indx_scrt(k)
1997 tag_scratch(n) = 0
1998 ENDDO
1999 nindx_scrt = 0
2000
2001 IF(nsn>0) DEALLOCATE(nsnlocal,cpulocal,candr)
2002 IF(c_nsnr>0) DEALLOCATE(index,itri)
2003
2004c IF(ITYP==23.OR.INACTI==5.OR.INACTI==6.OR.INACTI==7.
2005c . OR.IFQ>0)IPARI_L(24,NI)= C_NRTSR
2006
2007 ENDIF !END INACTI=5,6,7
2008
2009 CALL write_i_c(ibuf_e,multimp*ncont)
2010 CALL write_i_c(ibuf_n,multimp*ncont)
2011
2012 DEALLOCATE(ibuf_e,ibuf_n)
2013
2014 RETURN
2015 END
2016!||====================================================================
2017!|| split_remnode_i7 ../starter/source/restart/ddsplit/inter_tools.F
2018!||--- called by ------------------------------------------------------
2019!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
2020!||--- calls -----------------------------------------------------
2021!||--- uses -----------------------------------------------------
2022!|| message_mod ../starter/share/message_module/message_mod.F
2023!||====================================================================
2024 SUBROUTINE split_remnode_i7(PROC , INTBUF_TAB, NRTM , NRTM_L,
2025 . TAG_SEGM2, NREMNODE , NODLOCAL, ITAB ,NUMNOD_L)
2026C-----------------------------------------------
2027C M o d u l e s
2028C-----------------------------------------------
2029 USE message_mod
2030 USE intbufdef_mod
2031C-----------------------------------------------
2032C I m p l i c i t T y p e s
2033C-----------------------------------------------
2034#include "implicit_f.inc"
2035C-----------------------------------------------
2036C C o m m o n B l o c k s
2037C-----------------------------------------------
2038#include "com04_c.inc"
2039C-----------------------------------------------
2040C D u m m y A r g u m e n t s
2041C-----------------------------------------------
2042 INTEGER PROC,NRTM,NRTM_L,
2043 . tag_segm2(*),nremnode,nodlocal(*),
2044 . itab(*)
2045 INTEGER, DIMENSION(:),ALLOCATABLE ::
2046 . SIZ_TMP
2047 INTEGER, INTENT(IN) :: NUMNOD_L
2048
2049 TYPE(INTBUF_STRUCT_) :: INTBUF_TAB
2050! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
2051! NODLOCAL : integer, dimension=NUMNOD
2052! gives the local ID of a global element
2053! --> used here to avoid NLOCAL call (the NLOCAL perf is bad)
2054! NODLOCAL /= 0 if the element is on the current domain/processor
2055! and =0 if the element is not on the current domain
2056! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
2057C-----------------------------------------------
2058C F u n c t i o n
2059C-----------------------------------------------
2060! INTEGER NLOCAL
2061! EXTERNAL NLOCAL
2062C-----------------------------------------------
2063C L o c a l V a r i a b l e s
2064C-----------------------------------------------
2065 INTEGER I,J,K,SIZ,
2066 . L,SIZ1,SIZ2,M,N
2067
2068 INTEGER, DIMENSION(:),ALLOCATABLE ::
2069 . IBUF1,IBUF2,NODDEL,NODDELREMOTE
2070C ----------------------------------------
2071 ALLOCATE(SIZ_TMP(NRTM),NODDEL(NUMNOD),
2072 . NODDELREMOTE(NUMNOD))
2073
2074 ALLOCATE(IBUF1(2*(NRTM_L + 1)), IBUF2(NREMNODE))
2075 IBUF1(1:2*(NRTM_L+1)) = 0
2076 ibuf2(1:nremnode) = 0
2077
2078 siz_tmp(1:nrtm) = 0
2079
2080 DO k=1,nrtm
2081 IF(tag_segm2(k) /= 0)THEN
2082 siz_tmp(tag_segm2(k)) = intbuf_tab%KREMNODE(k+1)
2083 . -intbuf_tab%KREMNODE(k)
2084 ENDIF
2085 END DO
2086
2087 ibuf1(1) = 0
2088
2089 noddel(1:numnod) = 0
2090 noddelremote(1:numnod) = 0
2091 siz1 = 0
2092 siz2 = 0
2093 DO k=1,nrtm
2094 IF(tag_segm2(k) /= 0)THEN
2095
2096 siz = siz_tmp(tag_segm2(k))
2097 ibuf1(1+2*tag_segm2(k)) =ibuf1(1+2*(tag_segm2(k)-1)) + siz
2098
2099 l=intbuf_tab%KREMNODE(k)
2100 siz1 = 0
2101 siz2 = 0
2102 DO m=1,siz
2103 n = intbuf_tab%REMNODE(l+m)
2104 IF( nodlocal(n) /=0.AND.nodlocal(n)<=numnod_l) THEN
2105 noddel(siz1+1) = nodlocal(n)
2106 siz1 = siz1+1
2107 ENDIF
2108 ENDDO
2109 DO m=1,siz
2110 n = intbuf_tab%REMNODE(l+m)
2111 IF( nodlocal( n) ==0.OR.nodlocal(n)>numnod_l) THEN
2112 noddelremote(siz2+1) = itab(n)
2113 siz2 = siz2+1
2114 ENDIF
2115 ENDDO
2116 l=ibuf1(1+2*(tag_segm2(k)-1))
2117 DO m=1,siz1
2118 ibuf2(1+l+m-1)= noddel(m)
2119 ENDDO
2120 ibuf1(1+2*(tag_segm2(k)-1)+1) = l + siz1
2121 l=ibuf1(1+2*(tag_segm2(k)-1)+1)
2122 DO m=1,siz2
2123 ibuf2(1+l+m-1) = - noddelremote(m)
2124 ENDDO
2125 ENDIF
2126 DO m=1,siz1
2127 noddel(m) = 0
2128 ENDDO
2129 DO m=1,siz2
2130 noddelremote(m) = 0
2131 ENDDO
2132 ENDDO
2133
2134 DEALLOCATE(siz_tmp,noddel,noddelremote)
2135
2136 CALL write_i_c(ibuf1,2*(nrtm_l + 1))
2137 CALL write_i_c(ibuf2,nremnode)
2138
2139 DEALLOCATE(ibuf1, ibuf2)
2140
2141 RETURN
2142 END
2143!||====================================================================
2144!|| prepare_split_cand_i25_edge ../starter/source/restart/ddsplit/inter_tools.F
2145!||--- called by ------------------------------------------------------
2146!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
2147!||--- uses -----------------------------------------------------
2148!||====================================================================
2149 SUBROUTINE prepare_split_cand_i25_edge(INTBUF_TAB,SEGLOC,
2150 . TAG_EDGE, NEDGE_L, TAG_EDGE2, NEDGE,
2151 . II_STOK_E, II_STOK_E_L, TAG_II_E2E,
2152 . II_STOK_S, II_STOK_S_L, TAG_II_E2S,
2153 . PROC , FLAGREMNODE, IREMI2 ,
2154 . NRTM , TAG_JJ_E2E , TAG_JJ_E2S)
2155
2156C-----------------------------------------------
2157C M o d u l e s
2158C-----------------------------------------------
2159 USE intbufdef_mod
2160C-----------------------------------------------
2161C I m p l i c i t T y p e s
2162C-----------------------------------------------
2163#include "implicit_f.inc"
2164C-----------------------------------------------
2165C C o m m o n B l o c k s
2166C-----------------------------------------------
2167#include "assert.inc"
2168#include "param_c.inc"
2169C-----------------------------------------------
2170C D u m m y A r g u m e n t s
2171C-----------------------------------------------
2172 INTEGER :: NEDGE,NEDGE_L ! number of edges
2173 INTEGER :: TAG_EDGE(NEDGE_L), TAG_EDGE2(NEDGE)
2174 INTEGER :: SEGLOC(*) ! global to local id of segment
2175 INTEGER :: TAG_II_E2E(*) !local id of global E2E cand (OUT)
2176 INTEGER :: TAG_II_E2S(*) !local id of global E2S cand (OUT)
2177 INTEGER :: II_STOK_E, II_STOK_E_L
2178 INTEGER :: II_STOK_S, II_STOK_S_L
2179 INTEGER :: PROC, IREMI2, FLAGREMNODE, NRTM
2180 INTEGER :: TAG_JJ_E2E(*) !Global id of global E2E cand (OUT)
2181 INTEGER :: TAG_JJ_E2S(*) !Global id of global E2S cand (OUT)
2182
2183 TYPE(INTBUF_STRUCT_) :: INTBUF_TAB
2184C-----------------------------------------------
2185C L o c a l V a r i a b l e s
2186C-----------------------------------------------
2187 INTEGER :: I,J,K,L,M,N1,N2,JJ
2188 INTEGER :: ID,E1,E2,K1,K2
2189 INTEGER :: NB_FREE_EDGES ! number of free edges
2190 INTEGER :: NB_INTERNAL_EDGES ! number of edges internal to the domain
2191 INTEGER :: NB_BOUNDARY_EDGES_LOCAL ! boundary edges treated by current domain
2192 INTEGER :: NB_BOUNDARY_EDGES_REMOTE ! boundary edges treated by the other domain
2193 INTEGER, DIMENSION(:),ALLOCATABLE :: KCANDMS,ICANDMS,CANDMS
2194 INTEGER, DIMENSION(:),ALLOCATABLE :: TAGREMCAND_E2E, TAGREMCAND_E2S ! tabs to tag edges to be deactivated
2195C ----------------------------------------
2196
2197! prepare split candidates
2198 tag_ii_e2s(1:ii_stok_s) = 0
2199 tag_ii_e2e(1:ii_stok_e) = 0
2200 tag_jj_e2s(1:ii_stok_s) = 0
2201 tag_jj_e2e(1:ii_stok_e) = 0
2202
2203 id = 1
2204 nb_free_edges = 0
2205C FREE EDGES
2206 DO i=1, nedge
2207 e1=intbuf_tab%LEDGE(1+(i-1)*nledge)
2208 k1=segloc(e1)
2209 e2=intbuf_tab%LEDGE(3+(i-1)*nledge)
2210 IF(e2/=0)THEN
2211! not free edge
2212 k2=segloc(e2)
2213 ELSE
2214! Free edge
2215 k2=-1
2216 END IF
2217 IF( k1 > 0 .AND. k2 == -1) THEN
2218 nb_free_edges = nb_free_edges + 1
2219! Internal edge
2220 tag_edge(id) = i
2221 id = id + 1
2222 ENDIF
2223 ENDDO
2224
2225C INTERNAL EDGES
2226 nb_internal_edges = 0
2227 DO i=1, nedge
2228 e1=intbuf_tab%LEDGE(1+(i-1)*nledge)
2229 k1=segloc(e1)
2230 e2=intbuf_tab%LEDGE(3+(i-1)*nledge)
2231 IF(e2/=0)THEN
2232! not free edge
2233 k2=segloc(e2)
2234 ELSE
2235! Free edge
2236 k2=-1
2237 END IF
2238 IF( k1 > 0 .AND. k2 > 0) THEN
2239 nb_internal_edges = nb_internal_edges + 1
2240! Internal edge
2241 tag_edge(id) = i
2242 id = id + 1
2243 ENDIF
2244 ENDDO
2245
2246 nb_boundary_edges_local = 0
2247 DO i=1, nedge
2248 e1=intbuf_tab%LEDGE(1+(i-1)*nledge)
2249 k1=segloc(e1)
2250 e2=intbuf_tab%LEDGE(3+(i-1)*nledge)
2251 IF(e2/=0)THEN
2252! not free edge
2253 k2=segloc(e2)
2254 ELSE
2255! Free edge
2256 k2=-1
2257 END IF
2258 IF( k1 > 0 .AND. k2 == 0) THEN
2259 nb_boundary_edges_local = nb_boundary_edges_local + 1
2260 tag_edge(id) = i
2261 id = id + 1
2262 ENDIF
2263 ENDDO
2264
2265 nb_boundary_edges_remote = 0
2266 DO i=1, nedge
2267 e1=intbuf_tab%LEDGE(1+(i-1)*nledge)
2268 k1=segloc(e1)
2269 e2=intbuf_tab%LEDGE(3+(i-1)*nledge)
2270 IF(e2/=0)THEN
2271! not free edge
2272 k2=segloc(e2)
2273 ELSE
2274! Free edge
2275 k2=-1
2276 END IF
2277 IF( k1 == 0 .AND. k2 > 0) THEN
2278 nb_boundary_edges_remote = nb_boundary_edges_remote + 1
2279 tag_edge(id) = i
2280 id = id + 1
2281 ENDIF
2282 ENDDO
2283
2284
2285 i = nb_free_edges + nb_internal_edges + nb_boundary_edges_remote+nb_boundary_edges_local
2286 assert(i == nedge_l)
2287 id = 1
2288 tag_edge2(1:nedge) = 0
2289 DO i=1, nedge_l
2290 tag_edge2(tag_edge(i)) = i
2291C TAG_EDGE2(global id ) = local id
2292 ENDDO
2293
2294C------IREMI2 OPTION : deleting couples already defined in tied contact-------
2295
2296 ALLOCATE(tagremcand_e2e(ii_stok_e))
2297
2298 tagremcand_e2e(1:ii_stok_e) = 0
2299 IF(iremi2==1.AND.flagremnode==2) THEN
2300 ! connectivity edge > contact pairs
2301
2302 ALLOCATE(kcandms(nedge+1))
2303 ALLOCATE(icandms(nedge+1))
2304 ALLOCATE(candms(ii_stok_e))
2305 kcandms(1:nedge+1) = 0
2306 icandms(1:nedge+1) = 0
2307 candms(1:ii_stok_e) = 0
2308
2309 DO i = 1, ii_stok_e
2310 e1 = intbuf_tab%CANDM_E2E(i)
2311 kcandms(e1) =kcandms(e1)+1
2312 ENDDO
2313 icandms(1) = 1
2314 DO i=1,nedge
2315 icandms(i+1) = icandms(i) +kcandms(i)
2316 ENDDO
2317 kcandms(1:nedge+1) = icandms(1:nedge+1)
2318
2319 DO i=1,ii_stok_e
2320 e1 = intbuf_tab%CANDM_E2E(i)
2321 candms(kcandms(e1)) = i
2322 kcandms(e1) = kcandms(e1) + 1
2323 END DO
2324
2325 DO i=1,nedge
2326 k = intbuf_tab%KREMNODE_EDG(i)
2327 l = intbuf_tab%KREMNODE_EDG(i+1)-1
2328 DO j=icandms(i),icandms(i+1)-1
2329 DO m=k,l
2330 IF(intbuf_tab%CANDS_E2E(candms(j))== intbuf_tab%REMNODE_EDG(m))
2331 . tagremcand_e2e(candms(j)) = 1
2332 ENDDO
2333 ENDDO
2334 ENDDO
2335 DEALLOCATE(kcandms,icandms,candms)
2336 ENDIF
2337
2338 ii_stok_e_l = 0
2339 jj= 0
2340C local numbering of E2E candidates
2341 DO i = 1, ii_stok_e
2342 e1 =intbuf_tab%CANDM_E2E(i)
2343 e2 =intbuf_tab%CANDS_E2E(i)
2344 IF(tag_edge2( intbuf_tab%CANDM_E2E(i)) > 0) THEN
2345 ! master edge is on this processor
2346 id = intbuf_tab%CANDM_E2E(i)
2347 IF( intbuf_tab%LEDGE(9+(id-1)*nledge) == proc ) THEN
2348 jj= jj + 1
2349 tag_jj_e2e(i) = jj
2350 IF(tagremcand_e2e(i)==0) THEN ! cand deleted IremI2
2351C master edge is owned by this processor
2352C master edge is local
2353C Slave is local
2354 ii_stok_e_l = ii_stok_e_l + 1
2355 tag_ii_e2e(ii_stok_e_l) = i
2356 ENDIF
2357 ENDIF
2358 ENDIF
2359 ENDDO
2360
2361
2362C------IREMI2 OPTION : deleting couples already defined in tied contact-------
2363
2364 ALLOCATE(tagremcand_e2s(ii_stok_s))
2365
2366 tagremcand_e2s(1:ii_stok_s) = 0
2367 IF(iremi2==1.AND.flagremnode==2.AND.ii_stok_s > 0) THEN
2368
2369 ! connectivity NRTM > contact pairs
2370
2371 ALLOCATE(kcandms(nrtm+1))
2372 ALLOCATE(icandms(nrtm+1))
2373 ALLOCATE(candms(ii_stok_s))
2374 kcandms(1:nrtm+1) = 0
2375 icandms(1:nrtm+1) = 0
2376 candms(1:ii_stok_s) = 0
2377
2378 DO i = 1, ii_stok_s
2379 e1 = intbuf_tab%CANDM_E2S(i)
2380 kcandms(e1) =kcandms(e1)+1
2381 ENDDO
2382 icandms(1) = 1
2383 DO i=1,nrtm
2384 icandms(i+1) = icandms(i) +kcandms(i)
2385 ENDDO
2386 kcandms(1:nrtm+1) = icandms(1:nrtm+1)
2387
2388 DO i=1,ii_stok_s
2389 e1 = intbuf_tab%CANDM_E2S(i)
2390 candms(kcandms(e1)) = i
2391 kcandms(e1) = kcandms(e1) + 1
2392 END DO
2393
2394 DO i=1,nrtm
2395 k = intbuf_tab%KREMNODE_E2S(i)
2396 l = intbuf_tab%KREMNODE_E2S(i+1)-1
2397 DO j=icandms(i),icandms(i+1)-1
2398 DO m=k,l
2399 IF(intbuf_tab%CANDS_E2S(candms(j))== intbuf_tab%REMNODE_E2S(m))
2400 . tagremcand_e2s(candms(j)) = 1
2401 ENDDO
2402 ENDDO
2403 ENDDO
2404
2405 DEALLOCATE(kcandms,icandms,candms)
2406
2407 ENDIF
2408
2409 ii_stok_s_l = 0
2410 jj= 0
2411 DO i = 1, ii_stok_s
2412 IF(segloc( intbuf_tab%CANDM_E2S(i)) > 0) THEN
2413 jj= jj + 1
2414 tag_jj_e2s(i) = jj
2415 IF(tagremcand_e2s(i)==0) THEN ! cand deleted IremI2
2416C master sgmt is local
2417 ii_stok_s_l = ii_stok_s_l + 1
2418 tag_ii_e2s(ii_stok_s_l) = i
2419 ENDIF
2420 ENDIF
2421 ENDDO
2422
2423 DEALLOCATE(tagremcand_e2e,tagremcand_e2s)
2424 RETURN
2425 END
2426!||====================================================================
2427!|| split_cand_i25_edge ../starter/source/restart/ddsplit/inter_tools.f
2428!||--- called by ------------------------------------------------------
2429!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
2430!||--- calls -----------------------------------------------------
2431!||--- uses -----------------------------------------------------
2432!|| i25_fie_mod ../starter/share/modules1/i25_fie_mod.F
2433!||====================================================================
2434 SUBROUTINE split_cand_i25_edge(INTBUF_TAB,SEGLOC,PROC,NIN,
2435 . TAG_EDGE, NEDGE_L, TAG_EDGE2, NEDGE,
2436 . II_STOK_E, II_STOK_E_L, TAG_II_E2E,
2437 . II_STOK_S, II_STOK_S_L, TAG_II_E2S,
2438 . TAG_JJ_E2E,TAG_JJ_E2S )
2439
2440C-----------------------------------------------
2441C M o d u l e s
2442C-----------------------------------------------
2443 USE intbufdef_mod
2444 USE i25_fie_mod
2445C-----------------------------------------------
2446C I m p l i c i t T y p e s
2447C-----------------------------------------------
2448#include "implicit_f.inc"
2449C-----------------------------------------------
2450C C o m m o n B l o c k s
2451C-----------------------------------------------
2452#include "param_c.inc"
2453#include "assert.inc"
2454C-----------------------------------------------
2455C D u m m y A r g u m e n t s
2456C-----------------------------------------------
2457 INTEGER :: PROC,NIN
2458 INTEGER :: NEDGE,NEDGE_L ! number of edges
2459 INTEGER :: TAG_EDGE(NEDGE_L), TAG_EDGE2(NEDGE)
2460 INTEGER :: SEGLOC(*) ! global to local id of segment
2461 INTEGER :: TAG_II_E2E(*) !local id of global E2E cand (OUT)
2462 INTEGER :: TAG_II_E2S(*) !local id of global E2S cand (OUT)
2463 INTEGER :: II_STOK_E, II_STOK_E_L
2464 INTEGER :: II_STOK_S, II_STOK_S_L
2465 INTEGER :: TAG_JJ_E2E(II_STOK_E) !Global id of global E2E cand (OUT)
2466 INTEGER :: TAG_JJ_E2S(II_STOK_S) !Global id of global E2S cand (OUT)
2467
2468
2469 TYPE(intbuf_struct_) :: INTBUF_TAB
2470C-----------------------------------------------
2471C L o c a l V a r i a b l e s
2472C-----------------------------------------------
2473 INTEGER :: I,J,K,JJ
2474 INTEGER :: ID,E1,E2,K1,K2
2475 INTEGER, DIMENSION(:), ALLOCATABLE :: CANDM_E2E,CANDS_E2E
2476 INTEGER, DIMENSION(:), ALLOCATABLE :: CANDM_E2S,CANDS_E2S
2477
2478C ----------------------------------------
2479
2480! prepare split candidates
2481 ALLOCATE(candm_e2e(ii_stok_e_l))
2482 ALLOCATE(cands_e2e(ii_stok_e_l))
2483 assert(ii_stok_e_l==i25_split_cand(nin,proc+1)%NB_CAND_E2E)
2484 assert(ii_stok_s_l==i25_split_cand(nin,proc+1)%NB_CAND_E2S)
2485
2486C local numbering of E2E candidates
2487 id = 0
2488 DO j = 1, ii_stok_e_l
2489 i = tag_ii_e2e(j)
2490 jj = tag_jj_e2e(i)
2491 assert(i > 0)
2492C main edge is local
2493 id = id + 1
2494 candm_e2e(id) = tag_edge2(intbuf_tab%CANDM_E2E(i))
2495 IF(intbuf_tab%LEDGE(9+(intbuf_tab%CANDS_E2E(i)-1)*nledge) == proc ) THEN
2496C Secnd is also local
2497 cands_e2e(id) = tag_edge2(intbuf_tab%CANDS_E2E(i))
2498 ELSE
2499C Remote secnd
2500C ASSERT(.FALSE.)
2501C CANDS_E2E(ID) = -INTBUF_TAB%CANDS_E2E(I)
2502 cands_e2e(id) = abs(i25_split_cand(nin,proc+1)%CANDS_E2E(jj)) + nedge_l
2503
2504 ENDIF
2505 ENDDO
2506
2507 ALLOCATE(candm_e2s(ii_stok_s_l))
2508 ALLOCATE(cands_e2s(ii_stok_s_l))
2509C local numbering of E2S candidates
2510 id = 0
2511 assert(ii_stok_s_l == i25_split_cand(nin,proc+1)%NB_CAND_E2S)
2512C WRITE(6,*) PROC,"NBCAND=",II_STOK_S_L,I25_SPLIT_CAND(NIN,PROC+1)%NB_CAND_E2S
2513
2514 DO j = 1, ii_stok_s_l
2515 i = tag_ii_e2s(j)
2516 jj = tag_jj_e2s(i)
2517C main edge is local
2518 assert(i > 0)
2519 id = id + 1
2520 candm_e2s(id) = segloc(intbuf_tab%CANDM_E2S(i))
2521C IF(TAG_EDGE2(INTBUF_TAB%CANDS_E2S(I)) > 0) THEN
2522 IF(intbuf_tab%LEDGE(9+(intbuf_tab%CANDS_E2S(i)-1)*nledge) == proc ) THEN
2523C Secnd is also local
2524 cands_e2s(id) = tag_edge2(intbuf_tab%CANDS_E2S(i))
2525 assert(cands_e2s(id) == i25_split_cand(nin,proc+1)%CANDS_E2S(jj))
2526 ELSE
2527C Remote secnd
2528C ASSERT(.FALSE.)
2529 cands_e2s(id) = abs(i25_split_cand(nin,proc+1)%CANDS_E2S(jj)) + nedge_l
2530C CANDS_E2S(ID) = - INTBUF_TAB%CANDS_E2S(I)
2531 ENDIF
2532 ENDDO
2533
2534 CALL write_i_c(candm_e2e,ii_stok_e_l)
2535 CALL write_i_c(cands_e2e,ii_stok_e_l)
2536 CALL write_i_c(candm_e2s,ii_stok_s_l)
2537 CALL write_i_c(cands_e2s,ii_stok_s_l)
2538 DEALLOCATE(candm_e2e)
2539 DEALLOCATE(cands_e2e)
2540 DEALLOCATE(candm_e2s)
2541 DEALLOCATE(cands_e2s)
2542
2543 RETURN
2544 END
2545
2546!||====================================================================
2547!|| split_remnode_i25 ../starter/source/restart/ddsplit/inter_tools.F
2548!||--- called by ------------------------------------------------------
2549!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
2550!||--- calls -----------------------------------------------------
2551!||--- uses -----------------------------------------------------
2552!|| front_mod ../starter/share/modules1/front_mod.F
2553!|| message_mod ../starter/share/message_module/message_mod.F
2554!||====================================================================
2555 SUBROUTINE split_remnode_i25(PROC , INTBUF_TAB, NRTM , NRTM_L ,
2556 . TAG_SEGM2 , NREMNODE , NODLOCAL ,NREMNOR,
2557 . NSN , NSN_L ,TAG_NODE_2RY2,ITAB,
2558 . NUMNOD_L)
2559C-----------------------------------------------
2560C M o d u l e s
2561C-----------------------------------------------
2562 USE message_mod
2563 USE intbufdef_mod
2564 USE front_mod
2565C-----------------------------------------------
2566C I m p l i c i t T y p e s
2567C-----------------------------------------------
2568#include "implicit_f.inc"
2569C-----------------------------------------------
2570C C o m m o n B l o c k s
2571C-----------------------------------------------
2572#include "com04_c.inc"
2573C-----------------------------------------------
2574C D u m m y A r g u m e n t s
2575C-----------------------------------------------
2576 INTEGER PROC ,NRTM ,NRTM_L ,NSN ,NSN_L ,NREMNOR ,
2577 . TAG_SEGM2(*) ,NREMNODE ,NODLOCAL(*) ,
2578 . TAG_NODE_2RY2(*),ITAB(*)
2579 INTEGER, INTENT(IN) :: NUMNOD_L
2580
2581 TYPE(intbuf_struct_) :: INTBUF_TAB
2582! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
2583! NODLOCAL : integer, dimension=NUMNOD
2584! gives the local ID of a global element
2585! --> used here to avoid NLOCAL call (the NLOCAL perf is bad)
2586! NODLOCAL /= 0 if the element is on the current domain/processor
2587! and =0 if the element is not on the current domain
2588! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
2589C-----------------------------------------------
2590C F u n c t i o n
2591C-----------------------------------------------
2592! INTEGER NLOCAL
2593! EXTERNAL NLOCAL
2594C-----------------------------------------------
2595C L o c a l V a r i a b l e s
2596C-----------------------------------------------
2597 INTEGER I,J,K,SIZ,LL,
2598 . L,SIZ1 ,SIZ2 ,M ,N ,NS
2599
2600 INTEGER, DIMENSION(:),ALLOCATABLE ::
2601 . IBUF1,IBUF2,NODDEL,NODDELREMOTE
2602 INTEGER, DIMENSION(:),ALLOCATABLE ::
2603 . SIZ_TMP
2604C ----------------------------------------
2605 ALLOCATE(siz_tmp(nrtm),noddel(numnod),
2606 . noddelremote(numnod))
2607
2608 ALLOCATE(ibuf1(2*(nrtm_l + 1)), ibuf2(nremnode))
2609 ibuf1(1:2*(nrtm_l+1)) = 0
2610 ibuf2(1:nremnode) = 0
2611
2612 siz_tmp(1:nrtm) = 0
2613
2614 DO k=1,nrtm
2615 IF(tag_segm2(k) /= 0)THEN
2616 siz_tmp(tag_segm2(k)) = intbuf_tab%KREMNODE(k+1)
2617 . -intbuf_tab%KREMNODE(k)
2618 ENDIF
2619 END DO
2620
2621 ibuf1(1) = 0
2622
2623 noddel(1:numnod) = 0
2624 noddelremote(1:numnod) = 0
2625 siz1 = 0
2626 siz2 = 0
2627 DO k=1,nrtm
2628 IF(tag_segm2(k) /= 0)THEN
2629
2630 siz = siz_tmp(tag_segm2(k))
2631 ibuf1(1+2*tag_segm2(k)) =ibuf1(1+2*(tag_segm2(k)-1)) + siz
2632
2633 l=intbuf_tab%KREMNODE(k)
2634 siz1 = 0
2635 siz2 = 0
2636 DO m=1,siz
2637 n = intbuf_tab%REMNODE(l+m)
2638 IF( nodlocal(n)/=0.AND.nodlocal(n)<=numnod_l ) THEN
2639 noddel(siz1+1) = nodlocal(n)
2640 siz1 = siz1+1
2641 ENDIF
2642 ENDDO
2643 DO m=1,siz
2644 n = intbuf_tab%REMNODE(l+m)
2645 IF( nodlocal(n)==0.OR.nodlocal(n)>numnod_l ) THEN
2646 noddelremote(siz2+1) = itab(n)
2647 siz2 = siz2+1
2648 ENDIF
2649 ENDDO
2650 l=ibuf1(1+2*(tag_segm2(k)-1))
2651 DO m=1,siz1
2652 ibuf2(1+l+m-1)= noddel(m)
2653 ENDDO
2654 ibuf1(1+2*(tag_segm2(k)-1)+1) = l + siz1
2655 l=ibuf1(1+2*(tag_segm2(k)-1)+1)
2656 DO m=1,siz2
2657 ibuf2(1+l+m-1) = - noddelremote(m)
2658 ENDDO
2659 ENDIF
2660 DO m=1,siz1
2661 noddel(m) = 0
2662 ENDDO
2663 DO m=1,siz2
2664 noddelremote(m) = 0
2665 ENDDO
2666 ENDDO
2667
2668 DEALLOCATE(siz_tmp,noddel,noddelremote)
2669
2670 CALL write_i_c(ibuf1,2*(nrtm_l + 1))
2671 CALL write_i_c(ibuf2,nremnode)
2672
2673 DEALLOCATE(ibuf1, ibuf2)
2674
2675C----Tab Main segment removed for each secnd node----
2676c 1st : reorganizing the tab : keep only local main segments
2677
2678 ALLOCATE(ibuf1(nsn_l+1),ibuf2(nremnor))
2679
2680 ALLOCATE(noddel(nrtm))
2681
2682 ibuf1(1:nsn_l+1) = 0
2683 ibuf2(1:nremnor) = 0
2684
2685 DO n=1,nsn
2686
2687 ns = tag_node_2ry2(n)
2688 IF(ns /= 0)THEN
2689 siz = intbuf_tab%KREMNOR(n+1)-intbuf_tab%KREMNOR(n)
2690
2691 l=intbuf_tab%KREMNOR(n)
2692 siz1 = 0
2693c
2694 DO m=1,siz
2695 i = intbuf_tab%REMNOR(l+m)
2696 IF(tag_segm2(i)/=0) THEN
2697 noddel(siz1+1) = tag_segm2(i)
2698 siz1 = siz1+1
2699 ENDIF
2700 ENDDO
2701c
2702 l=ibuf1(ns)
2703 DO m=1,siz1
2704 ibuf2(l+m)= noddel(m)
2705 ENDDO
2706 ibuf1(ns+1) = l +siz1
2707
2708 DO m=1,siz1
2709 noddel(m) = 0
2710 ENDDO
2711
2712 ENDIF
2713 ENDDO
2714
2715 DEALLOCATE(noddel)
2716
2717 CALL write_i_c(ibuf1,nsn_l+1)
2718 CALL write_i_c(ibuf2,nremnor)
2719
2720 DEALLOCATE(ibuf1, ibuf2)
2721
2722
2723 RETURN
2724 END
2725!||====================================================================
2726!|| split_nisub_i7 ../starter/source/restart/ddsplit/inter_tools.F
2727!||--- called by ------------------------------------------------------
2728!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
2729!||--- calls -----------------------------------------------------
2730!||--- uses -----------------------------------------------------
2731!|| message_mod ../starter/share/message_module/message_mod.F
2732!||====================================================================
2733 SUBROUTINE split_nisub_i7(INTBUF_TAB, NSN_L , TAG_NODE_2RY, NRTM_L,
2734 . TAG_SEGM , NISUBS, NISUBM )
2735C-----------------------------------------------
2736C M o d u l e s
2737C-----------------------------------------------
2738 USE message_mod
2739 USE intbufdef_mod
2740C-----------------------------------------------
2741C I m p l i c i t T y p e s
2742C-----------------------------------------------
2743#include "implicit_f.inc"
2744C-----------------------------------------------
2745C D u m m y A r g u m e n t s
2746C-----------------------------------------------
2747 INTEGER NSN_L,NRTM_L,NISUBS,NISUBM,
2748 . TAG_NODE_2RY(*),TAG_SEGM(*)
2749
2750 TYPE(intbuf_struct_) :: INTBUF_TAB
2751C-----------------------------------------------
2752C L o c a l V a r i a b l e s
2753C-----------------------------------------------
2754 INTEGER I,J,K,NISUBS_L,NISUBM_L
2755
2756 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF1 !KD(29)
2757 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF2 !KD(30)
2758 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF3 !KD(31)
2759 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF4 !KD(32)
2760 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF5
2761 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF6
2762C ----------------------------------------
2763 ALLOCATE(IBUF1(NSN_L+1))
2764 ALLOCATE(IBUF2(NRTM_L+1))
2765 ALLOCATE(ibuf3(nisubs))
2766 ALLOCATE(ibuf4(nisubm))
2767 ALLOCATE(ibuf5(nisubs))
2768 ALLOCATE(ibuf6(nisubm))
2769
2770
2771 ibuf1(1: nsn_l+1) = 0
2772 ibuf2(1: nrtm_l+1) = 0
2773 ibuf3(1: nisubs) = 0
2774 ibuf4(1: nisubm) = 0
2775 ibuf5(1: nisubs) = 0
2776 ibuf6(1: nisubm) = 0
2777
2778 nisubs_l = 0
2779
2780 DO k=1,nsn_l
2781 ibuf1(k) = nisubs_l + 1
2782 j=tag_node_2ry(k)
2783 DO i = intbuf_tab%ADDSUBS(j),intbuf_tab%ADDSUBS(j+1)-1
2784 ibuf3(1+nisubs_l) = intbuf_tab%LISUBS(i)
2785 IF(intbuf_tab%S_INFLG_SUBS > 0) ibuf5(1+nisubs_l) = intbuf_tab%INFLG_SUBS(i)
2786 nisubs_l = nisubs_l + 1
2787 END DO
2788 END DO
2789
2790 ibuf1(nsn_l+1) = nisubs_l + 1
2791C
2792 nisubm_l = 0
2793 DO k=1,nrtm_l
2794 ibuf2(k) = nisubm_l + 1
2795 j=tag_segm(k)
2796 DO i = intbuf_tab%ADDSUBM(j),
2797 . intbuf_tab%ADDSUBM(j+1)-1
2798 ibuf4(1+nisubm_l) = intbuf_tab%LISUBM(i)
2799 IF(intbuf_tab%S_INFLG_SUBM > 0) ibuf6(1+nisubm_l) = intbuf_tab%INFLG_SUBM(i)
2800 nisubm_l = nisubm_l + 1
2801 END DO
2802 END DO
2803
2804 ibuf2(nrtm_l+1) = nisubm_l + 1
2805
2806 CALL write_i_c(ibuf1,nsn_l+1)
2807 CALL write_i_c(ibuf2,nrtm_l+1)
2808 CALL write_i_c(ibuf3,nisubs)
2809 CALL write_i_c(ibuf4,nisubm)
2810 IF(intbuf_tab%S_INFLG_SUBS > 0) CALL write_i_c(ibuf5,nisubs) !INFLG_SUBS
2811 IF(intbuf_tab%S_INFLG_SUBM > 0) CALL write_i_c(ibuf6,nisubm) !INFLG_SUBM
2812
2813 DEALLOCATE(ibuf1,ibuf2,ibuf3,ibuf4,ibuf5,ibuf6)
2814
2815 RETURN
2816 END
2817!||====================================================================
2818!|| split_nisub_i25 ../starter/source/restart/ddsplit/inter_tools.F
2819!||--- called by ------------------------------------------------------
2820!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
2821!||--- calls -----------------------------------------------------
2822!||--- uses -----------------------------------------------------
2823!|| message_mod ../starter/share/message_module/message_mod.F
2824!||====================================================================
2825 SUBROUTINE split_nisub_i25(INTBUF_TAB, NSN_L , TAG_NODE_2RY, NRTM_L,
2826 1 TAG_SEGM , NISUBS, NISUBM ,
2827 2 IEDGE,
2828 3 NEDGE,
2829 4 NEDGE_L,
2830 5 TAG_EDGE,
2831 6 TAG_EDGE2,
2832 7 NISUBE,
2833 9 PROC)
2834
2835C-----------------------------------------------
2836C M o d u l e s
2837C-----------------------------------------------
2838 USE message_mod
2839 USE intbufdef_mod
2840C-----------------------------------------------
2841C I m p l i c i t T y p e s
2842C-----------------------------------------------
2843#include "implicit_f.inc"
2844C-----------------------------------------------
2845C C o m m o n B l o c k s
2846C-----------------------------------------------
2847#include "param_c.inc"
2848C-----------------------------------------------
2849C D u m m y A r g u m e n t s
2850C-----------------------------------------------
2851 INTEGER NSN_L,NRTM_L,NISUBS,NISUBM,
2852 . TAG_NODE_2RY(*),TAG_SEGM(*)
2853 INTEGER, INTENT(IN) :: IEDGE
2854 INTEGER, INTENT(IN) :: NEDGE
2855 INTEGER, INTENT(IN) :: NEDGE_L
2856 INTEGER, INTENT(IN) :: TAG_EDGE(NEDGE_L) ! Local To global
2857 INTEGER, INTENT(IN) :: TAG_EDGE2(NEDGE) ! Global to local
2858 INTEGER, INTENT(IN) :: NISUBE !local number
2859 INTEGER, INTENT(IN) :: PROC !local number
2860
2861
2862
2863
2864 TYPE(intbuf_struct_) :: INTBUF_TAB
2865C-----------------------------------------------
2866C L o c a l V a r i a b l e s
2867C-----------------------------------------------
2868 INTEGER I,J,K,NISUBS_L,NISUBM_L,NISUBE_L
2869
2870 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF1
2871 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF2
2872 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF3
2873 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF4
2874 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF5
2875 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF6
2876C ----------------------------------------
2877 ALLOCATE(IBUF1(NSN_L+1))
2878 ALLOCATE(IBUF2(NRTM_L+1))
2879 ALLOCATE(IBUF3(NISUBS))
2880 ALLOCATE(IBUF4(NISUBM))
2881 ALLOCATE(IBUF5(NISUBS))
2882 ALLOCATE(IBUF6(NISUBM))
2883
2884 IBUF1(1: NSN_L+1) = 0
2885 ibuf2(1: nrtm_l+1) = 0
2886 ibuf3(1: nisubs) = 0
2887 ibuf4(1: nisubm) = 0
2888 ibuf5(1: nisubs) = 0
2889 ibuf6(1: nisubm) = 0
2890
2891 nisubs_l = 0
2892
2893 DO k=1,nsn_l
2894 ibuf1(k) = nisubs_l + 1
2895 j=tag_node_2ry(k)
2896 DO i = intbuf_tab%ADDSUBS(j),intbuf_tab%ADDSUBS(j+1)-1
2897 ibuf3(1+nisubs_l) = intbuf_tab%LISUBS(i)
2898 ibuf5(1+nisubs_l) = intbuf_tab%INFLG_SUBS(i)
2899 nisubs_l = nisubs_l + 1
2900 END DO
2901 END DO
2902
2903 ibuf1(nsn_l+1) = nisubs_l + 1
2904C
2905 nisubm_l = 0
2906 DO k=1,nrtm_l
2907 ibuf2(k) = nisubm_l + 1
2908 j=tag_segm(k)
2909 DO i = intbuf_tab%ADDSUBM(j),
2910 . intbuf_tab%ADDSUBM(j+1)-1
2911 ibuf4(1+nisubm_l) = intbuf_tab%LISUBM(i)
2912 ibuf6(1+nisubm_l) = intbuf_tab%INFLG_SUBM(i)
2913 nisubm_l = nisubm_l + 1
2914 END DO
2915 END DO
2916
2917 ibuf2(nrtm_l+1) = nisubm_l + 1
2918
2919 CALL write_i_c(ibuf1,nsn_l+1) !ADDSUBS
2920 CALL write_i_c(ibuf2,nrtm_l+1) ! ADDSUBM
2921 CALL write_i_c(ibuf3,nisubs) !LISUBSS
2922 CALL write_i_c(ibuf4,nisubm) !LISUBMI
2923 CALL write_i_c(ibuf5,nisubs) !INFLG_SUBS
2924 CALL write_i_c(ibuf6,nisubm) !INFLG_SUBM
2925
2926 DEALLOCATE(ibuf1,ibuf2,ibuf3,ibuf4,ibuf5,ibuf6)
2927
2928 IF(iedge/=0)THEN ! FAIRE SPMD
2929C CALL COPY_IVAL(INTBUF_TAB(NI)%ADDSUBE,NEDGE+1,1)
2930C CALL COPY_IVAL(INTBUF_TAB(NI)%LISUBE,NISUBE_L,1)
2931C CALL COPY_IVAL(INTBUF_TAB(NI)%INFLG_SUBE,NISUBE_L,1)
2932
2933 ALLOCATE(ibuf1(nedge_l+1))
2934 ALLOCATE(ibuf3(nisube))
2935 ALLOCATE(ibuf5(nisube))
2936
2937 ibuf1(1: nedge_l+1) = 0
2938 ibuf3(1: nisube) = 0
2939 ibuf5(1: nisube) = 0
2940
2941 nisube_l = 0
2942
2943 DO k=1,nedge_l
2944 ibuf1(k) = nisube_l + 1
2945 j=tag_edge(k)
2946 IF(intbuf_tab%LEDGE(nledge*(j-1)+9) == proc ) THEN ! IF current proc own the edge
2947 DO i = intbuf_tab%ADDSUBE(j),intbuf_tab%ADDSUBE(j+1)-1
2948 ibuf3(1+nisube_l) = intbuf_tab%LISUBE(i)
2949 ibuf5(1+nisube_l) = intbuf_tab%INFLG_SUBE(i)
2950 nisube_l = nisube_l + 1
2951 END DO
2952 ENDIF
2953 END DO
2954
2955 ibuf1(nedge_l+1) = nisube_l + 1
2956 CALL write_i_c(ibuf1,nedge_l+1) !ADDSUBE
2957 CALL write_i_c(ibuf3,nisube) !LISUBES
2958 CALL write_i_c(ibuf5,nisube) !INFLG_SUBE
2959 DEALLOCATE(ibuf1)
2960 DEALLOCATE(ibuf3)
2961 DEALLOCATE(ibuf5)
2962 assert(nisube == nisube_l)
2963
2964
2965 END IF
2966
2967
2968 RETURN
2969 END
2970!||====================================================================
2971!|| split_xsav ../starter/source/restart/ddsplit/inter_tools.F
2972!||--- calls -----------------------------------------------------
2973!|| nlocal ../starter/source/spmd/node/ddtools.F
2974!||--- uses -----------------------------------------------------
2975!||====================================================================
2976 SUBROUTINE split_xsav(INTBUF_TAB, NUMNOD_L, NSN, NSN_L,
2977 . NMN , NMN_L , TAG_SCRATCH, TAG_NODE_MSR,
2978 . TAG_NM , NODLOCAL, PROC , NI ,I710XSAV,
2979 . NINDX_SCRT, INDX_SCRT)
2980
2981C-----------------------------------------------
2982C M o d u l e s
2983C-----------------------------------------------
2984 USE intbufdef_mod
2985C-----------------------------------------------
2986C I m p l i c i t T y p e s
2987C-----------------------------------------------
2988#include "implicit_f.inc"
2989C-----------------------------------------------
2990C C o m m o n B l o c k s
2991C-----------------------------------------------
2992#include "com04_c.inc"
2993C-----------------------------------------------
2994C D u m m y A r g u m e n t s
2995C-----------------------------------------------
2996 INTEGER NUMNOD_L,NSN,NSN_L,NMN,
2997 . nmn_l, nod, proc, ni
2998 INTEGER TAG_SCRATCH(*), TAG_NODE_MSR(*),
2999 . tag_nm(*), nodlocal(*)
3000 INTEGER, INTENT(INOUT) :: NINDX_SCRT
3001 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_SCRT
3002
3003 TYPE(intbuf_struct_) :: INTBUF_TAB
3004 INTEGER I710XSAV(*)
3005C-----------------------------------------------
3006C F u n c t i o n
3007C-----------------------------------------------
3008 INTEGER NLOCAL
3009 EXTERNAL NLOCAL
3010C-----------------------------------------------
3011C L o c a l V a r i a b l e s
3012C-----------------------------------------------
3013 INTEGER I,J,K,L,N,N2,NSN_L2,NMN_L2,
3014 . siz_xsav,tag
3015
3016 my_real, DIMENSION(:),ALLOCATABLE :: rbuf
3017C ----------------------------------------
3018
3019 siz_xsav = 3*min(numnod_l,nsn_l+nmn_l)
3020 ALLOCATE(rbuf(siz_xsav))
3021 rbuf(1:siz_xsav) = zero
3022
3023C XSAVE
3024C NSN+NMN < NUMNOD
3025#include "vectorize.inc"
3026 DO k=1,nindx_scrt
3027 n = indx_scrt(k)
3028 tag_scratch(n) = 0
3029 ENDDO
3030 nindx_scrt = 0
3031 IF (nsn+nmn<=numnod)THEN
3032C NSN_L + NMN_L < NUMNOD_L
3033 IF (nsn_l+nmn_l<=numnod_l)THEN
3034C 1ere partie NSN
3035 nsn_l2 = 0
3036! TAG_SCRATCH(1:NUMNOD)=0
3037 DO k=1,nsn
3038 n=intbuf_tab%NSV(k)
3039 IF(nlocal(n,proc+1)==1.AND.
3040 . tag_scratch(n)==0) THEN
3041 rbuf(3*(nsn_l2)+1) =
3042 * intbuf_tab%XSAV(3*(k-1)+1)
3043 rbuf(3*(nsn_l2)+2) =
3044 * intbuf_tab%XSAV(3*(k-1)+2)
3045 rbuf(3*(nsn_l2)+3) =
3046 * intbuf_tab%XSAV(3*(k-1)+3)
3047 nsn_l2 = nsn_l2 + 1
3048 tag_scratch(n)=1
3049 nindx_scrt = nindx_scrt + 1
3050 indx_scrt(nindx_scrt) = n
3051 ENDIF
3052 ENDDO
3053
3054C 2eme partie NMN
3055 DO k=1,nmn
3056 n = intbuf_tab%MSR(k)
3057 IF(nlocal(n,proc+1)==1)THEN
3058 nod = nodlocal(n)
3059 DO l=1,nmn
3060 IF (i710xsav(l)==nod)THEN
3061 rbuf(3*nsn_l+3*(l-1)+1)=
3062 * intbuf_tab%XSAV(3*nsn+3*(k-1)+1)
3063 rbuf(3*nsn_l+3*(l-1)+2)=
3064 * intbuf_tab%XSAV(3*nsn+3*(k-1)+2)
3065 rbuf(3*nsn_l+3*(l-1)+3)=
3066 * intbuf_tab%XSAV(3*nsn+3*(k-1)+3)
3067 GOTO 600
3068 ENDIF
3069 ENDDO
3070 ENDIF
3071 600 CONTINUE
3072 ENDDO
3073
3074 ELSE
3075C NSN_L + NMN_L > NUMNOD_L
3076C 1ere partie NSN
3077 nsn_l2 = 0
3078! TAG_SCRATCH(1:NUMNOD)=0
3079 DO k=1,nsn
3080 n = intbuf_tab%NSV(k)
3081 IF(nlocal(n,proc+1)==1.AND.
3082 . tag_scratch(n)==0) THEN
3083 n2 = nodlocal(n)
3084 rbuf(3*(n2-1)+1) =
3085 * intbuf_tab%XSAV(3*(k-1)+1)
3086 rbuf(3*(n2-1)+2) =
3087 * intbuf_tab%XSAV(3*(k-1)+2)
3088 rbuf(3*(n2-1)+3) =
3089 * intbuf_tab%XSAV(3*(k-1)+3)
3090 nsn_l2 = nsn_l2 + 1
3091 tag_scratch(n)=1
3092 nindx_scrt = nindx_scrt + 1
3093 indx_scrt(nindx_scrt) = n
3094 ENDIF
3095 ENDDO
3096
3097C 2eme partie NMN
3098 nmn_l2 = 0
3099 DO k=1,nmn
3100 n=intbuf_tab%MSR(k)
3101 IF(nlocal(n,proc+1)==1)THEN
3102 n2 = nodlocal(n)
3103 IF (tag_nm(n)==1)THEN
3104 rbuf(3*(n2-1)+1) =
3105 * intbuf_tab%XSAV(3*nsn+3*(k-1)+1)
3106 rbuf(3*(n2-1)+2) =
3107 * intbuf_tab%XSAV(3*nsn+3*(k-1)+2)
3108 rbuf(3*(n2-1)+3) =
3109 * intbuf_tab%XSAV(3*nsn+3*(k-1)+3)
3110 nmn_l2 = nmn_l2 + 1
3111 ENDIF
3112 ENDIF
3113 ENDDO
3114 ENDIF
3115
3116 ELSE
3117C NSN+NMN > NUMNOD
3118 IF(nsn_l+ nmn_l < numnod_l)THEN
3119C NSN_L+NMN_L < NUMNOD_L
3120 nsn_l2 = 0
3121 DO k=1,nsn
3122 n=intbuf_tab%NSV(k)
3123 IF(nlocal(n,proc+1)==1) THEN
3124 n2=nodlocal(n)
3125 rbuf(3*nsn_l2+1) =
3126 * intbuf_tab%XSAV(3*(n-1)+1)
3127 rbuf(3*nsn_l2+2) =
3128 * intbuf_tab%XSAV(3*(n-1)+2)
3129 rbuf(3*nsn_l2+3) =
3130 * intbuf_tab%XSAV(3*(n-1)+3)
3131 nsn_l2 = nsn_l2 + 1
3132 tag_scratch(n)=1
3133 nindx_scrt = nindx_scrt + 1
3134 indx_scrt(nindx_scrt) = n
3135 ENDIF
3136 ENDDO
3137
3138 DO k=1,nmn
3139 n=intbuf_tab%MSR(k)
3140 IF(nlocal(n,proc+1)==1)THEN
3141 nod = nodlocal(n)
3142 DO l=1,nmn
3143c IF (I710SAV(NI)%P(L)==NOD)THEN
3144 tag = tag_node_msr(l)
3145 IF (intbuf_tab%MSR(tag)==nod)THEN
3146 rbuf(3*nsn_l2+3*(l-1)) =
3147 * intbuf_tab%XSAV(3*(n-1)+1)
3148 rbuf(3*nsn_l2+3*(l-1)+1) =
3149 * intbuf_tab%XSAV(3*(n-1)+2)
3150 rbuf(3*nsn_l2+3*(l-1)+2) =
3151 * intbuf_tab%XSAV(3*(n-1)+3)
3152 GOTO 610
3153 ENDIF
3154 ENDDO
3155 ENDIF
3156 610 CONTINUE
3157 ENDDO
3158
3159C NSN_L+NMN_L > NUMNOD_L
3160 ELSE
3161 nsn_l2 = 0
3162 DO k=1,nsn
3163 n=intbuf_tab%NSV(k)
3164 IF(nlocal(n,proc+1)==1) THEN
3165 n2=nodlocal(n)
3166 rbuf(3*(n2-1)+1) = intbuf_tab%XSAV(3*(n-1)+1)
3167 rbuf(3*(n2-1)+2) = intbuf_tab%XSAV(3*(n-1)+2)
3168 rbuf(3*(n2-1)+3) = intbuf_tab%XSAV(3*(n-1)+3)
3169 nsn_l2 = nsn_l2 + 1
3170 tag_scratch(n)=1
3171 nindx_scrt = nindx_scrt + 1
3172 indx_scrt(nindx_scrt) = n
3173 ENDIF
3174 ENDDO
3175
3176 DO k=1,nmn
3177 n=intbuf_tab%MSR(k)
3178 IF(nlocal(n,proc+1)==1)THEN
3179 IF (tag_nm(n)==1)THEN
3180 n2=nodlocal(n)
3181 rbuf(3*(n2-1)+1) =
3182 * intbuf_tab%XSAV(3*(n-1)+1)
3183 rbuf(3*(n2-1)+2) =
3184 * intbuf_tab%XSAV(3*(n-1)+2)
3185 rbuf(3*(n2-1)+3) =
3186 * intbuf_tab%XSAV(3*(n-1)+3)
3187 ENDIF
3188 ENDIF
3189 ENDDO
3190 ENDIF
3191 ENDIF
3192
3193 CALL write_db(rbuf,siz_xsav)
3194
3195
3196 DEALLOCATE(rbuf)
3197
3198 RETURN
3199 END
3200
3201C=======================================================================
3202C END SPECIFIC ROUTINES INT7
3203C=======================================================================
3204
3205C=======================================================================
3206C SPECIFIC ROUTINES INT8
3207C=======================================================================
3208!||====================================================================
3209!|| prepare_split_i8 ../starter/source/restart/ddsplit/inter_tools.F
3210!||--- called by ------------------------------------------------------
3211!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
3212!||--- calls -----------------------------------------------------
3213!|| nlocal ../starter/source/spmd/node/ddtools.F
3214!||--- uses -----------------------------------------------------
3215!|| front_mod ../starter/share/modules1/front_mod.F
3216!||====================================================================
3217 SUBROUTINE prepare_split_i8(PROC , INTBUF_TAB , IPARI ,
3218 . INTERCEP , TAG_NODE_2RY, TAG_SEGM ,
3219 . TAG_SEGM2, TAG_NM , TAG_NODE_MSR,
3220 . TAG_NODE_MSR2,TAG_LMSR,TAG_LMSR2,
3221 . TAG_NSEG,TAG_NSEG2,
3222 . NI,T8,ITAB,NINDX_NM,INDX_NM)
3223C Computes the TAGS used to split the data
3224C Local renumbering of T8%BUFFER ID
3225C-----------------------------------------------
3226C M o d u l e s
3227C-----------------------------------------------
3228 USE intbufdef_mod
3229 USE front_mod
3230 USE int8_mod
3231C-----------------------------------------------
3232C I m p l i c i t T y p e s
3233C-----------------------------------------------
3234#include "implicit_f.inc"
3235C-----------------------------------------------
3236C C o m m o n B l o c k s
3237C-----------------------------------------------
3238#include "com01_c.inc"
3239C-----------------------------------------------
3240C D u m m y A r g u m e n t s
3241C-----------------------------------------------
3242 TYPE(intbuf_struct_) :: INTBUF_TAB
3243 TYPE(INTERSURFP) :: INTERCEP
3244 TYPE(INT8_STRUCT_) :: T8
3245 INTEGER NI,PROC,IPARI(*),
3246 . TAG_NODE_2RY(*),TAG_SEGM(*),TAG_NM(*),TAG_NODE_MSR(*),
3247 . TAG_NODE_MSR2(*),TAG_LMSR(*),TAG_LMSR2(*),
3248 . TAG_NSEG(*),TAG_NSEG2(*),
3249 . TAG_SEGM2(*),ITAB(*)
3250 INTEGER, INTENT(INOUT) :: NINDX_NM
3251 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_NM
3252C-----------------------------------------------
3253C F u n c t i o n
3254C-----------------------------------------------
3255 INTEGER NLOCAL
3256 EXTERNAL NLOCAL
3257C-----------------------------------------------
3258C L o c a l V a r i a b l e s
3259C-----------------------------------------------
3260 INTEGER
3261 . NSN,NRTM,NMN,NMN_L,
3262 . I,J,K,N,N1,N2,N3,N4,P2,
3263 . CNSN_L,CNRTM_L,CNMN_L,CLMSR_L,
3264 . IBEGIN,IEND
3265C ----------------------------------------
3266 NRTM = ipari(4)
3267 nsn = ipari(5)
3268 nmn = ipari(6)
3269
3270 cnsn_l = 0
3271 DO k=1, nsn
3272 n=intbuf_tab%ILOCS(k)
3273 n=intbuf_tab%MSR(n)
3274 IF(nlocal(n,proc+1)==1) THEN
3275 cnsn_l = cnsn_l+1
3276 tag_node_2ry(k) = 1
3277 ENDIF
3278 ENDDO
3279
3280! prepare SPLIT_NRTM_R
3281 cnrtm_l = 0
3282 cnmn_l = 0
3283! already done in split_interface
3284! TAG_NM(1:NUMNOD) = 0
3285 DO k=1,nrtm
3286 n1 = intbuf_tab%IRECTM(4*(k-1)+1)
3287 n2 = intbuf_tab%IRECTM(4*(k-1)+2)
3288 n3 = intbuf_tab%IRECTM(4*(k-1)+3)
3289 n4 = intbuf_tab%IRECTM(4*(k-1)+4)
3290
3291 n1 = intbuf_tab%MSR(n1)
3292 n2 = intbuf_tab%MSR(n2)
3293 n3 = intbuf_tab%MSR(n3)
3294 n4 = intbuf_tab%MSR(n4)
3295
3296 IF(intercep%P(k)==proc+1)THEN
3297 cnrtm_l = cnrtm_l + 1
3298 tag_segm(cnrtm_l) = k
3299 tag_segm2(k) = cnrtm_l
3300 IF(tag_nm(n1)==0)THEN
3301 tag_nm(n1)=1
3302 cnmn_l = cnmn_l +1
3303 nindx_nm = nindx_nm + 1
3304 indx_nm(nindx_nm) = n1
3305 ENDIF
3306 IF(tag_nm(n2)==0)THEN
3307 tag_nm(n2)=1
3308 cnmn_l = cnmn_l +1
3309 nindx_nm = nindx_nm + 1
3310 indx_nm(nindx_nm) = n2
3311 ENDIF
3312 IF(tag_nm(n3)==0)THEN
3313 tag_nm(n3)=1
3314 cnmn_l = cnmn_l +1
3315 nindx_nm = nindx_nm + 1
3316 indx_nm(nindx_nm) = n3
3317 ENDIF
3318 IF(tag_nm(n4)==0)THEN
3319 tag_nm(n4)=1
3320 cnmn_l = cnmn_l +1
3321 nindx_nm = nindx_nm + 1
3322 indx_nm(nindx_nm) = n4
3323 ENDIF
3324 ENDIF
3325 ENDDO
3326
3327C WRITE(6,*) __FILE__,__LINE__,CNMN_L,CNRTM_L,NRTM
3328c IF(NI == 1) THEN
3329c DO I=1,NMN
3330c N = INTBUF_TAB%MSR(I)
3331c !if the node is local
3332c IF(TAG_NM(N)==1)THEN
3333c WRITE(700+PROC,*) ITAB(N)
3334c ENDIF
3335c ENDDO
3336c DO N=1,NUMNOD
3337c !if the node is local
3338c IF(TAG_NM(N)==1)THEN
3339c WRITE(800+PROC,*) ITAB(N)
3340c ENDIF
3341c ENDDO
3342c ENDIF
3343
3344C Compute TAG_LMSR,TAG_LMSR2,TAG_NSEG
3345 nmn_l = cnmn_l
3346 IF(nmn_l > 0) tag_nseg(1) = 1
3347 cnmn_l = 0
3348 clmsr_l = 0
3349 DO i=1,nmn
3350 n = intbuf_tab%MSR(i)
3351 !if the node is local
3352 IF(tag_nm(n)==1)THEN
3353 cnmn_l = cnmn_l + 1
3354 tag_node_msr(cnmn_l) = i
3355 tag_node_msr2(i) = cnmn_l
3356 ibegin = intbuf_tab%NSEGM(i)
3357 iend = intbuf_tab%NSEGM(i+1)-1
3358 DO j=ibegin,iend
3359 k = intbuf_tab%LMSR(j)
3360 IF(intercep%P(k)==proc+1)THEN
3361 ! TAG filled with local number of seg
3362 tag_nseg(cnmn_l + 1) = tag_nseg(cnmn_l + 1) + 1
3363 clmsr_l = clmsr_l + 1
3364 tag_lmsr(clmsr_l) = j
3365 tag_lmsr2(j) = clmsr_l
3366 ENDIF
3367 ENDDO
3368 ENDIF
3369 ENDDO
3370
3371 !Cumulate sum of TAG_SEGM
3372 !It becomes the local version of NSEGM
3373 DO j=2,cnmn_l+1
3374 tag_nseg(j) = tag_nseg(j) + tag_nseg(j-1)
3375 ENDDO
3376
3377 IF(nspmd > 1) THEN
3378 ! renumber MAIN_ID locally
3379 DO p2=1,nspmd
3380 IF(p2/=proc + 1) THEN
3381 DO i = 1,t8%BUFFER(p2)%NBMAIN
3382 t8%BUFFER(p2)%MAIN_ID(i) =
3383 . tag_node_msr2(t8%BUFFER(p2)%MAIN_ID(i))
3384 ENDDO
3385 ENDIF
3386 ENDDO
3387
3388 DO i = 1,t8%S_COMM
3389 t8%SPMD_COMM_PATTERN(i)%UID = itab(
3390 . intbuf_tab%MSR(t8%SPMD_COMM_PATTERN(i)%NUMLOC))
3391 t8%SPMD_COMM_PATTERN(i)%NUMLOC =
3392 . tag_node_msr2(t8%SPMD_COMM_PATTERN(i)%NUMLOC)
3393 ENDDO
3394 ENDIF
3395
3396
3397
3398
3399 RETURN
3400 END SUBROUTINE prepare_split_i8
3401C=======================================================================
3402C END SPECIFIC ROUTINES INT8
3403C=======================================================================
3404
3405
3406C=======================================================================
3407C SPECIFIC ROUTINES INT 9
3408C=======================================================================
3409!||====================================================================
3410!|| prepare_split_i9 ../starter/source/restart/ddsplit/inter_tools.F
3411!||--- called by ------------------------------------------------------
3412!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
3413!||--- calls -----------------------------------------------------
3414!|| nlocal ../starter/source/spmd/node/ddtools.F
3415!||--- uses -----------------------------------------------------
3416!|| front_mod ../starter/share/modules1/front_mod.F
3417!||====================================================================
3418 SUBROUTINE prepare_split_i9(PROC , INTBUF_TAB , IPARI ,
3419 . TAG_NODE_2RY, TAG_NODE_MSR, TAG_SCRATCH ,
3420 . TAG_IELES , TAG_IELEM ,
3421 . CEP , CEL ,NINDX_SCRT,INDX_SCRT)
3422C-----------------------------------------------
3423C M o d u l e s
3424C-----------------------------------------------
3425 USE intbufdef_mod
3426 USE front_mod
3427C-----------------------------------------------
3428C I m p l i c i t T y p e s
3429C-----------------------------------------------
3430#include "implicit_f.inc"
3431C-----------------------------------------------
3432C D u m m y A r g u m e n t s
3433C-----------------------------------------------
3434 TYPE(intbuf_struct_) :: INTBUF_TAB
3435
3436 INTEGER PROC,IPARI(*),
3437 . tag_node_2ry(*),tag_node_msr(*),
3438 . tag_ieles(*) ,tag_ielem(*),
3439 . tag_scratch(*),cep(*),cel(*)
3440 INTEGER, INTENT(INOUT) :: NINDX_SCRT
3441 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_SCRT
3442C-----------------------------------------------
3443C F u n c t i o n
3444C-----------------------------------------------
3445 INTEGER NLOCAL
3446 EXTERNAL nlocal
3447C-----------------------------------------------
3448C L o c a l V a r i a b l e s
3449C-----------------------------------------------
3450 INTEGER
3451 . NSN,NRTM,NRTS,NMN,
3452 . I,J,K,N,IE,IE_LOC,PROC2,
3453 . CNSN_L,CNMN_L,CNRTS_L,CNRTM_L
3454C ----------------------------------------
3455 NRTS = ipari(3)
3456 nrtm = ipari(4)
3457 nsn = ipari(5)
3458 nmn = ipari(6)
3459
3460 cnsn_l = 0
3461 DO k=1, nsn
3462 n=intbuf_tab%NSV(k)
3463 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0) THEN
3464 cnsn_l = cnsn_l+1
3465 tag_node_2ry(cnsn_l) = k
3466 tag_scratch(n)=1
3467 nindx_scrt = nindx_scrt + 1
3468 indx_scrt(nindx_scrt) = n
3469 ENDIF
3470 ENDDO
3471
3472 !reflush to zero only part of TAG_SCRATCH that has been used
3473! DO K=1, NSN
3474! N=INTBUF_TAB%NSV(K)
3475! TAG_SCRATCH(N) = 0
3476! ENDDO
3477#include "vectorize.inc"
3478 DO k=1,nindx_scrt
3479 n = indx_scrt(k)
3480 tag_scratch(n) = 0
3481 ENDDO
3482 nindx_scrt = 0
3483
3484 cnmn_l = 0
3485 DO i=1,nmn
3486 n = intbuf_tab%MSR(i)
3487 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0)THEN
3488 cnmn_l = cnmn_l + 1
3489 tag_node_msr(cnmn_l) = i
3490 ENDIF
3491 ENDDO
3492
3493 !reflush to zero only part of TAG_SCRATCH that has been used
3494 DO k=1, nmn
3495 n=intbuf_tab%MSR(k)
3496 tag_scratch(n) = 0
3497 ENDDO
3498
3499 !IELES
3500 cnrts_l = 0
3501 DO k = 1, nrts
3502 ie = intbuf_tab%IELES(k)
3503 proc2 = cep(ie)
3504 IF(proc2==proc) THEN
3505 ie_loc = cel(ie)
3506 ELSE
3507 ie_loc = -ie
3508 ENDIF
3509 cnrts_l = cnrts_l + 1
3510 tag_ieles(cnrts_l) = ie_loc
3511 ENDDO
3512
3513 !ielem
3514 cnrtm_l = 0
3515 DO k = 1, nrtm
3516 ie = intbuf_tab%IELEM(k)
3517 proc2 = cep(ie)
3518 IF(proc2==proc) THEN
3519 ie_loc = cel(ie)
3520 ELSE
3521 ie_loc = -ie
3522 ENDIF
3523 cnrtm_l = cnrtm_l + 1
3524 tag_ielem(cnrtm_l) = ie_loc
3525 ENDDO
3526
3527 RETURN
3528 END
3529C=======================================================================
3530C END SPECIFIC ROUTINES INT9
3531C=======================================================================
3532
3533C=======================================================================
3534C SPECIFIC ROUTINES INT 11
3535C=======================================================================
3536!||====================================================================
3537!|| prepare_split_i11 ../starter/source/restart/ddsplit/inter_tools.F
3538!||--- called by ------------------------------------------------------
3539!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
3540!||--- calls -----------------------------------------------------
3541!|| nlocal ../starter/source/spmd/node/ddtools.F
3542!||--- uses -----------------------------------------------------
3543!|| front_mod ../starter/share/modules1/front_mod.F
3544!||====================================================================
3545 SUBROUTINE prepare_split_i11(PROC , INTBUF_TAB, IPARI ,
3546 . TAG_NODE_2RY, TAG_SEGM , TAG_SEGM2 ,
3547 . TAG_NM , TAG_SEGS , TAG_NODE_MSR,
3548 . TAG_SCRATCH , INTERCEP , NI ,NINDX_NM,INDX_NM,
3549 . NINDX_SCRT , INDX_SCRT ,TAG_SEGS2)
3550C-----------------------------------------------
3551C M o d u l e s
3552C-----------------------------------------------
3553 USE intbufdef_mod
3554 USE front_mod
3555C-----------------------------------------------
3556C I m p l i c i t T y p e s
3557C-----------------------------------------------
3558#include "implicit_f.inc"
3559C-----------------------------------------------
3560C C o m m o n B l o c k s
3561C-----------------------------------------------
3562#include "com04_c.inc"
3563C-----------------------------------------------
3564C D u m m y A r g u m e n t s
3565C-----------------------------------------------
3566 INTEGER
3567 . ipari(*),ni
3568
3569 INTEGER PROC,TAG_NODE_2RY(*),TAG_SEGM(*),TAG_SEGM2(*),
3570 . tag_nm(*),tag_segs(*),tag_node_msr(*),tag_scratch(*),tag_segs2(*)
3571 INTEGER, INTENT(INOUT) :: NINDX_NM,NINDX_SCRT
3572 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_NM,INDX_SCRT
3573
3574 TYPE(intbuf_struct_) :: INTBUF_TAB
3575 TYPE(INTERSURFP) :: INTERCEP(3,NINTER)
3576C-----------------------------------------------
3577C F u n c t i o n
3578C-----------------------------------------------
3579 INTEGER NLOCAL
3580 EXTERNAL NLOCAL
3581C-----------------------------------------------
3582C L o c a l V a r i a b l e s
3583C-----------------------------------------------
3584 INTEGER
3585 . NSN,NRTM,NMN,NRTS
3586
3587 INTEGER
3588 . I,J,K,L,M,N,N1,N2,JJ,
3589 . CNRTM_L,CNRTS_L,CNSN_L,CNMN_L
3590C ----------------------------------------
3591 NRTS = ipari(3)
3592 nrtm = ipari(4)
3593 nsn = ipari(5)
3594 nmn = ipari(6)
3595
3596C IRECTS
3597 cnrts_l = 0
3598 DO k=1,nrts
3599 IF(intercep(2,ni)%P(k)==proc+1)THEN
3600 cnrts_l = cnrts_l + 1
3601 tag_segs(cnrts_l) = k
3602 tag_segs2(k) = cnrts_l
3603 ENDIF
3604 ENDDO
3605
3606 cnsn_l = 0
3607 DO k=1, nsn
3608 n=intbuf_tab%NSV(k)
3609 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0) THEN
3610 cnsn_l = cnsn_l+1
3611 tag_node_2ry(cnsn_l) = k
3612 tag_scratch(n)=1
3613 nindx_scrt = nindx_scrt + 1
3614 indx_scrt(nindx_scrt) = n
3615 ENDIF
3616 ENDDO
3617
3618 !reflush to zero only part of TAG_SCRATCH that has been used
3619#include "vectorize.inc"
3620 DO k=1, nindx_scrt
3621 n=indx_scrt(k)
3622 tag_scratch(n) = 0
3623 ENDDO
3624 nindx_scrt = 0
3625
3626 cnrtm_l = 0
3627 DO k=1,nrtm
3628 n1 = intbuf_tab%IRECTM(2*(k-1)+1)
3629 n2 = intbuf_tab%IRECTM(2*(k-1)+2)
3630 IF(intercep(1,ni)%P(k)==proc+1)THEN
3631 cnrtm_l = cnrtm_l + 1
3632 tag_segm(cnrtm_l) = k
3633 tag_segm2(k) = cnrtm_l
3634 IF(tag_nm(n1)==0)THEN
3635 tag_nm(n1)=1
3636 nindx_nm = nindx_nm + 1
3637 indx_nm(nindx_nm) = n1
3638 ENDIF
3639 IF(tag_nm(n2)==0)THEN
3640 tag_nm(n2)=1
3641 nindx_nm = nindx_nm + 1
3642 indx_nm(nindx_nm) = n2
3643 ENDIF
3644 ENDIF
3645 ENDDO
3646
3647 cnmn_l = 0
3648 DO i=1,nmn
3649 n = intbuf_tab%MSR(i)
3650 IF(tag_nm(n)==1)THEN
3651 cnmn_l = cnmn_l + 1
3652 tag_node_msr(cnmn_l) = i
3653 ENDIF
3654 ENDDO
3655
3656
3657 RETURN
3658 END
3659!||====================================================================
3660!|| split_cand_i11 ../starter/source/restart/ddsplit/inter_tools.F
3661!||--- called by ------------------------------------------------------
3662!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
3663!||--- calls -----------------------------------------------------
3664!|| nlocal ../starter/source/spmd/node/ddtools.F
3665!||--- uses -----------------------------------------------------
3666!|| front_mod ../starter/share/modules1/front_mod.F
3667!|| message_mod ../starter/share/message_module/message_mod.F
3668!||====================================================================
3669 SUBROUTINE split_cand_i11(PROC , INTBUF_TAB, NRTS , NRTS_L ,
3670 . TAG_SEGM2 , TAG_SEGS , II_STOK, MULTIMP,
3671 . NCONT , NOINT , INACTI ,
3672 . TAG_SCRATCH, INTERCEP , NI , IPARI_L,
3673 . II_STOK_L ,NINDX_SCRT ,INDX_SCRT)
3674C-----------------------------------------------
3675C M o d u l e s
3676C-----------------------------------------------
3677 USE message_mod
3678 USE front_mod
3679 USE intbufdef_mod
3680C-----------------------------------------------
3681C I m p l i c i t T y p e s
3682C-----------------------------------------------
3683#include "implicit_f.inc"
3684C-----------------------------------------------
3685C C o m m o n B l o c k s
3686C-----------------------------------------------
3687#include "com01_c.inc"
3688#include "com04_c.inc"
3689#include "param_c.inc"
3690C-----------------------------------------------
3691C D u m m y A r g u m e n t s
3692C-----------------------------------------------
3693 INTEGER PROC,NRTS,NRTS_L,II_STOK,MULTIMP,NCONT,
3694 . noint,inacti,ni,ipari_l(npari,ninter),
3695 . tag_segm2(*),tag_segs(*),tag_scratch(*),ii_stok_l
3696 INTEGER, INTENT(INOUT) :: NINDX_SCRT
3697 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_SCRT
3698
3699 TYPE(intbuf_struct_) :: INTBUF_TAB
3700 TYPE(INTERSURFP) :: INTERCEP(3,NINTER)
3701C-----------------------------------------------
3702C F u n c t i o n
3703C-----------------------------------------------
3704 INTEGER NLOCAL
3705 EXTERNAL nlocal
3706C-----------------------------------------------
3707C L o c a l V a r i a b l e s
3708C-----------------------------------------------
3709 INTEGER I,J,K,L,N,N1,N2,P,E,MULTOK,MSGID,
3710 . SPLIST,C_NRTSR
3711 INTEGER NUMP(NSPMD),WORK(70000)
3712
3713 INTEGER, DIMENSION(:),ALLOCATABLE ::
3714 . IBUF_E,IBUF_N,NRTSLOCAL,CPULOCAL,CANDR,PLIST,
3715 . INDEX,CANDS
3716
3717 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ITRI
3718
3719C ----------------------------------------
3720 ALLOCATE(IBUF_E(MULTIMP*NCONT),IBUF_N(MULTIMP*NCONT))
3721 IBUF_E(1:MULTIMP*NCONT) = 0
3722 ibuf_n(1:multimp*ncont) = 0
3723
3724 ii_stok_l = 0
3725
3726 IF(inacti==5.OR.inacti==6.OR.inacti==7) THEN
3727 IF(nrts>0) THEN
3728 ALLOCATE(nrtslocal(nrts))
3729 ALLOCATE(cpulocal(nrts))
3730 ALLOCATE(candr(nrts))
3731 END IF
3732
3733 nump(1:nspmd) = 0
3734
3735! optimize loop with PLIST tool
3736 ALLOCATE(plist(nspmd))
3737 plist(1:nspmd) = -1
3738
3739 DO k=1,nrts
3740 n1 = intbuf_tab%IRECTS(2*(k-1)+1)
3741 n2 = intbuf_tab%IRECTS(2*(k-1)+2)
3742 nrtslocal(k) = 0
3743 IF(intercep(2,ni)%P(k)==proc+1)THEN
3744 nump(proc+1) = nump(proc+1) + 1
3745 nrtslocal(k) = nump(proc+1)
3746 cpulocal(k) = proc+1
3747 ENDIF
3748 ENDDO
3749 DEALLOCATE(plist)
3750C
3751C Reperage des candidats se trouvant sur des procs distants
3752C
3753 c_nrtsr = 0
3754 DO k = 1, ii_stok
3755 e = intbuf_tab%CAND_E(k)
3756 IF (tag_segm2(e)/=0) THEN
3757 n = intbuf_tab%CAND_N(k)
3758 IF(tag_scratch(n)==0) THEN
3759 tag_scratch(n) = 1
3760 nindx_scrt = nindx_scrt + 1
3761 indx_scrt(nindx_scrt) = n
3762 IF(nlocal(intbuf_tab%NSV(n),proc+1)/=1)THEN
3763 c_nrtsr = c_nrtsr + 1
3764 candr(c_nrtsr) = n
3765 END IF
3766 END IF
3767 ENDIF
3768 ENDDO
3769
3770 !reflush TAG_SCRATCH to zero only when value has changes
3771#include "vectorize.inc"
3772 DO k=1, nindx_scrt
3773! E = INTBUF_TAB%CAND_E(K)
3774! IF (TAG_SEGM2(E)/=0) THEN
3775 n = indx_scrt(k)
3776 tag_scratch(n) = 0
3777! ENDIF
3778 ENDDO
3779 nindx_scrt = 0
3780
3781C
3782C Tris des candidats remote par proc et par nsv local croissant
3783C
3784 IF(c_nrtsr>0) THEN
3785 ALLOCATE(index(2*c_nrtsr))
3786 ALLOCATE(itri(2,c_nrtsr))
3787 END IF
3788 DO i = 1, c_nrtsr
3789 n = candr(i)
3790 itri(1,i) = cpulocal(n)
3791 itri(2,i) = nrtslocal(n)
3792 ENDDO
3793 CALL my_orders(0,work,itri,index,c_nrtsr,2)
3794C
3795 DO i = 1, c_nrtsr
3796 index(c_nrtsr+index(i)) = i
3797 ENDDO
3798 DO i = 1, c_nrtsr
3799 index(i)=index(c_nrtsr+i)
3800 ENDDO
3801C
3802 ii_stok_l = 0
3803
3804 c_nrtsr = 0
3805 DO k = 1, ii_stok
3806 e = intbuf_tab%CAND_E(k)
3807 IF (tag_segm2(e)/=0) THEN
3808 ii_stok_l = ii_stok_l + 1
3809 ibuf_e(ii_stok_l)=tag_segm2(e)
3810 l = intbuf_tab%CAND_N(k)
3811 n1 = intbuf_tab%IRECTS(2*(l-1)+1)
3812 n2 = intbuf_tab%IRECTS(2*(l-1)+2)
3813 IF(cpulocal(l) == (proc+1))THEN
3814 ibuf_n(ii_stok_l) = nrtslocal(l)
3815 ELSE
3816C noeud remote : numerotation pre calculee ci-dessus
3817 IF(tag_scratch(l)==0) THEN
3818 c_nrtsr =c_nrtsr + 1
3819 ibuf_n(ii_stok_l) = index(c_nrtsr)+nrts_l
3820 tag_scratch(l) = index(c_nrtsr)+nrts_l
3821 nindx_scrt = nindx_scrt + 1
3822 indx_scrt(nindx_scrt) = l
3823 ELSE
3824 ibuf_n(ii_stok_l) = tag_scratch(l)
3825 END IF
3826 END IF
3827 ENDIF
3828 ENDDO
3829
3830
3831 IF(nrts>0) DEALLOCATE(nrtslocal,cpulocal,candr)
3832 IF(c_nrtsr>0) DEALLOCATE(index,itri)
3833
3834 IF(inacti==5.OR.inacti==6.OR.inacti==7)ipari_l(24,ni)= c_nrtsr
3835
3836 ENDIF !END INACTI=5,6,7
3837
3838 CALL write_i_c(ibuf_e,multimp*ncont)
3839 CALL write_i_c(ibuf_n,multimp*ncont)
3840
3841 DEALLOCATE(ibuf_e,ibuf_n)
3842
3843 RETURN
3844 END
3845C=======================================================================
3846C END SPECIFIC ROUTINES INT11
3847C=======================================================================
3848
3849C=======================================================================
3850C SPECIFIC ROUTINES INT 17
3851C=======================================================================
3852!||====================================================================
3853!|| prepare_split_i17 ../starter/source/restart/ddsplit/inter_tools.F
3854!||--- called by ------------------------------------------------------
3855!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
3856!||--- calls -----------------------------------------------------
3857!|| nlocal ../starter/source/spmd/node/ddtools.F
3858!||--- uses -----------------------------------------------------
3859!|| front_mod ../starter/share/modules1/front_mod.F
3860!||====================================================================
3861 SUBROUTINE prepare_split_i17(PROC , INTBUF_TAB , IPARI ,
3862 . TAG_NODE_2RY , TAG_NODE_MSR ,
3863 . CEP , CEL , IGRBRIC ,
3864 . NSN_L , NME_L)
3865C-----------------------------------------------
3866C M o d u l e s
3867C-----------------------------------------------
3868 USE intbufdef_mod
3869 USE front_mod
3870 USE groupdef_mod
3871C-----------------------------------------------
3872C I m p l i c i t T y p e s
3873C-----------------------------------------------
3874#include "implicit_f.inc"
3875C-----------------------------------------------
3876C C o m m o n B l o c k s
3877C-----------------------------------------------
3878#include "com04_c.inc"
3879C-----------------------------------------------
3880C D u m m y A r g u m e n t s
3881C-----------------------------------------------
3882 TYPE(intbuf_struct_) :: INTBUF_TAB
3883
3884 INTEGER PROC,IPARI(*),
3885 . tag_node_2ry(*),tag_node_msr(*),
3886 . cep(*),cel(*),
3887 . nme_l,nsn_l
3888
3889C-----------------------------------------------
3890 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
3891C-----------------------------------------------
3892C F u n c t i o n
3893C-----------------------------------------------
3894 INTEGER NLOCAL
3895 EXTERNAL nlocal
3896C-----------------------------------------------
3897C L o c a l V a r i a b l e s
3898C-----------------------------------------------
3899 INTEGER
3900 . nsn,nrtm,nrts,nme,
3901 . j,k,ie,
3902 . ige,ign,nad,ead,nas,
3903 . cnme_l,cnsn_l
3904
3905C ----------------------------------------
3906 nrts = ipari(4)
3907 nme = ipari(4)
3908 nsn = ipari(5)
3909 ige = ipari(34)
3910 ign = ipari(36)
3911!
3912 cnsn_l = 0
3913 DO k=1, nsn
3914 ie = igrbric(ign)%ENTITY(k)
3915C IF(CEP(IE)==PROC) THEN
3916 cnsn_l = cnsn_l+1
3917 tag_node_2ry(cnsn_l) = k
3918C ENDIF
3919 ENDDO
3920 cnme_l = 0
3921 DO k=1,nme
3922 ie = igrbric(ige)%ENTITY(k)
3923C IF(CEP(IE)==PROC)THEN
3924 cnme_l = cnme_l + 1
3925 tag_node_msr(cnme_l) = k
3926C ENDIF
3927 ENDDO
3928
3929 RETURN
3930 END
3931C=======================================================================
3932C END SPECIFIC ROUTINES INT17
3933C=======================================================================
3934
3935C=======================================================================
3936C SPECIFIC ROUTINES INT20
3937C=======================================================================
3938!||====================================================================
3939!|| prepare_split_i20 ../starter/source/restart/ddsplit/inter_tools.F
3940!||--- called by ------------------------------------------------------
3941!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
3942!||--- calls -----------------------------------------------------
3943!|| nlocal ../starter/source/spmd/node/ddtools.F
3944!||--- uses -----------------------------------------------------
3945!|| front_mod ../starter/share/modules1/front_mod.F
3946!||====================================================================
3947 SUBROUTINE prepare_split_i20(
3948 . PROC , INTBUF_TAB, IPARI ,
3949 . TAG_NODE_2RY, TAG_SEGM , TAG_NODE_MSR,
3950 . TAG_SEGM2 , TAG_NM , TAG_NLINS,TAG_NLINM,
3951 . TAG_NLINS2 , TAG_NLINM2, TAG_NLG ,TAG_NLG2,
3952 . TAG_SCRATCH , INTERCEP , IPARI_L ,NI ,TAG_NSNE,
3953 . TAG_NMNE , TAG_NSVE , TAG_MSRE ,NINDX_NM,INDX_NM,
3954 . NINDX_SCRT , INDX_SCRT)
3955C-----------------------------------------------
3956C M o d u l e s
3957C-----------------------------------------------
3958 USE intbufdef_mod
3959 USE front_mod
3960C-----------------------------------------------
3961C I m p l i c i t T y p e s
3962C-----------------------------------------------
3963#include "implicit_f.inc"
3964C-----------------------------------------------
3965C C o m m o n B l o c k s
3966C-----------------------------------------------
3967#include "com04_c.inc"
3968#include "param_c.inc"
3969C-----------------------------------------------
3970C D u m m y A r g u m e n t s
3971C-----------------------------------------------
3972 TYPE(intbuf_struct_) :: INTBUF_TAB
3973 TYPE(intersurfp) :: INTERCEP(3,NINTER)
3974
3975 INTEGER PROC,IPARI(*),NI,
3976 . tag_node_2ry(*),tag_segm(*),tag_nm(*),tag_node_msr(*),
3977 . tag_segm2(*),tag_scratch(*),ipari_l(npari,ninter),
3978 . tag_nlins(*), tag_nlinm(*),tag_nlins2(*), tag_nlinm2(*),
3979 . tag_nlg(*),tag_nsne(*),tag_nmne(*),tag_nsve(*),tag_msre(*),
3980 . tag_nlg2(*)
3981 INTEGER, INTENT(INOUT) ::NINDX_NM,NINDX_SCRT
3982 INTEGER, DIMENSION(*), INTENT(INOUT) ::INDX_NM,INDX_SCRT
3983C-----------------------------------------------
3984C F u n c t i o n
3985C-----------------------------------------------
3986 INTEGER NLOCAL
3987 EXTERNAL NLOCAL
3988C-----------------------------------------------
3989C L o c a l V a r i a b l e s
3990C-----------------------------------------------
3991 INTEGER
3992 . NSN,NRTM,NMN,NLN,
3993 . nlins,nlinm,nlinsa,nlinma,nsne,nmne,
3994 . i,j,k,l,n,n1,n2,n3,n4,e,
3995 . nl,n1l,n2l,n3l,n4l,
3996 . ncont,ncont1,ncont2,
3997 . cnsn_l,cnrtm_l,cnmn_l,cnln_l,
3998 . cnlins_l,cnlinsa_l,cnlinm_l,
3999 . cnlinma_l,cnmne_l ,cnsne_l
4000 my_real
4001 . rcont
4002C ----------------------------------------
4003
4004 nrtm = ipari(4)
4005 nsn = ipari(5)
4006 nmn = ipari(6)
4007
4008 nln = ipari(35)
4009 nlins = ipari(51)
4010 nlinm = ipari(52)
4011 nlinsa = ipari(53)
4012 nlinma = ipari(54)
4013 nsne = ipari(55)
4014 nmne = ipari(56)
4015
4016 ! for type20, TAG_NM is used to tag main nodes, secnd nodes,
4017 ! line secnd, line main
4018
4019 ! prepare SPLIT_NRTM_R
4020 cnrtm_l = 0
4021 DO k=1,nrtm
4022 IF(intercep(1,ni)%P(k)==proc+1)THEN
4023 n1l = intbuf_tab%IRECTM(4*(k-1)+1)
4024 n2l = intbuf_tab%IRECTM(4*(k-1)+2)
4025 n3l = intbuf_tab%IRECTM(4*(k-1)+3)
4026 n4l = intbuf_tab%IRECTM(4*(k-1)+4)
4027 n1 = intbuf_tab%NLG(n1l)
4028 n2 = intbuf_tab%NLG(n2l)
4029 n3 = intbuf_tab%NLG(n3l)
4030 n4 = intbuf_tab%NLG(n4l)
4031 cnrtm_l = cnrtm_l + 1
4032 tag_segm(cnrtm_l) = k
4033 tag_segm2(k) = cnrtm_l
4034 IF(tag_nm(n1)==0)THEN
4035 tag_nm(n1)=1
4036 nindx_nm = nindx_nm + 1
4037 indx_nm(nindx_nm) = n1
4038 ENDIF
4039 IF(tag_nm(n2)==0)THEN
4040 tag_nm(n2)=1
4041 nindx_nm = nindx_nm + 1
4042 indx_nm(nindx_nm) = n2
4043 ENDIF
4044 IF(tag_nm(n3)==0)THEN
4045 tag_nm(n3)=1
4046 nindx_nm = nindx_nm + 1
4047 indx_nm(nindx_nm) = n3
4048 ENDIF
4049 IF(tag_nm(n4)==0)THEN
4050 tag_nm(n4)=1
4051 nindx_nm = nindx_nm + 1
4052 indx_nm(nindx_nm) = n4
4053 ENDIF
4054 ENDIF
4055 ENDDO
4056
4057 cnmn_l = 0
4058 DO i=1,nmn
4059 n = intbuf_tab%MSR(i)
4060 n1 = intbuf_tab%NLG(n)
4061 IF(tag_nm(n1)==1)THEN
4062 cnmn_l = cnmn_l + 1
4063 tag_node_msr(cnmn_l) = i
4064 ENDIF
4065 ENDDO
4066
4067 cnln_l = 0
4068 cnsn_l = 0
4069 DO k=1, nsn
4070 nl=intbuf_tab%NSV(k)
4071 n =intbuf_tab%NLG(nl)
4072 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0) THEN
4073 cnsn_l = cnsn_l+1
4074 tag_node_2ry(cnsn_l) = k
4075 tag_scratch(n)=1
4076 nindx_scrt = nindx_scrt + 1
4077 indx_scrt(nindx_scrt) = n
4078 IF(tag_nm(n)==0)THEN
4079 cnln_l = cnln_l + 1
4080 tag_nm(n)=1
4081 nindx_nm = nindx_nm + 1
4082 indx_nm(nindx_nm) = n
4083 ENDIF
4084 ENDIF
4085 ENDDO
4086
4087 !reflush to zero only part of TAG_SCRATCH that has been used
4088#include "vectorize.inc"
4089 DO k=1,nindx_scrt
4090 n = indx_scrt(k)
4091 tag_scratch(n) = 0
4092 ENDDO
4093 nindx_scrt = 0
4094C
4095C Partie ligne
4096CTAG_SCRATCH(K)
4097 cnlins_l = 0
4098 cnlinsa_l= 0
4099 cnlinm_l = 0
4100 cnlinma_l= 0
4101 cnmne_l = 0
4102 cnsne_l = 0
4103
4104 DO k=1,nlins
4105 n1l = intbuf_tab%IXLINS(2*(k-1)+1)
4106 n2l = intbuf_tab%IXLINS(2*(k-1)+2)
4107 n1 = intbuf_tab%NLG(n1l)
4108 n2 = intbuf_tab%NLG(n2l)
4109 IF(intercep(3,ni)%P(k)==proc+1) THEN
4110 cnlins_l = cnlins_l + 1
4111 tag_nlins(cnlins_l) = k
4112 tag_nlins2(k) = cnlins_l
4113C comptage ligne active
4114 IF(k<=nlinsa)cnlinsa_l = cnlinsa_l + 1
4115 IF (tag_scratch(n1)==0) THEN
4116 cnsne_l = cnsne_l + 1
4117 tag_nsne(cnsne_l) = n1
4118 tag_nsve(cnsne_l) = n1l
4119 tag_scratch(n1) = 1
4120 nindx_scrt = nindx_scrt + 1
4121 indx_scrt(nindx_scrt) = n1
4122 IF(tag_nm(n1)==0)THEN
4123 cnln_l = cnln_l + 1
4124 tag_nm(n1) = 1
4125 nindx_nm = nindx_nm + 1
4126 indx_nm(nindx_nm) = n1
4127 END IF
4128 ENDIF
4129 IF (tag_scratch(n2)==0) THEN
4130 cnsne_l = cnsne_l + 1
4131 tag_nsne(cnsne_l) = n2
4132 tag_nsve(cnsne_l) = n2l
4133 tag_scratch(n2) = 1
4134 nindx_scrt = nindx_scrt + 1
4135 indx_scrt(nindx_scrt) = n2
4136 IF(tag_nm(n2)==0)THEN
4137 cnln_l = cnln_l + 1
4138 tag_nm(n2) = 1
4139 nindx_nm = nindx_nm + 1
4140 indx_nm(nindx_nm) = n2
4141 END IF
4142 ENDIF
4143 ENDIF
4144 ENDDO
4145 !reflush to zero only part of TAG_SCRATCH that has been used
4146#include "vectorize.inc"
4147 DO k=1,nlins
4148 n1l = intbuf_tab%IXLINS(2*(k-1)+1)
4149 n2l = intbuf_tab%IXLINS(2*(k-1)+2)
4150 n1 = intbuf_tab%NLG(n1l)
4151 n2 = intbuf_tab%NLG(n2l)
4152 tag_scratch(n1) = 0
4153 tag_scratch(n2) = 0
4154 ENDDO
4155 nindx_scrt = 0
4156 DO k=1,nlinm
4157 n1l = intbuf_tab%IXLINM(2*(k-1)+1)
4158 n2l = intbuf_tab%IXLINM(2*(k-1)+2)
4159 n1 = intbuf_tab%NLG(n1l)
4160 n2 = intbuf_tab%NLG(n2l)
4161 IF(intercep(2,ni)%P(k)==proc+1) THEN
4162 cnlinm_l = cnlinm_l + 1
4163 tag_nlinm(cnlinm_l) = k
4164 tag_nlinm2(k) = cnlinm_l
4165C comptage ligne active
4166 IF(k<=nlinma)cnlinma_l = cnlinma_l + 1
4167 IF (tag_scratch(n1)==0) THEN
4168 cnmne_l = cnmne_l + 1
4169 tag_nmne(cnmne_l) = n1
4170 tag_msre(cnmne_l) = n1l
4171 tag_scratch(n1) = 1
4172 nindx_scrt = nindx_scrt + 1
4173 indx_scrt(nindx_scrt) = n1
4174 IF(tag_nm(n1)==0)THEN
4175 cnmn_l = cnmn_l + 1
4176 tag_nm(n1) = 1
4177 nindx_nm = nindx_nm + 1
4178 indx_nm(nindx_nm) = n1
4179 END IF
4180 ENDIF
4181 IF (tag_scratch(n2)==0) THEN
4182 cnmne_l = cnmne_l + 1
4183 tag_nmne(cnmne_l) = n2
4184 tag_msre(cnmne_l) = n2l
4185 tag_scratch(n2) = 1
4186 nindx_scrt = nindx_scrt + 1
4187 indx_scrt(nindx_scrt) = n2
4188 IF(tag_nm(n2)==0)THEN
4189 cnmn_l = cnmn_l + 1
4190 tag_nm(n2) = 1
4191 nindx_nm = nindx_nm + 1
4192 indx_nm(nindx_nm) = n2
4193 END IF
4194 ENDIF
4195 ENDIF
4196 ENDDO
4197
4198 !reflush to zero only part of TAG_SCRATCH that has been used
4199#include "vectorize.inc"
4200 DO k=1,nlinm
4201 n1l = intbuf_tab%IXLINM(2*(k-1)+1)
4202 n2l = intbuf_tab%IXLINM(2*(k-1)+2)
4203 n1 = intbuf_tab%NLG(n1l)
4204 n2 = intbuf_tab%NLG(n2l)
4205 tag_scratch(n1) = 0
4206 tag_scratch(n2) = 0
4207 ENDDO
4208C
4209C Calcul de NCONT en prenant le max des edge et non edge
4210C
4211 ncont1 = 0
4212 IF(nmn/=0) THEN
4213 rcont = cnmn_l
4214 rcont = rcont/nmn
4215 ncont = nint(nsn*rcont)
4216 IF(cnmn_l>0.AND.nsn>0) ncont1 = max(ncont,1)
4217 ENDIF
4218
4219 ncont2 = 0
4220 IF(nmne/=0) THEN
4221 rcont = cnmne_l
4222 rcont = rcont/nmne
4223 ncont = nint(nsne*rcont)
4224 IF(cnmne_l>0.AND.nsne>0) ncont2 = max(ncont,1)
4225 ENDIF
4226 ncont = max(ncont1,ncont2)
4227
4228C
4229C
4230c fill node global to local
4231 k = 0
4232 DO l = 1, nln
4233 i = intbuf_tab%NLG(l)
4234 IF(tag_nm(i) == 1) THEN
4235 k = k + 1
4236C TAGG(I) = K => noeud I vers numero local de noeud d interface sur le proc
4237 tag_nlg(k) = l
4238 tag_nlg2(i) = k
4239 END IF
4240 END DO
4241
4242 ipari_l(35,ni) = cnln_l
4243 ipari_l(51,ni) = cnlins_l
4244 ipari_l(52,ni) = cnlinm_l
4245 ipari_l(53,ni) = cnlinsa_l
4246 ipari_l(54,ni) = cnlinma_l
4247 ipari_l(55,ni) = cnsne_l
4248 ipari_l(56,ni) = cnmne_l
4249
4250 RETURN
4251 END
4252!||====================================================================
4253!|| split_seg_rval_i20 ../starter/source/restart/ddsplit/inter_tools.F
4254!||--- calls -----------------------------------------------------
4255!||--- uses -----------------------------------------------------
4256!||====================================================================
4257 SUBROUTINE split_seg_rval_i20(TAB,DIM1,DIM2,TAG_SEG)
4258C-----------------------------------------------
4259C M o d u l e s
4260C-----------------------------------------------
4261 USE intbufdef_mod
4262C-----------------------------------------------
4263C I m p l i c i t T y p e s
4264C-----------------------------------------------
4265#include "implicit_f.inc"
4266C-----------------------------------------------
4267C D u m m y A r g u m e n t s
4268C-----------------------------------------------
4269 INTEGER TAG_SEG(*),DIM1,DIM2
4270
4271 my_real tab(*)
4272C-----------------------------------------------
4273C L o c a l V a r i a b l e s
4274C-----------------------------------------------
4275 INTEGER I,J,K
4276
4277 my_real, DIMENSION(:),ALLOCATABLE :: rbuf
4278C ----------------------------------------
4279 ALLOCATE(rbuf(dim1*dim2))
4280 DO i=1, dim1
4281 k=tag_seg(i)
4282 DO j=1,dim2
4283 rbuf(dim2*(i-1)+j) = tab(dim2*(k-1)+j)
4284 ENDDO
4285 ENDDO
4286
4287 CALL write_db(rbuf,dim1*dim2)
4288 DEALLOCATE(rbuf)
4289
4290 RETURN
4291 END
4292!||====================================================================
4293!|| split_seg_ival_i20 ../starter/source/restart/ddsplit/inter_tools.F
4294!||--- called by ------------------------------------------------------
4295!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
4296!||--- calls -----------------------------------------------------
4297!||--- uses -----------------------------------------------------
4298!||====================================================================
4299 SUBROUTINE split_seg_ival_i20(TAB,TAB_NLG,DIM1,DIM2,TAG,TAG_NLG)
4300C-----------------------------------------------
4301C M o d u l e s
4302C-----------------------------------------------
4303 USE intbufdef_mod
4304C-----------------------------------------------
4305C I m p l i c i t T y p e s
4306C-----------------------------------------------
4307#include "implicit_f.inc"
4308C-----------------------------------------------
4309C D u m m y A r g u m e n t s
4310C-----------------------------------------------
4311 INTEGER TAB(*),TAG(*),TAB_NLG(*),TAG_NLG(*),DIM1,DIM2
4312C-----------------------------------------------
4313C L o c a l V a r i a b l e s
4314C-----------------------------------------------
4315 INTEGER I,J,K,N
4316 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
4317C ----------------------------------------
4318 ALLOCATE(IBUF(DIM1*DIM2))
4319 DO I=1, dim1
4320 k=tag(i)
4321 DO j=1,dim2
4322 n = tab_nlg(tab(dim2*(k-1)+j))
4323 ibuf(dim2*(i-1)+j) = tag_nlg(n)
4324 ENDDO
4325 ENDDO
4326
4327 CALL write_i_c(ibuf,dim1*dim2)
4328 DEALLOCATE(ibuf)
4329
4330 RETURN
4331 END
4332!||====================================================================
4333!|| split_seg_ival_i20_2 ../starter/source/restart/ddsplit/inter_tools.F
4334!||--- called by ------------------------------------------------------
4335!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
4336!||--- calls -----------------------------------------------------
4337!||--- uses -----------------------------------------------------
4338!||====================================================================
4339 SUBROUTINE split_seg_ival_i20_2(TAG_SEG,DIM1,TAG_NLG)
4340c specific inter 20 + redirection local to global
4341C-----------------------------------------------
4342C M o d u l e s
4343C-----------------------------------------------
4344 USE intbufdef_mod
4345C-----------------------------------------------
4346C I m p l i c i t T y p e s
4347C-----------------------------------------------
4348#include "implicit_f.inc"
4349C-----------------------------------------------
4350C D u m m y A r g u m e n t s
4351C-----------------------------------------------
4352 INTEGER TAG_SEG(*),TAG_NLG(*),DIM1
4353C-----------------------------------------------
4354C L o c a l V a r i a b l e s
4355C-----------------------------------------------
4356 INTEGER I,J,K
4357 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
4358C ----------------------------------------
4359 ALLOCATE(IBUF(DIM1))
4360 DO I=1, dim1
4361 k=tag_seg(i)
4362 ibuf(i) = tag_nlg(k)
4363 ENDDO
4364
4365 CALL write_i_c(ibuf,dim1)
4366 DEALLOCATE(ibuf)
4367
4368 RETURN
4369 END
4370!||====================================================================
4371!|| prepare_split_cand_i20_edge ../starter/source/restart/ddsplit/inter_tools.F
4372!||--- called by ------------------------------------------------------
4373!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
4374!||--- uses -----------------------------------------------------
4375!||====================================================================
4376 SUBROUTINE prepare_split_cand_i20_edge(INTBUF_TAB, TAG_NLINS2, II_STOK, TAG_II)
4377C-----------------------------------------------
4378C M o d u l e s
4379C-----------------------------------------------
4380 USE intbufdef_mod
4381C-----------------------------------------------
4382C I m p l i c i t T y p e s
4383C-----------------------------------------------
4384#include "implicit_f.inc"
4385C-----------------------------------------------
4386C D u m m y A r g u m e n t s
4387C-----------------------------------------------
4388 INTEGER TAG_NLINS2(*),TAG_II(*),II_STOK
4389
4390 TYPE(intbuf_struct_) :: INTBUF_TAB
4391C-----------------------------------------------
4392C L o c a l V a r i a b l e s
4393C-----------------------------------------------
4394 INTEGER
4395 . k,e,c_ii
4396C ----------------------------------------
4397
4398! prepare split candidates
4399 c_ii = 0
4400 DO k = 1, ii_stok
4401 e = intbuf_tab%LCAND_N(k)
4402 IF (tag_nlins2(e)/=0) THEN
4403 c_ii = c_ii + 1
4404 tag_ii(c_ii) = k
4405 ENDIF
4406 ENDDO
4407
4408 RETURN
4409 END
4410!||====================================================================
4411!|| split_cand_i20 ../starter/source/restart/ddsplit/inter_tools.F
4412!||--- called by ------------------------------------------------------
4413!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.f
4414!||--- calls -----------------------------------------------------
4415!|| ancmsg ../starter/source/output/message/message.F
4416!|| nlocal ../starter/source/spmd/node/ddtools.F
4417!|| plist_ifront ../starter/source/spmd/node/ddtools.F
4418!||--- uses -----------------------------------------------------
4419!|| message_mod ../starter/share/message_module/message_mod.f
4420!||====================================================================
4421 SUBROUTINE split_cand_i20(PROC , INTBUF_TAB, NSN , NSN_L ,
4422 . TAG_SEGM2 , II_STOK , MULTIMP, NCONT ,
4423 . NOINT , INACTI , TAG_SCRATCH ,
4424 . II_STOK_L , IPARI_L,NI,NINDX_SCRT,INDX_SCRT)
4425C-----------------------------------------------
4426C M o d u l e s
4427C-----------------------------------------------
4428 USE message_mod
4429 USE intbufdef_mod
4430C-----------------------------------------------
4431C I m p l i c i t T y p e s
4432C-----------------------------------------------
4433#include "implicit_f.inc"
4434C-----------------------------------------------
4435C C o m m o n B l o c k s
4436C-----------------------------------------------
4437#include "com01_c.inc"
4438#include "com04_c.inc"
4439#include "param_c.inc"
4440C-----------------------------------------------
4441C D u m m y A r g u m e n t s
4442C-----------------------------------------------
4443 INTEGER PROC,NSN,NSN_L,II_STOK,MULTIMP,NCONT,
4444 . TAG_SEGM2(*),NOINT,INACTI,NI,
4445 . TAG_SCRATCH(*) , II_STOK_L, IPARI_L(NPARI,NINTER)
4446 INTEGER, INTENT(INOUT) ::NINDX_SCRT
4447 INTEGER, DIMENSION(*), INTENT(INOUT) ::INDX_SCRT
4448
4449 TYPE(INTBUF_STRUCT_) :: INTBUF_TAB
4450C-----------------------------------------------
4451C F u n c t i o n
4452C-----------------------------------------------
4453 INTEGER NLOCAL
4454 EXTERNAL NLOCAL
4455C-----------------------------------------------
4456C L o c a l V a r i a b l e s
4457C-----------------------------------------------
4458 INTEGER I,J,K,N,P,E,MULTOK,MSGID,
4459 . SPLIST,C_NSNR
4460 INTEGER NUMP(NSPMD),WORK(70000)
4461
4462 INTEGER, DIMENSION(:),ALLOCATABLE ::
4463 . IBUF_E,IBUF_N,NSNLOCAL,CPULOCAL,CANDR,PLIST,
4464 . INDEX
4465
4466 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ITRI
4467C ----------------------------------------
4468 ALLOCATE(ibuf_e(multimp*ncont),ibuf_n(multimp*ncont))
4469
4470 ibuf_e(1:multimp*ncont) = 0
4471 ibuf_n(1:multimp*ncont) = 0
4472 ii_stok_l = 0 !mandatory in case of inacti ne 5,6,7
4473
4474 IF(inacti==5.OR.inacti==6.OR.inacti==7) THEN
4475 IF(nsn>0) THEN
4476 ALLOCATE(nsnlocal(nsn))
4477 ALLOCATE(cpulocal(nsn))
4478 ALLOCATE(candr(nsn))
4479 END IF
4480
4481 nump(1:nspmd) = 0
4482
4483 ALLOCATE(plist(nspmd))
4484 plist(1:nspmd) = -1
4485 nindx_scrt=0
4486 DO k=1,nsn
4487 n = intbuf_tab%NSV(k)
4488 nsnlocal(k) = 0
4489 IF(tag_scratch(n)==0) THEN
4490 splist=0
4491 CALL plist_ifront(plist,n,splist)
4492 DO i=1,splist
4493 p=plist(i)
4494 nump(p) = nump(p)+1
4495 ENDDO
4496 IF(nlocal(n,proc+1)==1) THEN
4497 nsnlocal(k) = nump(proc+1)
4498 cpulocal(k) = proc+1
4499 ELSE
4500 p = plist(1)
4501 nsnlocal(k) = nump(p)
4502 cpulocal(k) = p
4503 ENDIF
4504 tag_scratch(n) = 1
4505 nindx_scrt = nindx_scrt + 1
4506 indx_scrt(nindx_scrt) = n
4507 ENDIF
4508 ENDDO
4509 DEALLOCATE(plist)
4510
4511 !reflush TAG_SCRATCH to zero only when value has changes
4512#include "vectorize.inc"
4513 DO k=1,nindx_scrt
4514 n = indx_scrt(k)
4515 tag_scratch(n) = 0
4516 ENDDO
4517 nindx_scrt = 0
4518C
4519C Reperage des candidats se trouvant sur des procs distants
4520C
4521 c_nsnr = 0
4522
4523 DO k = 1, ii_stok
4524 e = intbuf_tab%CAND_E(k)
4525 IF (tag_segm2(e)/=0) THEN
4526 n = intbuf_tab%CAND_N(k)
4527 IF(tag_scratch(n)==0) THEN
4528 tag_scratch(n) = 1
4529 nindx_scrt = nindx_scrt + 1
4530 indx_scrt(nindx_scrt) = n
4531 IF(nlocal(intbuf_tab%NSV(n),proc+1)/=1)THEN
4532 c_nsnr = c_nsnr + 1
4533 candr(c_nsnr) = n
4534 END IF
4535 END IF
4536 ENDIF
4537 ENDDO
4538
4539 !reflush TAG_SCRATCH to zero only when value has changes
4540#include "vectorize.inc"
4541 DO k=1,nindx_scrt
4542 n = indx_scrt(k)
4543 tag_scratch(n) = 0
4544 ENDDO
4545 nindx_scrt = 0
4546C
4547C Tris des candidats remote par proc et par nsv local croissant
4548C
4549 IF(c_nsnr>0) THEN
4550 ALLOCATE(index(2*c_nsnr))
4551 ALLOCATE(itri(2,c_nsnr))
4552 END IF
4553 DO i = 1, c_nsnr
4554 n = candr(i)
4555 itri(1,i) = cpulocal(n)
4556 itri(2,i) = nsnlocal(n)
4557 ENDDO
4558 CALL my_orders(0,work,itri,index,c_nsnr,2)
4559C
4560 DO i = 1, c_nsnr
4561 index(c_nsnr+index(i)) = i
4562 ENDDO
4563 DO i = 1, c_nsnr
4564 index(i)=index(c_nsnr+i)
4565 ENDDO
4566C
4567 ii_stok_l = 0
4568
4569 c_nsnr = 0
4570 DO k = 1, ii_stok
4571 e = intbuf_tab%CAND_E(k)
4572 IF (tag_segm2(e)/=0) THEN
4573 ii_stok_l = ii_stok_l + 1
4574 END IF
4575 END DO
4576
4577 IF(ii_stok_l>multimp*ncont)THEN
4578 multok= ii_stok_l/ncont
4579 CALL ancmsg(msgid=626,
4580 . msgtype=msgerror,
4581 . anmode=aninfo,
4582 . i1=multok,
4583 . i2=noint)
4584 ELSE
4585 ii_stok_l = 0
4586C
4587 DO k = 1, ii_stok
4588 e = intbuf_tab%CAND_E(k)
4589 IF (tag_segm2(e)/=0) THEN
4590 n = intbuf_tab%CAND_N(k)
4591 ii_stok_l = ii_stok_l + 1
4592 ibuf_e(ii_stok_l)=tag_segm2(e)
4593
4594 IF(nlocal(intbuf_tab%NSV(n),proc+1)==1) THEN
4595 ibuf_n(ii_stok_l)=nsnlocal(n)
4596 ELSE
4597C noeud remote : numerotation pre calculee ci-dessus
4598c IF(TAG(N)==0) THEN
4599 IF(tag_scratch(n)==0) THEN
4600 c_nsnr = c_nsnr + 1
4601 ibuf_n(ii_stok_l)=index(c_nsnr)+nsn_l
4602 tag_scratch(n) = index(c_nsnr)+nsn_l
4603 nindx_scrt = nindx_scrt + 1
4604 indx_scrt(nindx_scrt) = n
4605 ELSE
4606 ibuf_n(ii_stok_l) = tag_scratch(n)
4607 END IF ! TAG(N)==0
4608 END IF ! NLOCAL(INTBUF_TAB%NSV(N),PROC+1)==1
4609 ENDIF !TAG_SEGM_2(E)/=0
4610 ENDDO !K = 1, II_STOK
4611 END IF !II_STOK_L>MULTIMP*NCONT
4612
4613 !reflush TAG_SCRATCH to zero only when value has changes
4614#include "vectorize.inc"
4615 DO k=1,nindx_scrt
4616 n = indx_scrt(k)
4617 tag_scratch(n) = 0
4618 ENDDO
4619 nindx_scrt = 0
4620
4621 IF(nsn>0) DEALLOCATE(nsnlocal,cpulocal,candr)
4622 IF(c_nsnr>0) DEALLOCATE(index,itri)
4623
4624 IF(inacti==5.OR.inacti==6.OR.inacti==7)ipari_l(24,ni)= c_nsnr
4625
4626 ENDIF !END INACTI=5,6,7
4627
4628 CALL write_i_c(ibuf_e,multimp*ncont)
4629 CALL write_i_c(ibuf_n,multimp*ncont)
4630
4631 DEALLOCATE(ibuf_e,ibuf_n)
4632
4633 RETURN
4634 END
4635!||====================================================================
4636!|| split_cand_i20_edge ../starter/source/restart/ddsplit/inter_tools.F
4637!||--- called by ------------------------------------------------------
4638!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
4639!||--- calls -----------------------------------------------------
4640!|| nlocal ../starter/source/spmd/node/ddtools.F
4641!||--- uses -----------------------------------------------------
4642!|| message_mod ../starter/share/message_module/message_mod.F
4643!||====================================================================
4644 SUBROUTINE split_cand_i20_edge(PROC , INTBUF_TAB, NLINS , NLINS_L ,
4645 . TAG_NLINS2, II_STOKE , MULTIMP, NCONTE ,
4646 . NOINT , INACTI , TAG_SCRATCH ,
4647 . II_STOKE_L, IPARI_L , NI ,NINDX_SCRT ,
4648 . INDX_SCRT)
4649C-----------------------------------------------
4650C M o d u l e s
4651C-----------------------------------------------
4652 USE message_mod
4653 USE intbufdef_mod
4654C-----------------------------------------------
4655C I m p l i c i t T y p e s
4656C-----------------------------------------------
4657#include "implicit_f.inc"
4658C-----------------------------------------------
4659C C o m m o n B l o c k s
4660C-----------------------------------------------
4661#include "com01_c.inc"
4662#include "com04_c.inc"
4663#include "param_c.inc"
4664C-----------------------------------------------
4665C D u m m y A r g u m e n t s
4666C-----------------------------------------------
4667 INTEGER PROC,NLINS,NLINS_L,II_STOKE,MULTIMP,NCONTE,
4668 . TAG_NLINS2(*),NOINT,INACTI,NI,
4669 . TAG_SCRATCH(*) , II_STOKE_L , IPARI_L(NPARI,NINTER)
4670 INTEGER, INTENT(INOUT) :: NINDX_SCRT
4671 INTEGER, DIMENSION(*), INTENT(INOUT) ::INDX_SCRT
4672
4673 TYPE(intbuf_struct_) :: INTBUF_TAB
4674C-----------------------------------------------
4675C F u n c t i o n
4676C-----------------------------------------------
4677 INTEGER NLOCAL
4678 EXTERNAL nlocal
4679C-----------------------------------------------
4680C L o c a l V a r i a b l e s
4681C-----------------------------------------------
4682 INTEGER I,J,K,L,N,P,N1L,N2L,N1,N2,E,MULTOK,MSGID,
4683 . SPLIST,C_NLINSR
4684 INTEGER NUMP(NSPMD),WORK(70000)
4685
4686 INTEGER, DIMENSION(:),ALLOCATABLE ::
4687 . ibuf_e,ibuf_n,nrtslocal,cpulocal,candr,plist,
4688 . index
4689
4690 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ITRI
4691C ----------------------------------------
4692 ALLOCATE(ibuf_e(multimp*nconte),ibuf_n(multimp*nconte))
4693 ibuf_e(1:multimp*nconte) = 0
4694 ibuf_n(1:multimp*nconte) = 0
4695 ii_stoke_l = 0 !mandatory in case of inacti ne 5,6,7
4696
4697 IF(inacti==5.OR.inacti==6.OR.inacti==7) THEN
4698 IF(nlins>0) THEN
4699 ALLOCATE(nrtslocal(nlins))
4700 ALLOCATE(cpulocal(nlins))
4701 ALLOCATE(candr(nlins))
4702 END IF
4703
4704 nump(1:nspmd) = 0
4705
4706 DO k=1,nlins
4707 n1l = intbuf_tab%IXLINS(2*(k-1)+1)
4708 n2l = intbuf_tab%IXLINS(2*(k-1)+2)
4709 n1 = intbuf_tab%NLG(n1l)
4710 n2 = intbuf_tab%NLG(n2l)
4711 nrtslocal(k) = 0
4712 IF(nlocal(n1,proc+1)==1.AND.
4713 . nlocal(n2,proc+1)==1) THEN
4714 nump(proc+1) = nump(proc+1) + 1
4715 nrtslocal(k) = nump(proc+1)
4716 cpulocal(k) = proc+1
4717 END IF
4718 DO p = 1, nspmd
4719 IF(p/=proc+1.AND.nlocal(n1,p)==1.AND.
4720 . nlocal(n2,p)==1) THEN
4721 IF(nrtslocal(k)==0) THEN
4722 nump(p) = nump(p) + 1
4723 nrtslocal(k) = nump(p)
4724 cpulocal(k) = p
4725 END IF
4726 END IF
4727 END DO
4728 ENDDO
4729C
4730C Reperage des candidats se trouvant sur des procs distants
4731C
4732 !TAG_SCRATCH must have been reflush correctly to 0
4733 c_nlinsr = 0
4734 DO k = 1, ii_stoke
4735 e = intbuf_tab%LCAND_N(k)
4736 IF (tag_nlins2(e)/=0) THEN
4737 n = intbuf_tab%LCAND_S(k)
4738 IF(tag_scratch(n)==0) THEN
4739 tag_scratch(n) = 1
4740 nindx_scrt = nindx_scrt + 1
4741 indx_scrt(nindx_scrt) = n
4742 n1l = intbuf_tab%IXLINS(2*(n-1)+1)
4743 n2l = intbuf_tab%IXLINS(2*(n-1)+2)
4744 n1 = intbuf_tab%NLG(n1l)
4745 n2 = intbuf_tab%NLG(n2l)
4746 IF(cpulocal(n)/=proc+1)THEN
4747 c_nlinsr = c_nlinsr + 1
4748 candr(c_nlinsr) = n
4749 END IF
4750 END IF
4751 ENDIF
4752 ENDDO
4753
4754 !reflush TAG_SCRATCH to zero only when value has changes
4755#include "vectorize.inc"
4756 DO k=1,nindx_scrt
4757 n = indx_scrt(k)
4758 tag_scratch(n) = 0
4759 ENDDO
4760 nindx_scrt = 0
4761C
4762C Tris des candidats remote par proc et par nsv local croissant
4763C
4764 IF(c_nlinsr>0) THEN
4765 ALLOCATE(index(2*c_nlinsr))
4766 ALLOCATE(itri(2,c_nlinsr))
4767 END IF
4768 DO i = 1, c_nlinsr
4769 n = candr(i)
4770 itri(1,i) = cpulocal(n)
4771 itri(2,i) = nrtslocal(n)
4772 ENDDO
4773 CALL my_orders(0,work,itri,index,c_nlinsr,2)
4774C
4775 DO i = 1, c_nlinsr
4776 index(c_nlinsr+index(i)) = i
4777 ENDDO
4778 DO i = 1, c_nlinsr
4779 index(i)=index(c_nlinsr+i)
4780 ENDDO
4781C
4782 ii_stoke_l = 0
4783 ii_stoke_l = 0
4784 c_nlinsr = 0
4785C
4786 DO k = 1, ii_stoke
4787 e = intbuf_tab%LCAND_N(k)
4788 IF (tag_nlins2(e)/=0) THEN
4789 ii_stoke_l = ii_stoke_l + 1
4790 ibuf_e(ii_stoke_l)=tag_nlins2(e)
4791 l = intbuf_tab%LCAND_N(k)
4792 n1l = intbuf_tab%IXLINS(2*(l-1)+1)
4793 n2l = intbuf_tab%IXLINS(2*(l-1)+2)
4794 n1 = intbuf_tab%IXLINS(n1l)
4795 n2 = intbuf_tab%IXLINS(n2l)
4796 IF(cpulocal(l) == proc+1)THEN
4797 ibuf_n(ii_stoke_l)=nrtslocal(l)
4798 ELSE
4799C noeud remote : numerotation pre calculee ci-dessus
4800 IF(tag_scratch(l)==0) THEN
4801 c_nlinsr = c_nlinsr + 1
4802 ibuf_n(ii_stoke_l) = index(c_nlinsr)+nlins_l
4803 tag_scratch(l) = index(c_nlinsr)+nlins_l
4804 nindx_scrt = nindx_scrt + 1
4805 indx_scrt(nindx_scrt) = l
4806 ELSE
4807 ibuf_n(ii_stoke_l) = tag_scratch(l)
4808 END IF
4809 END IF
4810 ENDIF !TAG_NLINS2(E)/=0
4811 ENDDO !K = 1, II_STOKE
4812
4813 !reflush TAG_SCRATCH to zero only when value has changes
4814#include "vectorize.inc"
4815 DO k=1,nindx_scrt
4816 n = indx_scrt(k)
4817 tag_scratch(n) = 0
4818 ENDDO
4819 nindx_scrt = 0
4820
4821 IF(nlins>0) DEALLOCATE(nrtslocal,cpulocal,candr)
4822 IF(c_nlinsr>0) DEALLOCATE(index,itri)
4823
4824 IF(inacti==5.OR.inacti==6.OR.inacti==7) ipari_l(57,ni)= c_nlinsr
4825
4826 ENDIF !END INACTI=5,6,7
4827
4828 CALL write_i_c(ibuf_e,multimp*nconte)
4829 CALL write_i_c(ibuf_n,multimp*nconte)
4830
4831 DEALLOCATE(ibuf_e,ibuf_n)
4832
4833 RETURN
4834 END
4835C=======================================================================
4836C END SPECIFIC ROUTINES INT20
4837C=======================================================================
4838
4839C=======================================================================
4840C SPECIFIC ROUTINES INT 21
4841C=======================================================================
4842!||====================================================================
4843!|| prepare_split_i21 ../starter/source/restart/ddsplit/inter_tools.F
4844!||--- called by ------------------------------------------------------
4845!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
4846!||--- calls -----------------------------------------------------
4847!|| nlocal ../starter/source/spmd/node/ddtools.F
4848!|| plist_ifront ../starter/source/spmd/node/ddtools.F
4849!||--- uses -----------------------------------------------------
4850!|| front_mod ../starter/share/modules1/front_mod.F
4851!||====================================================================
4852 SUBROUTINE prepare_split_i21(PROC , INTBUF_TAB , IPARI ,
4853 . TAG_NODE_2RY, TAG_SEGM , TAG_NODE_2RY2,
4854 . TAG_SEGS , TAG_NODE_MSR,
4855 . TAG_SCRATCH , INTERCEP , NI, INTTH ,
4856 . NODLOCAL ,MSR_L_I21 ,MNDD_I21 ,
4857 . NINDX_SCRT ,INDX_SCRT)
4858C-----------------------------------------------
4859C M o d u l e s
4860C-----------------------------------------------
4861 USE intbufdef_mod
4862 USE front_mod
4863C-----------------------------------------------
4864C I m p l i c i t T y p e s
4865C-----------------------------------------------
4866#include "implicit_f.inc"
4867C-----------------------------------------------
4868C C o m m o n B l o c k s
4869C-----------------------------------------------
4870#include "com01_c.inc"
4871#include "com04_c.inc"
4872C-----------------------------------------------
4873C D u m m y A r g u m e n t s
4874C-----------------------------------------------
4875 INTEGER
4876 . ipari(*),ni
4877
4878 INTEGER PROC,TAG_NODE_2RY(*),TAG_SEGM(*),TAG_NODE_2RY2(*),
4879 . tag_segs(*),tag_node_msr(*),tag_scratch(*), nodlocal(*),
4880 . msr_l_i21(*),mndd_i21(*)
4881 INTEGER, INTENT(INOUT) :: NINDX_SCRT
4882 INTEGER, DIMENSION(*), INTENT(INOUT) ::INDX_SCRT
4883
4884 TYPE(intbuf_struct_) :: INTBUF_TAB
4885 TYPE(intersurfp) :: INTERCEP(3,NINTER)
4886C-----------------------------------------------
4887C F u n c t i o n
4888C-----------------------------------------------
4889 INTEGER NLOCAL
4890 EXTERNAL NLOCAL
4891C-----------------------------------------------
4892C L o c a l V a r i a b l e s
4893C-----------------------------------------------
4894
4895 INTEGER, DIMENSION(:),ALLOCATABLE :: PLIST
4896 INTEGER
4897 . nsn,nrtm,nmn,nrts,intth, nmng,flagloadp
4898
4899 INTEGER
4900 . i,j,k,l,m,n,n1,n2,n3,n4,jj,splist,
4901 . cnrtm_l,cnrts_l,cnsn_l,cnmn_l
4902C ----------------------------------------
4903 nrts = ipari(3)
4904 nrtm = ipari(4)
4905 nsn = ipari(5)
4906 nmn = ipari(6)
4907 nmng = ipari(8)
4908 flagloadp = ipari(95)
4909
4910 cnrts_l = 0
4911 DO k=1,nrts
4912 IF(intercep(1,ni)%P(k)==proc+1)THEN
4913 cnrts_l = cnrts_l + 1
4914 tag_segs(cnrts_l) = k
4915 ENDIF
4916 ENDDO
4917
4918 cnsn_l = 0
4919 DO k=1, nsn
4920 n=intbuf_tab%NSV(k)
4921 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0) THEN
4922 cnsn_l = cnsn_l+1
4923 tag_node_2ry(cnsn_l) = k
4924 tag_node_2ry2(k) = cnsn_l
4925 tag_scratch(n)=1
4926 nindx_scrt = nindx_scrt + 1
4927 indx_scrt(nindx_scrt) = n
4928 ENDIF
4929 ENDDO
4930
4931 !reflush to zero only part of TAG_SCRATCH that has been used
4932#include "vectorize.inc"
4933 DO k=1,nindx_scrt
4934 n = indx_scrt(k)
4935 tag_scratch(n) = 0
4936 ENDDO
4937 nindx_scrt = 0
4938
4939 cnrtm_l = 0
4940 DO k=1,nrtm
4941 cnrtm_l = cnrtm_l + 1
4942 tag_segm(cnrtm_l) = k
4943 ENDDO
4944
4945 cnmn_l = 0
4946 DO i=1,nmn
4947 n = intbuf_tab%MSR(i)
4948 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0) THEN
4949 cnmn_l = cnmn_l + 1
4950 tag_node_msr(cnmn_l) = i
4951 tag_scratch(n)=1
4952 nindx_scrt = nindx_scrt + 1
4953 indx_scrt(nindx_scrt) = n
4954 ENDIF
4955 ENDDO
4956
4957 !reflush to zero only part of TAG_SCRATCH that has been used
4958#include "vectorize.inc"
4959 DO k=1,nindx_scrt
4960 n = indx_scrt(k)
4961 tag_scratch(n) = 0
4962 ENDDO
4963 nindx_scrt = 0
4964
4965 !PREPARE MNDD TAB FOR main TEMPERATURE COMMUNICATION
4966 ALLOCATE(plist(nspmd))
4967 plist(1:nspmd) = -1
4968 IF (intth == 2.OR.flagloadp > 0) THEN
4969 DO k=1,nmng
4970 n = intbuf_tab%MSR(k)
4971 IF(nlocal(n,proc+1)==1) THEN
4972 ! node on domain
4973 mndd_i21(k) = 0
4974 ELSE
4975 ! node is not on domain, set value to first domain of node
4976 CALL plist_ifront(plist,n,splist)
4977 mndd_i21(k) = plist(1)
4978 ENDIF
4979 END DO
4980 ENDIF
4981 DEALLOCATE(plist)
4982 ! PREPARE MSRL TAB FOR LOCAL NODES NUMBERING==> main TEMPERATURE COMMUNICATION
4983 IF (intth == 2.OR.flagloadp > 0) THEN
4984 msr_l_i21(1:nmng)=0
4985 DO i=1,nmng
4986 n = intbuf_tab%MSR(i)
4987 IF(nlocal(n,proc+1)==1) THEN
4988 msr_l_i21(i) = nodlocal(n)
4989 ENDIF
4990 END DO
4991 ENDIF
4992
4993 RETURN
4994 END
4995!||====================================================================
4996!|| split_cand_ival_i21 ../starter/source/restart/ddsplit/inter_tools.F
4997!||--- called by ------------------------------------------------------
4998!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
4999!||--- calls -----------------------------------------------------
5000!||--- uses -----------------------------------------------------
5001!||====================================================================
5002 SUBROUTINE split_cand_ival_i21(TAB , II_STOK_L, TAG_II,
5003 . DIM1, DIM2 )
5004C introduce a second dimension
5005C-----------------------------------------------
5006C M o d u l e s
5007C-----------------------------------------------
5008 USE intbufdef_mod
5009C-----------------------------------------------
5010C I m p l i c i t T y p e s
5011C-----------------------------------------------
5012#include "implicit_f.inc"
5013C-----------------------------------------------
5014C D u m m y A r g u m e n t s
5015C-----------------------------------------------
5016 INTEGER TAB(*),TAG_II(*),II_STOK_L,MULTIMP,NCONT,
5017 . dim1,dim2
5018C-----------------------------------------------
5019C L o c a l V a r i a b l e s
5020C-----------------------------------------------
5021 INTEGER I,J,K
5022 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
5023C ----------------------------------------
5024 ALLOCATE(ibuf(dim1*dim2))
5025 ibuf(1:dim1*dim2) = 0
5026
5027 DO i=1,ii_stok_l
5028 k=tag_ii(i)
5029 DO j=1,dim2
5030 ibuf(dim2*(i-1)+j) = tab(dim2*(k-1)+j)
5031 ENDDO
5032 ENDDO
5033
5034 CALL write_i_c(ibuf,dim1*dim2)
5035 DEALLOCATE(ibuf)
5036
5037 RETURN
5038 END
5039!||====================================================================
5040!|| split_2ry_cand_ival_i21 ../starter/source/restart/ddsplit/inter_tools.F
5041!||--- called by ------------------------------------------------------
5042!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5043!||--- calls -----------------------------------------------------
5044!||--- uses -----------------------------------------------------
5045!||====================================================================
5046 SUBROUTINE split_2ry_cand_ival_i21(TAB , II_STOK_L, TAG_II,TAG_NODE_2RY2,
5047 . DIM1 )
5048C introduce a second dimension
5049C-----------------------------------------------
5050C M o d u l e s
5051C-----------------------------------------------
5052 USE intbufdef_mod
5053C-----------------------------------------------
5054C I m p l i c i t T y p e s
5055C-----------------------------------------------
5056#include "implicit_f.inc"
5057C-----------------------------------------------
5058C D u m m y A r g u m e n t s
5059C-----------------------------------------------
5060 INTEGER TAB(*),TAG_II(*),II_STOK_L,
5061 . dim1,tag_node_2ry2(*)
5062C-----------------------------------------------
5063C L o c a l V a r i a b l e s
5064C-----------------------------------------------
5065 INTEGER I,J,K,N
5066 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
5067C ----------------------------------------
5068 ALLOCATE(ibuf(dim1))
5069 ibuf(1:dim1) = 0
5070
5071 DO i=1,ii_stok_l
5072 k=tag_ii(i)
5073 n = tab(k)
5074 ibuf(i) = tag_node_2ry2(n)
5075 ENDDO
5076
5077 CALL write_i_c(ibuf,dim1)
5078 DEALLOCATE(ibuf)
5079
5080 RETURN
5081 END
5082!||====================================================================
5083!|| prepare_split_cand_i21 ../starter/source/restart/ddsplit/inter_tools.F
5084!||--- called by ------------------------------------------------------
5085!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5086!||--- calls -----------------------------------------------------
5087!|| nlocal ../starter/source/spmd/node/ddtools.F
5088!||--- uses -----------------------------------------------------
5089!||====================================================================
5090 SUBROUTINE prepare_split_cand_i21(INTBUF_TAB, TAG_NODE_2RY2, II_STOK, TAG_II,C_II,PROC)
5091C-----------------------------------------------
5092C M o d u l e s
5093C-----------------------------------------------
5094 USE intbufdef_mod
5095C-----------------------------------------------
5096C I m p l i c i t T y p e s
5097C-----------------------------------------------
5098#include "implicit_f.inc"
5099C-----------------------------------------------
5100C D u m m y A r g u m e n t s
5101C-----------------------------------------------
5102 INTEGER TAG_NODE_2RY2(*),TAG_II(*),II_STOK, PROC
5103
5104 TYPE(intbuf_struct_) :: INTBUF_TAB
5105C-----------------------------------------------
5106C F u n c t i o n
5107C-----------------------------------------------
5108 INTEGER NLOCAL
5109 EXTERNAL nlocal
5110C-----------------------------------------------
5111C L o c a l V a r i a b l e s
5112C-----------------------------------------------
5113 INTEGER
5114 . K,M,N,C_II
5115C ----------------------------------------
5116
5117! prepare split candidates
5118 c_ii = 0
5119 DO k = 1, ii_stok
5120 m = intbuf_tab%CAND_N(k)
5121 n = intbuf_tab%NSV(m)
5122 IF (nlocal(n,proc+1)==1) THEN
5123 IF(abs(intbuf_tab%IRTLM(2*(m-1)+1))==intbuf_tab%CAND_E(k)) THEN
5124 c_ii = c_ii + 1
5125 tag_ii(c_ii) = k
5126 ENDIF
5127 ENDIF
5128 ENDDO
5129
5130 RETURN
5131 END
5132C=======================================================================
5133C END SPECIFIC ROUTINES INT21
5134C=======================================================================
5135
5136C=======================================================================
5137C SPECIFIC ROUTINES INT 24
5138C=======================================================================
5139!||====================================================================
5140!|| prepare_split_i24 ../starter/source/restart/ddsplit/inter_tools.F
5141!||--- called by ------------------------------------------------------
5142!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5143!||--- calls -----------------------------------------------------
5144!|| nlocal ../starter/source/spmd/node/ddtools.F
5145!|| secnd_surface_on_domain ../starter/source/interfaces/inter3d1/i24setnodes.F
5146!||--- uses -----------------------------------------------------
5147!|| front_mod ../starter/share/modules1/front_mod.F
5148!||====================================================================
5149 SUBROUTINE prepare_split_i24(PROC , INTBUF_TAB , IPARI ,
5150 . INTERCEP , TAG_NODE_2RY, TAG_SEGM ,
5151 . TAG_SEGM2, TAG_NM , TAG_NODE_MSR,
5152 . TAG_SCRATCH,NODLOCAL24 ,NODLOCAL,
5153 . INTERCEP2,
5154 . NUMNOD_L,TAG_NSNE,TAG_SEGS,TAG_SEGS2,NI,TAG_2RY_INV,
5155 . IEDGE4,TAG_NODE_2RY2,TAG_IELEM,CEP,CEL,TAG_SEGSS,
5156 . NINDX_NM,INDX_NM,NINDX_SCRT,INDX_SCRT,
5157 . NINDX_NDLOCAL24,INDX_NDLOCAL24,INTERCEP3)
5158C-----------------------------------------------
5159C M o d u l e s
5160C-----------------------------------------------
5161 USE intbufdef_mod
5162 USE front_mod
5163C-----------------------------------------------
5164C I m p l i c i t T y p e s
5165C-----------------------------------------------
5166#include "implicit_f.inc"
5167C-----------------------------------------------
5168C C o m m o n B l o c k s
5169C-----------------------------------------------
5170#include "com04_c.inc"
5171C-----------------------------------------------
5172C D u m m y A r g u m e n t s
5173C-----------------------------------------------
5174 TYPE(intbuf_struct_) :: INTBUF_TAB
5175 TYPE(INTERSURFP) :: INTERCEP,INTERCEP2,INTERCEP3
5176
5177 INTEGER PROC,INTNITSCHE,IPARI(*),
5178 . TAG_NODE_2RY(*),TAG_SEGM(*),TAG_NM(*),TAG_NODE_MSR(*),
5179 . TAG_SEGM2(*),TAG_SCRATCH(*),NODLOCAL24(*) ,NODLOCAL(*),
5180 . numnod_l,tag_nsne(*),tag_segs(*),tag_segs2(*),ni,tag_2ry_inv(*),iedge4,
5181 . tag_node_2ry2(*),tag_ielem(*),cep(*),cel(*),tag_segss(*)
5182 INTEGER, INTENT(INOUT) ::NINDX_NM,NINDX_SCRT,NINDX_NDLOCAL24
5183 INTEGER, DIMENSION(*), INTENT(INOUT) ::INDX_NM,INDX_SCRT,INDX_NDLOCAL24
5184! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
5185! NODLOCAL : integer, dimension=NUMNOD
5186! gives the local ID of a global element
5187! --> used here to avoid NLOCAL call (the NLOCAL perf is bad)
5188! NODLOCAL /= 0 if the element is on the current domain/processor
5189! and =0 if the element is not on the current domain
5190! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
5191
5192C-----------------------------------------------
5193C F u n c t i o n
5194C-----------------------------------------------
5195 INTEGER NLOCAL
5196 EXTERNAL NLOCAL
5197C-----------------------------------------------
5198C L o c a l V a r i a b l e s
5199C-----------------------------------------------
5200 INTEGER
5201 . NSN,NRTM,NMN,NRTS,
5202 . I,J,K,N,N1,N2,N3,N4,E,IE,IE_LOC,PROC2,
5203 . CNSN_L,CNRTM_L,CNMN_L,NRTSE,NSNE,NSN0,NSNE_COUNT,SE1,
5204 . cnrts_l
5205 INTEGER
5206 . secnd_surface_on_domain,nrtse_count
5207 EXTERNAL secnd_surface_on_domain
5208C ----------------------------------------
5209 nrts = ipari(3)
5210 nrtm = ipari(4)
5211 nsn = ipari(5)
5212 nmn = ipari(6)
5213 nrtse= ipari(52)
5214 nsne = ipari(55)
5215 nsn0 = nsn - nsne
5216 intnitsche = ipari(86)
5217
5218 cnsn_l = 0
5219 DO k=1, nsn0
5220 n=intbuf_tab%NSV(k)
5221 IF( (nodlocal(n)/=0.AND.nodlocal(n)<=numnod_l)
5222 + .AND.tag_scratch(n)==0) THEN
5223 cnsn_l = cnsn_l+1
5224 tag_node_2ry(cnsn_l) = k
5225 IF(iedge4 > 0) tag_2ry_inv(k)=cnsn_l
5226 tag_scratch(n)=1
5227 nindx_scrt = nindx_scrt + 1
5228 indx_scrt(nindx_scrt) = n
5229 ENDIF
5230 ENDDO
5231
5232 DO k=1+nsn0, nsne+nsn0
5233 n=intbuf_tab%NSV(k)-numnod
5234 se1 = intbuf_tab%IS2SE(2*(n-1)+1)
5235 IF (intercep2%P(se1)==proc+1)THEN
5236 cnsn_l = cnsn_l+1
5237 tag_node_2ry(cnsn_l) = k
5238 tag_2ry_inv(k)=cnsn_l
5239 ENDIF
5240 ENDDO
5241
5242 !reflush to zero only part of TAG_SCRATCH that has been used
5243#include "vectorize.inc"
5244 DO k=1,nindx_scrt
5245 n = indx_scrt(k)
5246 tag_scratch(n) = 0
5247 ENDDO
5248 nindx_scrt = 0
5249
5250
5251
5252! prepare SPLIT_NRTM_R
5253 cnrtm_l = 0
5254 DO k=1,nrtm
5255 n1 = intbuf_tab%IRECTM(4*(k-1)+1)
5256 n2 = intbuf_tab%IRECTM(4*(k-1)+2)
5257 n3 = intbuf_tab%IRECTM(4*(k-1)+3)
5258 n4 = intbuf_tab%IRECTM(4*(k-1)+4)
5259 IF(intercep%P(k)==proc+1)THEN
5260 cnrtm_l = cnrtm_l + 1
5261 tag_segm(cnrtm_l) = k
5262 tag_segm2(k) = cnrtm_l
5263 IF(tag_nm(n1)==0)THEN
5264 tag_nm(n1)=1
5265 nindx_nm = nindx_nm + 1
5266 indx_nm(nindx_nm) = n1
5267 ENDIF
5268 IF(tag_nm(n2)==0)THEN
5269 tag_nm(n2)=1
5270 nindx_nm = nindx_nm + 1
5271 indx_nm(nindx_nm) = n2
5272 ENDIF
5273 IF(tag_nm(n3)==0)THEN
5274 tag_nm(n3)=1
5275 nindx_nm = nindx_nm + 1
5276 indx_nm(nindx_nm) = n3
5277 ENDIF
5278 IF(tag_nm(n4)==0)THEN
5279 tag_nm(n4)=1
5280 nindx_nm = nindx_nm + 1
5281 indx_nm(nindx_nm) = n4
5282 ENDIF
5283 ENDIF
5284 ENDDO
5285
5286 cnmn_l = 0
5287 DO i=1,nmn
5288 n = intbuf_tab%MSR(i)
5289 IF(tag_nm(n)==1)THEN
5290 cnmn_l = cnmn_l + 1
5291 tag_node_msr(cnmn_l) = i
5292 ENDIF
5293 ENDDO
5294
5295 DO i=1,cnsn_l
5296 n = tag_node_2ry(i)
5297 tag_node_2ry2(n) = i
5298 ENDDO
5299
5300
5301
5302! NODLOCAL24(1:NUMNOD)=NODLOCAL(1:NUMNOD)
5303C Prepare Node ID with virtual Type 24 E2E Nodes
5304 IF (nsne > 0 ) THEN
5305
5306 nsne_count=0
5307
5308
5309 DO i = 1,nsne
5310
5311C Get First IS2SE surface
5312C If Surface is on P, than speudo node is on pocessor.
5313C Give him NODLOCAL ID (+NUMNOD_L).
5314C Evt set TAG array
5315 se1 = intbuf_tab%IS2SE(2*(i-1)+1)
5316 IF (intercep2%P(se1)==proc+1)THEN
5317 nsne_count=nsne_count+1
5318 nodlocal24(numnod+i) = numnod_l + nsne_count
5319 nindx_ndlocal24 = nindx_ndlocal24 + 1
5320 indx_ndlocal24(nindx_ndlocal24) = numnod+i
5321 tag_nsne(nsne_count)=i
5322 ENDIF
5323 END DO
5324
5325 nrtse_count=0
5326 DO i = 1,nrtse
5327 IF(intercep2%P(i)==proc+1)THEN
5328 nrtse_count=nrtse_count+1
5329 tag_segs(nrtse_count)=i
5330 tag_segs2(i)=nrtse_count
5331 ENDIF
5332 ENDDO
5333
5334
5335 END IF
5336C Nitsche Method
5337
5338 IF(intnitsche > 0) THEN
5339
5340! prepare SPLIT_NRTM_R
5341 cnrts_l = 0
5342 DO k=1,nrts
5343 IF(intercep3%P(k)==proc+1)THEN
5344 cnrts_l = cnrts_l + 1
5345 tag_segss(cnrts_l) = k
5346 ENDIF
5347 ENDDO
5348
5349 !TAG_IELEM for IELNRTS tab writing
5350
5351 DO i = 1, cnrts_l ! NRTS = NRTM only if NRT_SH = 0
5352 k = tag_segss(i)
5353 ie = intbuf_tab%IELNRTS(k)
5354c PROC2 = CEP(IE)
5355c IF(PROC2==PROC) THEN
5356 ie_loc = cel(ie)
5357 tag_ielem(i) = ie_loc
5358c ENDIF
5359 ENDDO
5360 ENDIF
5361
5362
5363 RETURN
5364 END
5365!||====================================================================
5366!|| split_node_ival_i24 ../starter/source/restart/ddsplit/inter_tools.F
5367!||--- called by ------------------------------------------------------
5368!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5369!||--- calls -----------------------------------------------------
5370!||--- uses -----------------------------------------------------
5371!||====================================================================
5372 SUBROUTINE split_node_ival_i24(TAB,DIM1,TAG,TAG2)
5373c
5374c split node array with global value specific type24 & type25
5375c (see SPLIT_NODE_NODLOC for local values)
5376c
5377C-----------------------------------------------
5378C M o d u l e s
5379C-----------------------------------------------
5380 USE intbufdef_mod
5381C-----------------------------------------------
5382C I m p l i c i t T y p e s
5383C-----------------------------------------------
5384#include "implicit_f.inc"
5385C-----------------------------------------------
5386C D u m m y A r g u m e n t s
5387C-----------------------------------------------
5388 INTEGER TAB(*),DIM1,TAG(*),TAG2(*)
5389C-----------------------------------------------
5390C L o c a l V a r i a b l e s
5391C-----------------------------------------------
5392 INTEGER I,K,N
5393 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
5394C ----------------------------------------
5395 ALLOCATE(ibuf(dim1))
5396
5397 DO i=1, dim1
5398 k=tag(i)
5399 n = tab(k)
5400 IF(n>0)THEN
5401 ibuf(i) = tag2(n)
5402 ELSEIF(n<0)THEN
5403 ibuf(i) = -tag2(-n)
5404 ELSE
5405 ibuf(i) = 0
5406 ENDIF
5407 ENDDO
5408
5409 CALL write_i_c(ibuf,dim1)
5410 DEALLOCATE(ibuf)
5411
5412 RETURN
5413 END
5414!||====================================================================
5415!|| split_seg_nodloc_i24 ../starter/source/restart/ddsplit/inter_tools.F
5416!||--- called by ------------------------------------------------------
5417!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5418!||--- calls -----------------------------------------------------
5419!||--- uses -----------------------------------------------------
5420!||====================================================================
5421 SUBROUTINE split_seg_nodloc_i24(TAB,DIM1,DIM2,TAG_SEG,NODLOCAL)
5422C-----------------------------------------------
5423C M o d u l e s
5424C-----------------------------------------------
5425 USE intbufdef_mod
5426C-----------------------------------------------
5427C I m p l i c i t T y p e s
5428C-----------------------------------------------
5429#include "implicit_f.inc"
5430C-----------------------------------------------
5431C D u m m y A r g u m e n t s
5432C-----------------------------------------------
5433 INTEGER TAB(*),TAG_SEG(*),DIM1,DIM2,NODLOCAL(*)
5434C-----------------------------------------------
5435C L o c a l V a r i a b l e s
5436C-----------------------------------------------
5437 INTEGER I,J,K,N
5438 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
5439C ----------------------------------------
5440 ALLOCATE(ibuf(dim1*dim2))
5441 DO i=1, dim1
5442 k=tag_seg(i)
5443 DO j=1,dim2
5444 n = tab(dim2*(k-1)+j)
5445
5446 IF(n>0)THEN
5447 ibuf(dim2*(i-1)+j) = nodlocal(n)
5448 ELSEIF(n<0)THEN
5449 ibuf(dim2*(i-1)+j) = -nodlocal(-n)
5450 ELSE
5451 ibuf(dim2*(i-1)+j) = 0
5452 ENDIF
5453 ENDDO
5454 ENDDO
5455 CALL write_i_c(ibuf,dim1*dim2)
5456 DEALLOCATE(ibuf)
5457
5458 RETURN
5459 END
5460!||====================================================================
5461!|| split_segedge_nodloc_i24 ../starter/source/restart/ddsplit/inter_tools.F
5462!||--- called by ------------------------------------------------------
5463!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5464!||--- calls -----------------------------------------------------
5465!||--- uses -----------------------------------------------------
5466!||====================================================================
5467 SUBROUTINE split_segedge_nodloc_i24(TAB,DIM1,TAG_SEG,NODLOCAL,NI)
5468C-----------------------------------------------
5469C M o d u l e s
5470C-----------------------------------------------
5471 USE intbufdef_mod
5472C-----------------------------------------------
5473C I m p l i c i t T y p e s
5474C-----------------------------------------------
5475#include "implicit_f.inc"
5476C-----------------------------------------------
5477C D u m m y A r g u m e n t s
5478C-----------------------------------------------
5479 INTEGER TAB(5,*),TAG_SEG(*),DIM1,DIM2,NODLOCAL(*)
5480C-----------------------------------------------
5481C L o c a l V a r i a b l e s
5482C-----------------------------------------------
5483 INTEGER I,J,K,N1,N2,N3,N4,NI
5484 INTEGER, DIMENSION(:,:),ALLOCATABLE :: IBUF
5485C ----------------------------------------
5486 ALLOCATE(ibuf(5,dim1))
5487 DO i=1, dim1
5488 k=tag_seg(i)
5489 n1 = tab(1,k)
5490 n2 = tab(2,k)
5491 n3 = tab(3,k)
5492 n4 = tab(4,k)
5493
5494 ibuf(1,i)=nodlocal(n1)
5495 ibuf(2,i)=nodlocal(n2)
5496 ibuf(3,i)=nodlocal(n3)
5497 ibuf(4,i)=nodlocal(n4)
5498
5499 ibuf(5,i)=tab(5,k)
5500 ENDDO
5501
5502 CALL write_i_c(ibuf,dim1*5)
5503
5504 DEALLOCATE(ibuf)
5505
5506 RETURN
5507 END
5508!||====================================================================
5509!|| split_cand_i24 ../starter/source/restart/ddsplit/inter_tools.F
5510!||--- called by ------------------------------------------------------
5511!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5512!||--- calls -----------------------------------------------------
5513!|| ancmsg ../starter/source/output/message/message.F
5514!|| plist_ifront ../starter/source/spmd/node/ddtools.F
5515!||--- uses -----------------------------------------------------
5516!|| front_mod ../starter/share/modules1/front_mod.F
5517!|| message_mod ../starter/share/message_module/message_mod.F
5518!||====================================================================
5519 SUBROUTINE split_cand_i24(PROC , INTBUF_TAB, NSN , NSN_L ,
5520 . TAG_SEGM2, II_STOK , MULTIMP, NCONT ,
5521 . NOINT , INACTI , TAG_SCRATCH ,II_STOK_L,
5522 . INTERCEP2, NINDX_SCRT, INDX_SCRT ,NODLOCAL ,
5523 . NUMNOD_L)
5524C-----------------------------------------------
5525C M o d u l e s
5526C-----------------------------------------------
5527 USE message_mod
5528 USE intbufdef_mod
5529 USE front_mod
5530C-----------------------------------------------
5531C I m p l i c i t T y p e s
5532C-----------------------------------------------
5533#include "implicit_f.inc"
5534C-----------------------------------------------
5535C C o m m o n B l o c k s
5536C-----------------------------------------------
5537#include "com01_c.inc"
5538#include "com04_c.inc"
5539C-----------------------------------------------
5540C D u m m y A r g u m e n t s
5541C-----------------------------------------------
5542 INTEGER PROC,NSN,NSN_L,II_STOK,MULTIMP,NCONT,
5543 . tag_segm2(*),noint,inacti,
5544 . tag_scratch(*) , ii_stok_l, ityp
5545 INTEGER, INTENT(INOUT) :: NINDX_SCRT
5546 INTEGER, INTENT(IN) :: NUMNOD_L
5547 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_SCRT
5548 INTEGER, DIMENSION(*), INTENT(IN) :: NODLOCAL
5549
5550 TYPE(intbuf_struct_) :: INTBUF_TAB
5551 TYPE(INTERSURFP) :: INTERCEP2
5552! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
5553! INDX_XXX : size = NUMNOD
5554! index of non-zero TAG_XXX value
5555! used for optimize the initialization
5556! of TAG_XXX array (XXX = NM or SCRT for SCRATCH)
5557! allocated array in lectur and threadprivate array
5558! NINDX_XXX : number of non-zero TAG_XXX value
5559! TAG_XXX : size = NUMNOD + NUMELS + I24MAXNSNE2
5560! array used to tag an element for
5561! a given interface ; allocated in lectur
5562! allocated array in lectur and threadprivate array
5563! NODLOCAL : integer, dimension=NUMNOD
5564! gives the local ID of a global element
5565! --> used here to avoid nlocal call (the nlocal perf is bad)
5566! NODLOCAL /= 0 if the element is on the current domain/processor
5567! and =0 if the element is not on the current domain
5568! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
5569C-----------------------------------------------
5570C F u n c t i o n
5571C-----------------------------------------------
5572! INTEGER NLOCAL
5573! EXTERNAL NLOCAL
5574C-----------------------------------------------
5575C L o c a l V a r i a b l e s
5576C-----------------------------------------------
5577 INTEGER I,J,K,N,P,E,MULTOK,MSGID,
5578 . splist,c_nsnr,nn,se1,my_node
5579 INTEGER NUMP(NSPMD),WORK(70000)
5580
5581 INTEGER, DIMENSION(:),ALLOCATABLE ::
5582 . ibuf_e,ibuf_n,nsnlocal,cpulocal,candr,plist,
5583 . index
5584
5585 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ITRI
5586 LOGICAL CONDITION
5587C ----------------------------------------
5588C w to be done :modif w/ edge
5589C ----------------------------------------
5590 ALLOCATE(ibuf_e(multimp*ncont),ibuf_n(multimp*ncont))
5591 ibuf_e(1:multimp*ncont) = 0
5592 ibuf_n(1:multimp*ncont) = 0
5593 ii_stok_l = 0 !mandatory in case of inacti ne 5,6,7
5594
5595 IF(nsn>0) THEN
5596 ALLOCATE(nsnlocal(nsn))
5597 ALLOCATE(cpulocal(nsn))
5598 ALLOCATE(candr(nsn))
5599 END IF
5600
5601 nump(1:nspmd) = 0
5602
5603 ALLOCATE(plist(nspmd))
5604 plist(1:nspmd) = -1
5605 DO k=1,nsn
5606 n = intbuf_tab%NSV(k)
5607 nsnlocal(k) = 0
5608 IF(tag_scratch(n)==0) THEN
5609 splist=0
5610 IF(n<=numnod)THEN
5611 CALL plist_ifront(plist,n,splist)
5612 DO i=1,splist
5613 p=plist(i)
5614 nump(p) = nump(p)+1
5615 ENDDO
5616 IF( nodlocal( n )/=0.AND.nodlocal(n)<=numnod_l ) THEN
5617 nsnlocal(k) = nump(proc+1)
5618 cpulocal(k) = proc+1
5619 ELSE
5620 p = plist(1)
5621 nsnlocal(k) = nump(p)
5622 cpulocal(k) = p
5623 ENDIF
5624 ELSE
5625C T24 E2E Nodes can be on 1 SPMD domain only
5626 nn = n - numnod
5627 se1 = intbuf_tab%IS2SE(2*(nn-1)+1)
5628 p = intercep2%P(se1)
5629 nump(p) = nump(p)+1
5630 nsnlocal(k) = nump(p)
5631 cpulocal(k) = p
5632 ENDIF
5633
5634 tag_scratch(n) = 1
5635 nindx_scrt = nindx_scrt + 1
5636 indx_scrt(nindx_scrt) = n
5637 ENDIF
5638 ENDDO
5639 DEALLOCATE(plist)
5640
5641 !reflush TAG_SCRATCH to zero only when value has changes
5642#include "vectorize.inc"
5643 DO k=1,nindx_scrt
5644 n = indx_scrt(k)
5645 tag_scratch(n) = 0
5646 ENDDO
5647 nindx_scrt = 0
5648C
5649C Reperage des candidats se trouvant sur des procs distants
5650C
5651 c_nsnr = 0
5652
5653 DO k = 1, ii_stok
5654 e = intbuf_tab%CAND_E(k)
5655 IF (tag_segm2(e)/=0) THEN
5656 n = intbuf_tab%CAND_N(k)
5657C IF (INTBUF_TAB%NSV(N)> NUMNOD) CYCLE
5658 IF(tag_scratch(n)==0) THEN
5659 tag_scratch(n) = 1
5660 nindx_scrt = nindx_scrt + 1
5661 indx_scrt(nindx_scrt) = n
5662 IF(intbuf_tab%NSV(n) <= numnod)THEN
5663 my_node = intbuf_tab%NSV(n)
5664 IF( nodlocal( my_node ) ==0.OR.nodlocal( my_node )>numnod_l ) THEN
5665 c_nsnr = c_nsnr + 1
5666 candr(c_nsnr) = n
5667 END IF
5668 ELSE
5669 nn = intbuf_tab%NSV(n) - numnod
5670 se1 = intbuf_tab%IS2SE(2*(nn-1)+1)
5671 p = intercep2%P(se1)
5672 IF(p/= (proc+1) ) THEN
5673 c_nsnr = c_nsnr + 1
5674 candr(c_nsnr) = n
5675 ENDIF
5676 ENDIF
5677 END IF
5678 ENDIF
5679 ENDDO
5680
5681 !reflush TAG_SCRATCH to zero only when value has changes
5682#include "vectorize.inc"
5683 DO k=1,nindx_scrt
5684 n = indx_scrt(k)
5685 tag_scratch(n) = 0
5686 ENDDO
5687 nindx_scrt = 0
5688C
5689C Tris des candidats remote par proc et par nsv local croissant
5690C
5691 IF(c_nsnr>0) THEN
5692 ALLOCATE(index(2*c_nsnr))
5693 ALLOCATE(itri(2,c_nsnr))
5694 END IF
5695 DO i = 1, c_nsnr
5696 n = candr(i)
5697 itri(1,i) = cpulocal(n)
5698 itri(2,i) = nsnlocal(n)
5699 ENDDO
5700 CALL my_orders(0,work,itri,index,c_nsnr,2)
5701C
5702 DO i = 1, c_nsnr
5703 index(c_nsnr+index(i)) = i
5704 ENDDO
5705 DO i = 1, c_nsnr
5706 index(i)=index(c_nsnr+i)
5707 ENDDO
5708C
5709 ii_stok_l = 0
5710
5711 c_nsnr = 0
5712 DO k = 1, ii_stok
5713 e = intbuf_tab%CAND_E(k)
5714 IF (tag_segm2(e)/=0) THEN
5715 ii_stok_l = ii_stok_l + 1
5716 END IF
5717 END DO
5718
5719 IF(ii_stok_l>multimp*ncont)THEN
5720 multok= ii_stok_l/ncont
5721 CALL ancmsg(msgid=626,
5722 . msgtype=msgerror,
5723 . anmode=aninfo,
5724 . i1=multok,
5725 . i2=noint)
5726 ELSE
5727 ii_stok_l = 0
5728C
5729 DO k = 1, ii_stok
5730 e = intbuf_tab%CAND_E(k)
5731 IF (tag_segm2(e)/=0) THEN
5732 n = intbuf_tab%CAND_N(k)
5733 ii_stok_l = ii_stok_l + 1
5734 ibuf_e(ii_stok_l)=tag_segm2(e)
5735 IF (intbuf_tab%NSV(n)>numnod) THEN
5736 nn = intbuf_tab%NSV(n)-numnod
5737 se1 = intbuf_tab%IS2SE(2*(nn-1)+1)
5738 p=0
5739 IF(intercep2%P(se1)==(proc+1)) p=1
5740 ELSE
5741 p = 0
5742 my_node = intbuf_tab%NSV(n)
5743 IF( nodlocal( my_node )/=0.AND.nodlocal( my_node )<=numnod_l ) p=1
5744 ENDIF
5745
5746 IF(p==1 ) THEN
5747 ibuf_n(ii_stok_l)=nsnlocal(n)
5748 ELSE
5749C noeud remote : numerotation pre calculee ci-dessus
5750c IF(TAG(N)==0) THEN
5751 IF(tag_scratch(n)==0) THEN
5752 c_nsnr = c_nsnr + 1
5753 ibuf_n(ii_stok_l)=index(c_nsnr)+nsn_l
5754 tag_scratch(n) = index(c_nsnr)+nsn_l
5755 nindx_scrt = nindx_scrt + 1
5756 indx_scrt(nindx_scrt) = n
5757 ELSE
5758 ibuf_n(ii_stok_l) = tag_scratch(n)
5759 END IF ! TAG(N)==0
5760 END IF ! NLOCAL(INTBUF_TAB%NSV(N),PROC+1)==1
5761 ENDIF !TAG_SEGM_2(E)/=0
5762 ENDDO !K = 1, II_STOK
5763 END IF !II_STOK_L>MULTIMP*NCONT
5764
5765 !reflush TAG_SCRATCH to zero only when value has changes
5766#include "vectorize.inc"
5767 DO k=1,nindx_scrt
5768 n = indx_scrt(k)
5769 tag_scratch(n) = 0
5770 ENDDO
5771 nindx_scrt = 0
5772
5773 IF(nsn>0) DEALLOCATE(nsnlocal,cpulocal,candr)
5774 IF(c_nsnr>0) DEALLOCATE(index,itri)
5775
5776
5777 CALL write_i_c(ibuf_e,multimp*ncont)
5778 CALL write_i_c(ibuf_n,multimp*ncont)
5779
5780 DEALLOCATE(ibuf_e,ibuf_n)
5781
5782 RETURN
5783 END
5784C
5785!||====================================================================
5786!|| split_seg_edge ../starter/source/restart/ddsplit/inter_tools.F
5787!||--- called by ------------------------------------------------------
5788!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5789!||--- calls -----------------------------------------------------
5790!||====================================================================
5791 SUBROUTINE split_seg_edge(NSNE_L,IS2SE,TAG_NSNE,TAG_SEG2,NI)
5792C-----------------------------------------------
5793C I m p l i c i t T y p e s
5794C-----------------------------------------------
5795#include "implicit_f.inc"
5796C-----------------------------------------------
5797C D u m m y A r g u m e n t s
5798C-----------------------------------------------
5799 INTEGER IS2SE(2,*),NSNE_L,TAG_NSNE(*),TAG_SEG2(*)
5800C-----------------------------------------------
5801C L o c a l V a r i a b l e s
5802C-----------------------------------------------
5803 INTEGER I,SEG,SE1,SE2,NI
5804 INTEGER, DIMENSION(:,:),ALLOCATABLE :: IBUF
5805C-----------------------------------------------
5806 ALLOCATE(ibuf(2,nsne_l))
5807 DO i=1,nsne_l
5808 seg=tag_nsne(i)
5809 se1 = is2se(1,seg)
5810 se2 = is2se(2,seg)
5811 ibuf(1,i)=tag_seg2(se1)
5812
5813 IF(se2 /=0)THEN
5814 ibuf(2,i)=tag_seg2(se2)
5815 ELSE
5816 ibuf(2,i)=0
5817 ENDIF
5818 ENDDO
5819 CALL write_i_c(ibuf,2*nsne_l)
5820
5821 DEALLOCATE(ibuf)
5822
5823 END
5824C=======================================================================
5825C END SPECIFIC ROUTINES INT24
5826C=======================================================================
5827
5828C=======================================================================
5829C SPECIFIC ROUTINES INT 25
5830C=======================================================================
5831!||====================================================================
5832!|| split_node_ival_i25 ../starter/source/restart/ddsplit/inter_tools.F
5833!||--- called by ------------------------------------------------------
5834!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5835!||--- calls -----------------------------------------------------
5836!||--- uses -----------------------------------------------------
5837!||====================================================================
5838 SUBROUTINE split_node_ival_i25(TAB,DIMO,DIMN,TAG,TAG2)
5839c
5840c split node array with global value specific type24 & type25
5841c (see SPLIT_NODE_NODLOC for local values)
5842c
5843C-----------------------------------------------
5844C M o d u l e s
5845C-----------------------------------------------
5846 USE intbufdef_mod
5847C-----------------------------------------------
5848C I m p l i c i t T y p e s
5849C-----------------------------------------------
5850#include "implicit_f.inc"
5851C-----------------------------------------------
5852C D u m m y A r g u m e n t s
5853C-----------------------------------------------
5854 INTEGER TAB(*),DIMO,DIMN,TAG(*),TAG2(*)
5855C-----------------------------------------------
5856C L o c a l V a r i a b l e s
5857C-----------------------------------------------
5858 INTEGER I,K,N
5859 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
5860C ----------------------------------------
5861 ALLOCATE(ibuf(dimn))
5862
5863 DO i=1, dimn
5864 k=tag(i)
5865 n = tab(k)
5866 IF(n > 0)THEN
5867 IF(n > dimo)THEN
5868 n = n-dimo
5869 ibuf(i) = tag2(n)+dimn
5870 ELSE
5871 ibuf(i) = tag2(n)
5872 END IF
5873 ELSEIF(n < 0)THEN
5874 IF(n < -dimo)THEN
5875 n = n+dimo
5876 ibuf(i) = -tag2(-n)-dimn
5877 ELSE
5878 ibuf(i) = -tag2(-n)
5879 END IF
5880 ELSE
5881 ibuf(i) = 0
5882 ENDIF
5883 ENDDO
5884
5885 CALL write_i_c(ibuf,dimn)
5886 DEALLOCATE(ibuf)
5887
5888 RETURN
5889 END
5890!||====================================================================
5891!|| prepare_split_i25 ../starter/source/restart/ddsplit/inter_tools.F
5892!||--- called by ------------------------------------------------------
5893!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5894!||--- calls -----------------------------------------------------
5895!|| nlocal ../starter/source/spmd/node/ddtools.F
5896!||--- uses -----------------------------------------------------
5897!|| front_mod ../starter/share/modules1/front_mod.F
5898!||====================================================================
5899 SUBROUTINE prepare_split_i25(PROC , INTBUF_TAB , IPARI ,
5900 . INTERCEP , TAG_NODE_2RY , TAG_SEGM ,
5901 . TAG_SEGM2 , TAG_NM , TAG_NODE_MSR ,
5902 . TAG_SCRATCH, TAG_SM ,KNOR2MSR ,
5903 . NOR2MSR ,TAG_NODE_2RY2,NINDX_NM ,
5904 . INDX_NM ,NINDX_SCRT ,INDX_SCRT ,
5905 . NRTM_L)
5906C-----------------------------------------------
5907C M o d u l e s
5908C-----------------------------------------------
5909 USE intbufdef_mod
5910 USE front_mod
5911C-----------------------------------------------
5912C I m p l i c i t T y p e s
5913C-----------------------------------------------
5914#include "implicit_f.inc"
5915C-----------------------------------------------
5916C D u m m y A r g u m e n t s
5917C-----------------------------------------------
5918 TYPE(intbuf_struct_) :: INTBUF_TAB
5919 TYPE(intersurfp) :: INTERCEP
5920
5921 INTEGER PROC,IPARI(*),
5922 . TAG_NODE_2RY(*),TAG_SEGM(*),TAG_NM(*),TAG_NODE_MSR(*),
5923 . TAG_SEGM2(*),TAG_SCRATCH(*),TAG_SM(*),
5924 . KNOR2MSR(*), NOR2MSR(*), TAG_NODE_2RY2(*)
5925 INTEGER, INTENT(INOUT) :: NINDX_NM,NINDX_SCRT
5926 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_NM,INDX_SCRT
5927C-----------------------------------------------
5928C F u n c t i o n
5929C-----------------------------------------------
5930 INTEGER NLOCAL
5931 EXTERNAL NLOCAL
5932C-----------------------------------------------
5933C L o c a l V a r i a b l e s
5934C-----------------------------------------------
5935 INTEGER
5936 . NSN,NRTM,NMN,
5937 . I,J,K,L,N,N1,N2,N3,N4,E,
5938 . CNSN_L,CNRTM_L,CNMN_L,NADMSR_L,NRTM_L
5939C ----------------------------------------
5940 NRTM = ipari(4)
5941 nsn = ipari(5)
5942 nmn = ipari(6)
5943
5944 cnsn_l = 0
5945 DO k=1, nsn
5946 n=intbuf_tab%NSV(k)
5947 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0) THEN
5948 cnsn_l = cnsn_l+1
5949 tag_node_2ry(cnsn_l) = k
5950 tag_scratch(n)=1
5951 tag_node_2ry2(k) = cnsn_l
5952 nindx_scrt = nindx_scrt + 1
5953 indx_scrt(nindx_scrt) = n
5954 ENDIF
5955 ENDDO
5956
5957 !reflush to zero only part of TAG_SCRATCH that has been used
5958#include "vectorize.inc"
5959 DO k=1,nindx_scrt
5960 n = indx_scrt(k)
5961 tag_scratch(n) = 0
5962 ENDDO
5963 nindx_scrt = 0
5964
5965! prepare SPLIT_NRTM_R
5966 cnrtm_l = 0
5967 DO k=1,nrtm
5968 n1 = intbuf_tab%IRECTM(4*(k-1)+1)
5969 n2 = intbuf_tab%IRECTM(4*(k-1)+2)
5970 n3 = intbuf_tab%IRECTM(4*(k-1)+3)
5971 n4 = intbuf_tab%IRECTM(4*(k-1)+4)
5972 IF(intercep%P(k)==proc+1)THEN
5973 cnrtm_l = cnrtm_l + 1
5974 tag_segm(cnrtm_l) = k
5975 tag_segm2(k) = cnrtm_l
5976 IF(tag_nm(n1)==0)THEN
5977 tag_nm(n1)=1
5978 nindx_nm = nindx_nm + 1
5979 indx_nm(nindx_nm) = n1
5980 ENDIF
5981 IF(tag_nm(n2)==0)THEN
5982 tag_nm(n2)=1
5983 nindx_nm = nindx_nm + 1
5984 indx_nm(nindx_nm) = n2
5985 ENDIF
5986 IF(tag_nm(n3)==0)THEN
5987 tag_nm(n3)=1
5988 nindx_nm = nindx_nm + 1
5989 indx_nm(nindx_nm) = n3
5990 ENDIF
5991 IF(tag_nm(n4)==0)THEN
5992 tag_nm(n4)=1
5993 nindx_nm = nindx_nm + 1
5994 indx_nm(nindx_nm) = n4
5995 ENDIF
5996 ENDIF
5997 ENDDO
5998
5999! prepare SPLIT Normals <=> Vertices
6000 nadmsr_l=0
6001 DO k=1,nrtm
6002 n1 = intbuf_tab%ADMSR(4*(k-1)+1)
6003 n2 = intbuf_tab%ADMSR(4*(k-1)+2)
6004 n3 = intbuf_tab%ADMSR(4*(k-1)+3)
6005 n4 = intbuf_tab%ADMSR(4*(k-1)+4)
6006 IF(intercep%P(k)==proc+1)THEN
6007 IF(tag_sm(n1)==0)THEN
6008 nadmsr_l=nadmsr_l+1
6009 tag_sm(n1)=nadmsr_l
6010 END IF
6011 IF(tag_sm(n2)==0)THEN
6012 nadmsr_l=nadmsr_l+1
6013 tag_sm(n2)=nadmsr_l
6014 END IF
6015 IF(tag_sm(n3)==0)THEN
6016 nadmsr_l=nadmsr_l+1
6017 tag_sm(n3)=nadmsr_l
6018 END IF
6019 IF(tag_sm(n4)==0)THEN
6020 nadmsr_l=nadmsr_l+1
6021 tag_sm(n4)=nadmsr_l
6022 END IF
6023 ENDIF
6024 ENDDO
6025
6026 cnmn_l = 0
6027 DO i=1,nmn
6028 n = intbuf_tab%MSR(i)
6029 IF(tag_nm(n)==1)THEN
6030 cnmn_l = cnmn_l + 1
6031 tag_node_msr(cnmn_l) = i
6032 ENDIF
6033 ENDDO
6034
6035C-----------------------------------------------
6036C Pre construction ADRESSES
6037C
6038 DO i=1,nrtm
6039 IF(intercep%P(i)==proc+1)THEN
6040 DO k=1,3
6041 n = tag_sm(intbuf_tab%ADMSR(4*(i-1)+k))
6042 knor2msr(n) = knor2msr(n) + 1
6043 END DO
6044 IF(intbuf_tab%IRECTM(4*(i-1)+3)/=intbuf_tab%IRECTM(4*(i-1)+4))THEN
6045 n = tag_sm(intbuf_tab%ADMSR(4*(i-1)+4))
6046 knor2msr(n) = knor2msr(n) + 1
6047 END IF
6048 END IF
6049 END DO
6050C
6051 DO i=1,nadmsr_l
6052 knor2msr(i+1) = knor2msr(i+1) + knor2msr(i)
6053 END DO
6054C
6055 DO i=nadmsr_l,1,-1
6056 knor2msr(i+1)=knor2msr(i)
6057 END DO
6058 knor2msr(1)=0
6059C
6060C Construction de la matrice Nod -> Shell elt
6061C
6062 DO i=1,nrtm
6063 IF(intercep%P(i)==proc+1)THEN
6064 DO k=1,3
6065 n = tag_sm(intbuf_tab%ADMSR(4*(i-1)+k))
6066 knor2msr(n) = knor2msr(n) + 1
6067 nor2msr(knor2msr(n)) = tag_segm2(i)
6068 END DO
6069 IF(intbuf_tab%IRECTM(4*(i-1)+3)/=intbuf_tab%IRECTM(4*(i-1)+4))THEN
6070 n = tag_sm(intbuf_tab%ADMSR(4*(i-1)+4))
6071 knor2msr(n) = knor2msr(n) + 1
6072 nor2msr(knor2msr(n)) = tag_segm2(i)
6073 END IF
6074 END IF
6075 END DO
6076C
6077 DO i=nadmsr_l,1,-1
6078 knor2msr(i+1)=knor2msr(i)
6079 END DO
6080 knor2msr(1)=0
6081C
6082 RETURN
6083 END
6084!||====================================================================
6085!|| split_ledge_i25 ../starter/source/restart/ddsplit/inter_tools.F
6086!||--- called by ------------------------------------------------------
6087!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
6088!||--- calls -----------------------------------------------------
6089!||--- uses -----------------------------------------------------
6090!||====================================================================
6091 SUBROUTINE split_ledge_i25(NEDGE,
6092 . NEDGE_L,
6093 . IRECTM,
6094 . NRTM_L,
6095 . LEDGE,
6096 . MSEGLO,
6097 . ADMSR,
6098 . SEGLOC,
6099 . TAG_SM,
6100 . NODLOCAL,
6101 . TAG_EDGE,
6102 . ITAB,
6103 . PROC)
6104c
6105C-----------------------------------------------
6106C M o d u l e s
6107C-----------------------------------------------
6108 USE intbufdef_mod
6109C-----------------------------------------------
6110C I m p l i c i t T y p e s
6111C-----------------------------------------------
6112#include "implicit_f.inc"
6113C-----------------------------------------------
6114C C o m m o n B l o c k s
6115C-----------------------------------------------
6116#include "param_c.inc"
6117#include "assert.inc"
6118C-----------------------------------------------
6119C D u m m y A r g u m e n t s
6120C-----------------------------------------------
6121 INTEGER NEDGE, NEDGE_L, NRTM_L, LEDGE(NLEDGE,*), MSEGLO(*), SEGLOC(*), NODLOCAL(*)
6122 INTEGER :: PROC
6123 INTEGER :: TAG_EDGE(NEDGE_L)
6124 INTEGER, INTENT(IN) :: ITAB(*)
6125 INTEGER, INTENT(IN) :: IRECTM(4,*)
6126 INTEGER, INTENT(IN) :: ADMSR(4,*)
6127 INTEGER, INTENT(IN) :: TAG_SM(*)
6128
6129C-----------------------------------------------
6130C L o c a l V a r i a b l e s
6131C-----------------------------------------------
6132 INTEGER :: I,E1,K1,E2,K2,CMPT
6133 INTEGER :: ID
6134 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
6135 INTEGER :: NB_FREE_EDGES
6136 INTEGER :: NB_INTERNAL_EDGES
6137 INTEGER :: NB_BOUNDARY_EDGES_LOCAL ! boundary edges treated by current domain
6138 INTEGER :: NB_BOUNDARY_EDGES_REMOTE ! boundary edges treated by the other domain
6139 INTEGER :: IAS,JAS,IS,N1,N2,I1,I2
6140C ----------------------------------------
6141 ALLOCATE(ibuf(nledge*nedge_l))
6142
6143 cmpt=0
6144 id = 1
6145 nb_free_edges = 0
6146C FREE EDGES
6147 DO i=1, nedge
6148 e1=ledge(1,i)
6149 k1=segloc(e1)
6150 e2=ledge(3,i)
6151 IF(e2/=0)THEN
6152! not free edge
6153 k2=segloc(e2)
6154 ELSE
6155! Free edge
6156 k2=-1
6157 END IF
6158 IF( k1 > 0 .AND. k2 == -1) THEN
6159 nb_free_edges = nb_free_edges + 1
6160! Internal edge
6161 tag_edge(id) = i
6162C at starter phase 9 and 10 are used to save PROC and local ID
6163 assert(ledge(9,i) == proc)
6164 assert(ledge(10,i) == id)
6165 ledge(9,i) = proc
6166 ledge(10,i) = id
6167
6168 id = id + 1
6169 cmpt=cmpt+1
6170 ibuf(cmpt) = k1
6171 cmpt=cmpt+1
6172 ibuf(cmpt) = ledge(2,i)
6173 cmpt=cmpt+1
6174 ibuf(cmpt) = 0
6175 cmpt=cmpt+1
6176 ibuf(cmpt) = 0
6177 cmpt=cmpt+1
6178 ibuf(cmpt) = nodlocal(ledge(5,i))
6179 cmpt=cmpt+1
6180 ibuf(cmpt) = nodlocal(ledge(6,i))
6181 cmpt=cmpt+1
6182 ibuf(cmpt) = ledge(7,i)
6183 cmpt=cmpt+1
6184 ibuf(cmpt) = i ! + 10000* ITAB(LEDGE(6,I))
6185 cmpt=cmpt+1
6186 ibuf(cmpt) = 1 ! Weight
6187C orientation segment 1
6188 cmpt=cmpt+1
6189 ias=ledge(1,i)
6190 jas=ledge(2,i)
6191 n1=ledge(5,i)
6192 n2=ledge(6,i)
6193 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6194 is= 1
6195 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6196 is=-1
6197 ELSE
6198 is = -huge(is)
6199 assert(.false.)
6200 END IF
6201 ibuf(cmpt) = is
6202 IF(is==1)THEN
6203 i1=admsr(jas,ias)
6204 i2=admsr(mod(jas,4)+1,ias)
6205 ELSE ! IM(I)==-1
6206 i2=admsr(jas,ias)
6207 i1=admsr(mod(jas,4)+1,ias)
6208 END IF
6209 cmpt=cmpt+1
6210 ibuf(cmpt) = tag_sm(i1)
6211 cmpt=cmpt+1
6212 ibuf(cmpt) = tag_sm(i2)
6213 assert(tag_sm(i1) > 0)
6214 assert(tag_sm(i2) > 0)
6215C orientation segment 2
6216 cmpt=cmpt+1
6217 ibuf(cmpt) = 0
6218 cmpt=cmpt+1
6219 ibuf(cmpt) = 0
6220 cmpt=cmpt+1
6221 ibuf(cmpt) = 0
6222 END IF
6223 ENDDO
6224
6225C INTERNAL EDGES
6226 nb_internal_edges = 0
6227 DO i=1, nedge
6228 e1=ledge(1,i)
6229 k1=segloc(e1)
6230 e2=ledge(3,i)
6231 IF(e2/=0)THEN
6232! not free edge
6233 k2=segloc(e2)
6234 ELSE
6235! Free edge
6236 k2=-1
6237 END IF
6238 IF( k1 > 0 .AND. k2 > 0) THEN
6239 nb_internal_edges = nb_internal_edges + 1
6240
6241! Internal edge
6242 tag_edge(id) = i
6243C at starter phase 9 and 10 are used to save PROC and local ID
6244 assert(ledge(9,i) == proc)
6245 assert(ledge(10,i) == id)
6246 ledge(9,i) = proc
6247 ledge(10,i) = id
6248
6249 id = id + 1
6250 cmpt=cmpt+1
6251 ibuf(cmpt) = k1
6252 cmpt=cmpt+1
6253 ibuf(cmpt) = ledge(2,i)
6254 cmpt=cmpt+1
6255 ibuf(cmpt) = k2
6256 cmpt=cmpt+1
6257 ibuf(cmpt) = ledge(4,i)
6258 cmpt=cmpt+1
6259 ibuf(cmpt) = nodlocal(ledge(5,i))
6260 cmpt=cmpt+1
6261 ibuf(cmpt) = nodlocal(ledge(6,i))
6262 cmpt=cmpt+1
6263 ibuf(cmpt) = ledge(7,i)
6264 cmpt=cmpt+1
6265 ibuf(cmpt) = i ! + 10000* ITAB(LEDGE(6,I))
6266 cmpt=cmpt+1
6267 ibuf(cmpt) = 1 ! Weight
6268C orientation segment 1
6269 cmpt=cmpt+1
6270 ias=ledge(1,i)
6271 jas=ledge(2,i)
6272 n1=ledge(5,i)
6273 n2=ledge(6,i)
6274 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6275 is= 1
6276 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6277 is=-1
6278 ELSE
6279 assert(.false.)
6280 END IF
6281 ibuf(cmpt) = is
6282 IF(is==1)THEN
6283 i1=admsr(jas,ias)
6284 i2=admsr(mod(jas,4)+1,ias)
6285 ELSE ! IM(I)==-1
6286 i2=admsr(jas,ias)
6287 i1=admsr(mod(jas,4)+1,ias)
6288 END IF
6289 cmpt = cmpt +1
6290 ibuf(cmpt) = tag_sm(i1)
6291 cmpt=cmpt+1
6292 ibuf(cmpt) = tag_sm(i2)
6293 assert(tag_sm(i1) > 0)
6294 assert(tag_sm(i2) > 0)
6295
6296C orientation segment 2
6297 cmpt=cmpt+1
6298 ias=ledge(3,i)
6299 jas=ledge(4,i)
6300 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6301 is= 1
6302 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6303 is=-1
6304 ELSE
6305 assert(.false.)
6306 END IF
6307 ibuf(cmpt) = is
6308
6309 IF(is==1)THEN
6310 i1=admsr(jas,ias)
6311 i2=admsr(mod(jas,4)+1,ias)
6312 ELSE ! IM(I)==-1
6313 i2=admsr(jas,ias)
6314 i1=admsr(mod(jas,4)+1,ias)
6315 END IF
6316 cmpt = cmpt +1
6317 ibuf(cmpt) = tag_sm(i1)
6318 cmpt=cmpt+1
6319 ibuf(cmpt) = tag_sm(i2)
6320 assert(tag_sm(i1) > 0)
6321 assert(tag_sm(i2) > 0)
6322
6323
6324
6325 END IF
6326 ENDDO
6327
6328 nb_boundary_edges_local = 0
6329 DO i=1, nedge
6330 e1=ledge(1,i)
6331 k1=segloc(e1)
6332 e2=ledge(3,i)
6333 IF(e2/=0)THEN
6334! not free edge
6335 k2=segloc(e2)
6336 ELSE
6337! Free edge
6338 k2=-1
6339 END IF
6340 IF( k1 > 0 .AND. k2 == 0) THEN
6341 nb_boundary_edges_local = nb_boundary_edges_local + 1
6342 tag_edge(id) = i
6343C at starter phase 9 and 10 are used to save PROC and local ID
6344 assert(ledge(9,i) == proc)
6345c ASSERT(LEDGE(10,I) == ID)
6346 ledge(9,i) = proc
6347 ledge(10,i) = id
6348
6349 id = id + 1
6350 cmpt=cmpt+1
6351 ibuf(cmpt) = k1
6352 cmpt=cmpt+1
6353 ibuf(cmpt) = ledge(2,i)
6354C boundary edge: remote segment
6355 cmpt=cmpt+1
6356C IBUF(CMPT) = -MSEGLO(E2)
6357 ibuf(cmpt) = -k1
6358 cmpt=cmpt+1
6359 ibuf(cmpt) = ledge(4,i)
6360C IBUF(CMPT) = LEDGE(2,I)
6361 cmpt=cmpt+1
6362 ibuf(cmpt) = nodlocal(ledge(5,i))
6363 cmpt=cmpt+1
6364 ibuf(cmpt) = nodlocal(ledge(6,i))
6365 cmpt=cmpt+1
6366 ibuf(cmpt) = ledge(7,i)
6367 cmpt=cmpt+1
6368 ibuf(cmpt) = i ! + 10000* ITAB(LEDGE(6,I))
6369 cmpt=cmpt+1
6370 ibuf(cmpt) = 1 ! Weight
6371C orientation segment 1
6372 cmpt=cmpt+1
6373 ias=ledge(1,i)
6374 jas=ledge(2,i)
6375 n1=ledge(5,i)
6376 n2=ledge(6,i)
6377 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6378 is= 1
6379 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6380 is=-1
6381 ELSE
6382 assert(.false.)
6383 END IF
6384 ibuf(cmpt) = is
6385 IF(is==1)THEN
6386 i1=admsr(jas,ias)
6387 i2=admsr(mod(jas,4)+1,ias)
6388 ELSE ! IM(I)==-1
6389 i2=admsr(jas,ias)
6390 i1=admsr(mod(jas,4)+1,ias)
6391 END IF
6392 cmpt = cmpt +1
6393 ibuf(cmpt) = tag_sm(i1)
6394 cmpt = cmpt +1
6395 ibuf(cmpt) = tag_sm(i2)
6396 assert(tag_sm(i1) > 0)
6397 assert(tag_sm(i2) > 0)
6398
6399C orientation segment 2
6400 cmpt=cmpt+1
6401 ias=ledge(3,i)
6402 jas=ledge(4,i)
6403 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6404 is= 1
6405 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6406 is=-1
6407 ELSE
6408 assert(.false.)
6409 END IF
6410 ibuf(cmpt) = is
6411 IF(is==1)THEN
6412 i1=admsr(jas,ias)
6413 i2=admsr(mod(jas,4)+1,ias)
6414 ELSE ! IM(I)==-1
6415 i2=admsr(jas,ias)
6416 i1=admsr(mod(jas,4)+1,ias)
6417 ENDIF
6418 cmpt = cmpt +1
6419 ibuf(cmpt) = tag_sm(i1)
6420 cmpt = cmpt +1
6421 ibuf(cmpt) = tag_sm(i2)
6422 assert(tag_sm(i1) > 0)
6423 assert(tag_sm(i2) > 0)
6424
6425 ENDIF
6426 ENDDO
6427
6428 nb_boundary_edges_remote = 0
6429 DO i=1, nedge
6430 e1=ledge(1,i)
6431 k1=segloc(e1)
6432 e2=ledge(3,i)
6433 IF(e2/=0)THEN
6434! not free edge
6435 k2=segloc(e2)
6436 ELSE
6437! Free edge
6438 k2=-1
6439 END IF
6440 IF( k1 == 0 .AND. k2 > 0) THEN
6441 nb_boundary_edges_remote = nb_boundary_edges_remote + 1
6442 tag_edge(id) = i
6443 id = id + 1
6444! if at least one segment belongs to this domain
6445! Put the local segment first
6446 cmpt=cmpt+1
6447 ibuf(cmpt) = k2 !1
6448 cmpt=cmpt+1
6449 ibuf(cmpt) = ledge(4,i) !2
6450 cmpt=cmpt+1
6451C IBUF(CMPT) = -MSEGLO(E1)
6452 ibuf(cmpt) = -k2 !3
6453 cmpt=cmpt+1
6454 ibuf(cmpt) = ledge(2,i) !4
6455C IBUF(CMPT) = LEDGE(4,I)
6456 cmpt=cmpt+1
6457 ibuf(cmpt) = nodlocal(ledge(5,i)) !5
6458 cmpt=cmpt+1
6459 ibuf(cmpt) = nodlocal(ledge(6,i)) !6
6460 cmpt=cmpt+1
6461 ibuf(cmpt) = ledge(7,i) !7
6462 cmpt=cmpt+1
6463 ibuf(cmpt) = i !8
6464 cmpt=cmpt+1
6465 ibuf(cmpt) = 0 !9
6466C orientation segment 1
6467 cmpt=cmpt+1
6468 ias=ledge(3,i) ! segments have been switched
6469 jas=ledge(4,i) ! The first one is 3-4
6470 n1=ledge(5,i)
6471 n2=ledge(6,i)
6472 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6473 is= 1
6474 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6475 is=-1
6476 ELSE
6477 assert(.false.)
6478 ENDIF
6479 ibuf(cmpt) = is !10
6480 IF(is==1)THEN
6481 i1=admsr(jas,ias)
6482 i2=admsr(mod(jas,4)+1,ias)
6483 ELSE ! IM(I)==-1
6484 i2=admsr(jas,ias)
6485 i1=admsr(mod(jas,4)+1,ias)
6486 END IF
6487 cmpt = cmpt +1
6488 ibuf(cmpt) = tag_sm(i1)!11
6489 cmpt = cmpt +1
6490 ibuf(cmpt) = tag_sm(i2) !12
6491 assert(tag_sm(i1) > 0)
6492 assert(tag_sm(i2) > 0)
6493
6494C orientation segment 2
6495 cmpt=cmpt+1
6496 ias=ledge(1,i) ! segments have been switched
6497 jas=ledge(2,i) ! the second one is 1-2
6498 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6499 is= 1
6500 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6501 is=-1
6502 ELSE
6503 assert(.false.)
6504 ENDIF
6505 ibuf(cmpt) = is ! 13
6506 IF(is==1)THEN
6507 i1=admsr(jas,ias)
6508 i2=admsr(mod(jas,4)+1,ias)
6509 ELSE ! IM(I)==-1
6510 i2=admsr(jas,ias)
6511 i1=admsr(mod(jas,4)+1,ias)
6512 END IF
6513 cmpt = cmpt +1
6514 ibuf(cmpt) = tag_sm(i1) !14
6515 cmpt = cmpt +1
6516 ibuf(cmpt) = tag_sm(i2) !15
6517 assert(tag_sm(i1) > 0)
6518 assert(tag_sm(i2) > 0)
6519
6520 ENDIF
6521 ENDDO
6522
6523
6524C WRITE(6,*) __FILE__,"NEDGE_L",NEDGE_L
6525C WRITE(6,*) "NB_FREE_EDGES=",NB_FREE_EDGES
6526C WRITE(6,*) "NB_INTERNAL_EDGES=",NB_INTERNAL_EDGES
6527C WRITE(6,*) "NB_BOUNDARY_EDGES_LOCAL=",NB_BOUNDARY_EDGES_LOCAL
6528C WRITE(6,*) "NB_BOUNDARY_EDGES_REMOTE=",NB_BOUNDARY_EDGES_REMOTE
6529
6530
6531
6532 i = nb_free_edges+nb_internal_edges+nb_boundary_edges_local + nb_boundary_edges_remote
6533 assert(nedge_l == i)
6534
6535 CALL write_i_c(ibuf,nledge*nedge_l)
6536 DEALLOCATE(ibuf)
6537
6538 RETURN
6539 END
6540
6541!||====================================================================
6542!|| split_cand_i25 ../starter/source/restart/ddsplit/inter_tools.F
6543!||--- called by ------------------------------------------------------
6544!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
6545!||--- calls -----------------------------------------------------
6546!|| ancmsg ../starter/source/output/message/message.F
6547!|| nlocal ../starter/source/spmd/node/ddtools.F
6548!|| plist_ifront ../starter/source/spmd/node/ddtools.F
6549!||--- uses -----------------------------------------------------
6550!|| message_mod ../starter/share/message_module/message_mod.F
6551!||====================================================================
6552 SUBROUTINE split_cand_i25(PROC , INTBUF_TAB, NSN , NSN_L ,
6553 . TAG_SEGM2, II_STOK , MULTIMP, NCONT ,
6554 . NOINT , INACTI , TAG_SCRATCH ,II_STOK_L,
6555 . NINDX_SCRT,INDX_SCRT)
6556C-----------------------------------------------
6557C M o d u l e s
6558C-----------------------------------------------
6559 USE message_mod
6560 USE intbufdef_mod
6561C-----------------------------------------------
6562C I m p l i c i t T y p e s
6563C-----------------------------------------------
6564#include "implicit_f.inc"
6565C-----------------------------------------------
6566C C o m m o n B l o c k s
6567C-----------------------------------------------
6568#include "com01_c.inc"
6569#include "com04_c.inc"
6570C-----------------------------------------------
6571C D u m m y A r g u m e n t s
6572C-----------------------------------------------
6573 INTEGER PROC,NSN,NSN_L,II_STOK,MULTIMP,NCONT,
6574 . tag_segm2(*),noint,inacti,
6575 . tag_scratch(*) , ii_stok_l, ityp
6576 INTEGER, INTENT(INOUT) :: NINDX_SCRT
6577 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_SCRT
6578
6579 TYPE(intbuf_struct_) :: INTBUF_TAB
6580C-----------------------------------------------
6581C F u n c t i o n
6582C-----------------------------------------------
6583 INTEGER NLOCAL
6584 EXTERNAL nlocal
6585C-----------------------------------------------
6586C L o c a l V a r i a b l e s
6587C-----------------------------------------------
6588 INTEGER I,J,K,N,P,E,MULTOK,MSGID,
6589 . splist,c_nsnr
6590 INTEGER NUMP(NSPMD),WORK(70000)
6591
6592 INTEGER, DIMENSION(:),ALLOCATABLE ::
6593 . ibuf_e,ibuf_n,nsnlocal,cpulocal,candr,plist,
6594 . index
6595
6596 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ITRI
6597C ----------------------------------------
6598C w to be done :modif w/ edge
6599C ----------------------------------------
6600 ALLOCATE(ibuf_e(multimp*ncont),ibuf_n(multimp*ncont))
6601 ibuf_e(1:multimp*ncont) = 0
6602 ibuf_n(1:multimp*ncont) = 0
6603 ii_stok_l = 0 !mandatory in case of inacti ne 5,6,7
6604
6605 IF(nsn>0) THEN
6606 ALLOCATE(nsnlocal(nsn))
6607 ALLOCATE(cpulocal(nsn))
6608 ALLOCATE(candr(nsn))
6609 END IF
6610
6611 nump(1:nspmd) = 0
6612
6613 ALLOCATE(plist(nspmd))
6614 plist(1:nspmd) = -1
6615 DO k=1,nsn
6616 n = intbuf_tab%NSV(k)
6617 nsnlocal(k) = 0
6618 IF(tag_scratch(n)==0) THEN
6619 splist=0
6620 CALL plist_ifront(plist,n,splist)
6621 DO i=1,splist
6622 p=plist(i)
6623 nump(p) = nump(p)+1
6624 ENDDO
6625 IF(nlocal(n,proc+1)==1) THEN
6626 nsnlocal(k) = nump(proc+1)
6627 cpulocal(k) = proc+1
6628 ELSE
6629 p = plist(1)
6630 nsnlocal(k) = nump(p)
6631 cpulocal(k) = p
6632 ENDIF
6633 tag_scratch(n) = 1
6634 nindx_scrt = nindx_scrt + 1
6635 indx_scrt(nindx_scrt) = n
6636 ENDIF
6637 ENDDO
6638 DEALLOCATE(plist)
6639
6640 !reflush TAG_SCRATCH to zero only when value has changes
6641#include "vectorize.inc"
6642 DO k=1,nindx_scrt
6643 n = indx_scrt(k)
6644 tag_scratch(n) = 0
6645 ENDDO
6646 nindx_scrt = 0
6647C
6648C Reperage des candidats se trouvant sur des procs distants
6649C
6650 c_nsnr = 0
6651
6652 DO k = 1, ii_stok
6653 e = intbuf_tab%CAND_E(k)
6654 IF (tag_segm2(e)/=0) THEN
6655 n = intbuf_tab%CAND_N(k)
6656 IF (intbuf_tab%NSV(n)> numnod) cycle
6657 IF(tag_scratch(n)==0) THEN
6658 tag_scratch(n) = 1
6659 nindx_scrt = nindx_scrt + 1
6660 indx_scrt(nindx_scrt) = n
6661 IF(nlocal(intbuf_tab%NSV(n),proc+1)/=1)THEN
6662 c_nsnr = c_nsnr + 1
6663 candr(c_nsnr) = n
6664 END IF
6665 END IF
6666 ENDIF
6667 ENDDO
6668
6669 !reflush TAG_SCRATCH to zero only when value has changes
6670#include "vectorize.inc"
6671 DO k=1,nindx_scrt
6672 n = indx_scrt(k)
6673 tag_scratch(n) = 0
6674 ENDDO
6675 nindx_scrt = 0
6676C
6677C Tris des candidats remote par proc et par nsv local croissant
6678C
6679C IF(C_NSNR>0) THEN
6680 ALLOCATE(index(2*c_nsnr))
6681 ALLOCATE(itri(2,c_nsnr))
6682C END IF
6683 DO i = 1, c_nsnr
6684 n = candr(i)
6685 itri(1,i) = cpulocal(n)
6686 itri(2,i) = nsnlocal(n)
6687 ENDDO
6688 CALL my_orders(0,work,itri,index,c_nsnr,2)
6689C
6690 DO i = 1, c_nsnr
6691 index(c_nsnr+index(i)) = i
6692 ENDDO
6693 DO i = 1, c_nsnr
6694 index(i)=index(c_nsnr+i)
6695 ENDDO
6696C
6697 ii_stok_l = 0
6698
6699 c_nsnr = 0
6700 DO k = 1, ii_stok
6701 e = intbuf_tab%CAND_E(k)
6702 IF (tag_segm2(e)/=0) THEN
6703 ii_stok_l = ii_stok_l + 1
6704 END IF
6705 END DO
6706
6707 IF(ii_stok_l>multimp*ncont)THEN
6708 multok= ii_stok_l/ncont
6709 CALL ancmsg(msgid=626,
6710 . msgtype=msgerror,
6711 . anmode=aninfo,
6712 . i1=multok,
6713 . i2=noint)
6714 ELSE
6715 ii_stok_l = 0
6716C
6717 DO k = 1, ii_stok
6718 e = intbuf_tab%CAND_E(k)
6719 IF (tag_segm2(e)/=0) THEN
6720 n = intbuf_tab%CAND_N(k)
6721 ii_stok_l = ii_stok_l + 1
6722 ibuf_e(ii_stok_l)=tag_segm2(e)
6723 IF (intbuf_tab%NSV(n)>numnod) THEN
6724 ibuf_n(ii_stok_l)=n
6725 ELSEIF(nlocal(intbuf_tab%NSV(n),proc+1)==1) THEN
6726 ibuf_n(ii_stok_l)=nsnlocal(n)
6727 ELSE
6728C noeud remote : numerotation pre calculee ci-dessus
6729c IF(TAG(N)==0) THEN
6730 IF(tag_scratch(n)==0) THEN
6731 c_nsnr = c_nsnr + 1
6732 ibuf_n(ii_stok_l)=index(c_nsnr)+nsn_l
6733 tag_scratch(n) = index(c_nsnr)+nsn_l
6734 nindx_scrt = nindx_scrt + 1
6735 indx_scrt(nindx_scrt) = n
6736 ELSE
6737 ibuf_n(ii_stok_l) = tag_scratch(n)
6738 END IF ! TAG(N)==0
6739 END IF ! NLOCAL(INTBUF_TAB%NSV(N),PROC+1)==1
6740 ENDIF !TAG_SEGM_2(E)/=0
6741 ENDDO !K = 1, II_STOK
6742 END IF !II_STOK_L>MULTIMP*NCONT
6743
6744 !reflush TAG_SCRATCH to zero only when value has changes
6745 DO k=1, ii_stok
6746 e = intbuf_tab%CAND_E(k)
6747 IF (tag_segm2(e)/=0) THEN
6748 n = intbuf_tab%CAND_N(k)
6749 IF (intbuf_tab%NSV(n)<= numnod) tag_scratch(n) = 0
6750 ENDIF
6751 ENDDO
6752
6753 IF(nsn>0) DEALLOCATE(nsnlocal,cpulocal,candr)
6754 DEALLOCATE(index,itri)
6755
6756
6757 CALL write_i_c(ibuf_e,multimp*ncont)
6758 CALL write_i_c(ibuf_n,multimp*ncont)
6759
6760 DEALLOCATE(ibuf_e,ibuf_n)
6761
6762 RETURN
6763 END
6764
6765!||====================================================================
6766!|| split_adskyn_25 ../starter/source/restart/ddsplit/inter_tools.F
6767!||--- called by ------------------------------------------------------
6768!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
6769!||--- calls -----------------------------------------------------
6770!||--- uses -----------------------------------------------------
6771!|| front_mod ../starter/share/modules1/front_mod.F
6772!||====================================================================
6773 SUBROUTINE split_adskyn_25(ADSKYN,IADNOR,NADMSR,ADMSR,NADMSR_L,
6774 . NRTM_L,TAG_SEGM,TAG_SM,INTERCEP)
6775c
6776c build & write skyline matrix for normals assembling
6777c
6778C-----------------------------------------------
6779C M o d u l e s
6780C-----------------------------------------------
6781 USE intbufdef_mod
6782 USE front_mod
6783C-----------------------------------------------
6784C I m p l i c i t T y p e s
6785C-----------------------------------------------
6786#include "implicit_f.inc"
6787C-----------------------------------------------
6788C D u m m y A r g u m e n t s
6789C-----------------------------------------------
6790 INTEGER ADSKYN(NADMSR+1),IADNOR(4,*),NADMSR,NADMSR_L,NRTM_L,
6791 . ADMSR(4,*), TAG_SEGM(*),TAG_SM(*)
6792 TYPE(intersurfp) :: INTERCEP
6793C-----------------------------------------------
6794C L o c a l V a r i a b l e s
6795C-----------------------------------------------
6796 INTEGER I,J,K,IS,ISL
6797 INTEGER, DIMENSION(:),ALLOCATABLE :: ADSKYN_L,IADNOR_L, TAG_MS
6798C ----------------------------------------
6799 ALLOCATE(adskyn_l(nadmsr_l+1),iadnor_l(4*nrtm_l),tag_ms(nadmsr_l))
6800
6801 tag_ms(1:nadmsr_l)=0
6802 DO i=1, nadmsr
6803 k=tag_sm(i)
6804 IF(k /= 0) tag_ms(k) = i
6805 END DO
6806
6807 adskyn_l(1)=1
6808 DO k=1, nadmsr_l
6809 i=tag_ms(k)
6810 adskyn_l(k+1)=adskyn_l(k)+adskyn(i+1)-adskyn(i)
6811 END DO
6812
6813 DO i=1, nrtm_l
6814 k=tag_segm(i)
6815 DO j=1,4
6816 is =admsr(j,k)
6817 isl=tag_sm(is)
6818 iadnor_l(4*(i-1)+j) = iadnor(j,k) - adskyn(is) + adskyn_l(isl)
6819 ENDDO
6820 ENDDO
6821
6822 CALL write_i_c(adskyn_l,nadmsr_l+1)
6823 CALL write_i_c(iadnor_l,4*nrtm_l)
6824
6825 DEALLOCATE(adskyn_l,iadnor_l,tag_ms)
6826
6827 RETURN
6828 END
6829!||====================================================================
6830!|| split_lbound_i25 ../starter/source/restart/ddsplit/inter_tools.F
6831!||--- called by ------------------------------------------------------
6832!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
6833!||--- calls -----------------------------------------------------
6834!||--- uses -----------------------------------------------------
6835!||====================================================================
6836 SUBROUTINE split_lbound_i25(NADMSR,NADMSR_L,LBOUND,TAG_SM)
6837c
6838C-----------------------------------------------
6839C M o d u l e s
6840C-----------------------------------------------
6841 USE intbufdef_mod
6842C-----------------------------------------------
6843C I m p l i c i t T y p e s
6844C-----------------------------------------------
6845#include "implicit_f.inc"
6846C-----------------------------------------------
6847C D u m m y A r g u m e n t s
6848C-----------------------------------------------
6849 INTEGER NADMSR,NADMSR_L,LBOUND(*), TAG_SM(*)
6850C-----------------------------------------------
6851C L o c a l V a r i a b l e s
6852C-----------------------------------------------
6853 INTEGER I,K
6854 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF, TAG_MS
6855C ----------------------------------------
6856 ALLOCATE(tag_ms(nadmsr_l))
6857
6858 tag_ms(1:nadmsr_l)=0
6859 DO i=1, nadmsr
6860 k=tag_sm(i)
6861 IF(k /= 0) tag_ms(k) = i
6862 END DO
6863C ----------------------------------------
6864 ALLOCATE(ibuf(nadmsr_l))
6865
6866 DO i=1, nadmsr_l
6867 k=tag_ms(i)
6868 IF(k/=0) THEN
6869 ibuf(i) = lbound(k)
6870 END IF
6871 ENDDO
6872
6873 CALL write_i_c(ibuf,nadmsr_l)
6874 DEALLOCATE(ibuf)
6875
6876 RETURN
6877 END
6878C=======================================================================
6879C END SPECIFIC ROUTINES INT25
6880C=======================================================================
6881!||====================================================================
6882!|| split_isegpt_ival ../starter/source/restart/ddsplit/inter_tools.F
6883!||--- called by ------------------------------------------------------
6884!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
6885!||--- calls -----------------------------------------------------
6886!||--- uses -----------------------------------------------------
6887!||====================================================================
6888 SUBROUTINE split_isegpt_ival(ISEGPT,NSN_L,DIM2,TAG_NODE_2RY,NI,TAG_2RY_INV,PROC)
6889c
6890c split & write node array (type INTEGER) with global value
6891c (see SPLIT_NODE_NODLOC for local values)
6892c
6893C-----------------------------------------------
6894C M o d u l e s
6895C-----------------------------------------------
6896 USE intbufdef_mod
6897C-----------------------------------------------
6898C I m p l i c i t T y p e s
6899C-----------------------------------------------
6900#include "implicit_f.inc"
6901C-----------------------------------------------
6902C D u m m y A r g u m e n t s
6903C-----------------------------------------------
6904 INTEGER ISEGPT(*),TAG_NODE_2RY(*),NSN_L,DIM2,NI,PROC,
6905 * TAG_2RY_INV(*)
6906C-----------------------------------------------
6907C L o c a l V a r i a b l e s
6908C-----------------------------------------------
6909 INTEGER I,J,K,SN,FICT_SN
6910 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
6911C ----------------------------------------
6912 ALLOCATE(ibuf(nsn_l))
6913
6914 DO i=1, nsn_l
6915 k=tag_node_2ry(i)
6916 DO j=1,dim2
6917 ibuf(i) = 0
6918 IF(isegpt(k)==k)THEN
6919 ibuf(i) = i
6920 ELSEIF(-isegpt(k)==k)THEN
6921 ibuf(i) = -i
6922 ELSE
6923 sn = isegpt(k)
6924 IF(sn==0)THEN
6925 ibuf(i) = sn
6926 ELSE
6927 fict_sn = tag_2ry_inv(sn)
6928 ibuf(i) = fict_sn
6929 ENDIF
6930 ENDIF
6931
6932 ENDDO
6933 ENDDO
6934
6935 CALL write_i_c(ibuf,nsn_l*dim2)
6936
6937 DEALLOCATE(ibuf)
6938
6939 RETURN
6940 END
6941!||====================================================================
6942!|| split_remnode_i24 ../starter/source/restart/ddsplit/inter_tools.F
6943!||--- called by ------------------------------------------------------
6944!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
6945!||--- calls -----------------------------------------------------
6946!|| nlocal ../starter/source/spmd/node/ddtools.F
6947!||--- uses -----------------------------------------------------
6948!|| front_mod ../starter/share/modules1/front_mod.F
6949!|| message_mod ../starter/share/message_module/message_mod.F
6950!||====================================================================
6951 SUBROUTINE split_remnode_i24(PROC , INTBUF_TAB, NRTM , NRTM_L,
6952 . TAG_SEGM2, NREMNODE , NODLOCAL, ITAB ,
6953 . IS2ID ,INTERCEP2 ,NSNE ,NODLOCAL24)
6954C-----------------------------------------------
6955C M o d u l e s
6956C-----------------------------------------------
6957 USE message_mod
6958 USE intbufdef_mod
6959 USE front_mod
6960C-----------------------------------------------
6961C I m p l i c i t T y p e s
6962C-----------------------------------------------
6963#include "implicit_f.inc"
6964C-----------------------------------------------
6965C C o m m o n B l o c k s
6966C-----------------------------------------------
6967#include "com04_c.inc"
6968C-----------------------------------------------
6969C D u m m y A r g u m e n t s
6970C-----------------------------------------------
6971 INTEGER PROC,NRTM,NRTM_L,
6972 . tag_segm2(*),nremnode,nodlocal(*),
6973 . itab(*),is2id(*),nsne,nodlocal24(*)
6974 INTEGER, DIMENSION(:),ALLOCATABLE ::
6975 . siz_tmp
6976
6977 TYPE(intbuf_struct_) :: INTBUF_TAB
6978 TYPE(intersurfp) :: INTERCEP2
6979C-----------------------------------------------
6980C F u n c t i o n
6981C-----------------------------------------------
6982 INTEGER NLOCAL
6983 EXTERNAL nlocal
6984C-----------------------------------------------
6985C L o c a l V a r i a b l e s
6986C-----------------------------------------------
6987 INTEGER I,J,K,SIZ,L,SIZ1,SIZ2,M,N,SE1,NS,NUMNODT
6988
6989 INTEGER, DIMENSION(:),ALLOCATABLE ::
6990 . ibuf1,ibuf2,noddel,noddelremote
6991C ----------------------------------------
6992 ALLOCATE(siz_tmp(nrtm),noddel(numnod+nsne),
6993 . noddelremote(numnod+nsne))
6994
6995 ALLOCATE(ibuf1(2*(nrtm_l + 1)), ibuf2(nremnode))
6996 ibuf1(1:2*(nrtm_l+1)) = 0
6997 ibuf2(1:nremnode) = 0
6998
6999 siz_tmp(1:nrtm) = 0
7000
7001 DO k=1,nrtm
7002 IF(tag_segm2(k) /= 0)THEN
7003 siz_tmp(tag_segm2(k)) = intbuf_tab%KREMNODE(k+1)
7004 . -intbuf_tab%KREMNODE(k)
7005 ENDIF
7006 END DO
7007
7008 ibuf1(1) = 0
7009 numnodt = numnod + nsne
7010 noddel(1:numnodt) = 0
7011 noddelremote(1:numnodt) = 0
7012 siz1 = 0
7013 siz2 = 0
7014 DO k=1,nrtm
7015 IF(tag_segm2(k) /= 0)THEN
7016
7017 siz = siz_tmp(tag_segm2(k))
7018 ibuf1(1+2*tag_segm2(k)) =ibuf1(1+2*(tag_segm2(k)-1)) + siz
7019 l=intbuf_tab%KREMNODE(k)
7020 siz1 = 0
7021 siz2 = 0
7022c--------add if N<=NUMNOD else nodlocal_fictive
7023 DO m=1,siz
7024 n = intbuf_tab%REMNODE(l+m)
7025 IF (n>numnod) THEN
7026 ns = n-numnod
7027 se1 = intbuf_tab%IS2SE(2*(ns-1)+1)
7028 IF (intercep2%P(se1)==proc+1)THEN
7029 noddel(siz1+1) = nodlocal24(n)
7030 siz1 = siz1+1
7031 ENDIF
7032 ELSE
7033 IF(nlocal(n,proc+1)==1) THEN
7034 noddel(siz1+1) = nodlocal(n)
7035 siz1 = siz1+1
7036 ENDIF
7037 END IF
7038 ENDDO
7039c--------add if N<=NUMNOD else IS2ID(N-NUMNOD)
7040 DO m=1,siz
7041 n = intbuf_tab%REMNODE(l+m)
7042 IF (n>numnod) THEN
7043 ns = n-numnod
7044 se1 = intbuf_tab%IS2SE(2*(ns-1)+1)
7045 IF (intercep2%P(se1)/=proc+1)THEN
7046 noddelremote(siz2+1) = is2id(ns)
7047 siz2 = siz2+1
7048 ENDIF
7049 ELSE
7050 IF(nlocal(n,proc+1)/=1) THEN
7051 noddelremote(siz2+1) = itab(n)
7052 siz2 = siz2+1
7053 ENDIF
7054 END IF
7055 ENDDO
7056c
7057 l=ibuf1(1+2*(tag_segm2(k)-1))
7058 DO m=1,siz1
7059 ibuf2(1+l+m-1)= noddel(m)
7060 ENDDO
7061c
7062 ibuf1(1+2*(tag_segm2(k)-1)+1) = l + siz1
7063 l=ibuf1(1+2*(tag_segm2(k)-1)+1)
7064 DO m=1,siz2
7065 ibuf2(1+l+m-1) = - noddelremote(m)
7066 ENDDO
7067 ENDIF
7068 DO m=1,siz1
7069 noddel(m) = 0
7070 ENDDO
7071 DO m=1,siz2
7072 noddelremote(m) = 0
7073 ENDDO
7074 ENDDO
7075c print *,'NREMNODE,SIZ1,SIZ2=',NREMNODE,SIZ1,SIZ2
7076
7077 DEALLOCATE(siz_tmp,noddel,noddelremote)
7078
7079 CALL write_i_c(ibuf1,2*(nrtm_l + 1))
7080 CALL write_i_c(ibuf2,nremnode)
7081
7082 DEALLOCATE(ibuf1, ibuf2)
7083
7084 RETURN
7085 END
7086
7087!||====================================================================
7088!|| split_remnode_i11 ../starter/source/restart/ddsplit/inter_tools.F
7089!||--- called by ------------------------------------------------------
7090!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.f
7091!||--- calls -----------------------------------------------------
7092!||--- uses -----------------------------------------------------
7093!|| message_mod ../starter/share/message_module/message_mod.F
7094!||====================================================================
7095 SUBROUTINE split_remnode_i11(PROC , INTBUF_TAB, NRTM , NRTM_L,
7096 . TAG_SEGM2, NODLOCAL, ITAB ,NUMNOD_L, TAG_SEGS2,
7097 . NREMNODE_L)
7098C-----------------------------------------------
7099C M o d u l e s
7100C-----------------------------------------------
7101 USE message_mod
7102 USE intbufdef_mod
7103C-----------------------------------------------
7104C I m p l i c i t T y p e s
7105C-----------------------------------------------
7106#include "implicit_f.inc"
7107C-----------------------------------------------
7108C D u m m y A r g u m e n t s
7109C-----------------------------------------------
7110 INTEGER PROC,NRTM,NRTM_L,
7111 . tag_segm2(*),nremnode,nodlocal(*),
7112 . itab(*),tag_segs2(*)
7113 INTEGER, INTENT(IN) :: NUMNOD_L,NREMNODE_L
7114
7115 TYPE(intbuf_struct_) :: INTBUF_TAB
7116C-----------------------------------------------
7117C F u n c t i o n
7118C-----------------------------------------------
7119! INTEGER NLOCAL
7120! EXTERNAL NLOCAL
7121C-----------------------------------------------
7122C L o c a l V a r i a b l e s
7123C-----------------------------------------------
7124 INTEGER I,J,K,SIZ,
7125 . l,siz1,siz2,m,n,cpt_l,index1
7126
7127 INTEGER, DIMENSION(:),ALLOCATABLE ::
7128 . ibuf1,ibuf2
7129C ----------------------------------------
7130C
7131C
7132 ALLOCATE(ibuf1(2*(nrtm_l + 1)), ibuf2(nremnode_l))
7133 ibuf1(1:2*(nrtm_l+1)) = 0
7134 ibuf2(1:nremnode_l) = 0
7135C
7136C--- Split of KERMNODE -> IBUF1
7137 index1 = 1
7138 cpt_l = 0
7139 DO k=1,nrtm
7140 IF(tag_segm2(k) /= 0)THEN
7141 siz = intbuf_tab%KREMNODE(k+1)-intbuf_tab%KREMNODE(k)
7142 l=intbuf_tab%KREMNODE(k)
7143 siz1 = 0
7144 siz2 = 0
7145 DO m=1,siz
7146 n = intbuf_tab%REMNODE(l+m-1)
7147 IF (tag_segs2(n)/=0) THEN
7148C-- Local segment - local id is stored
7149 siz1 = siz1 + 1
7150 ELSE
7151C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
7152 siz2 = siz2 + 2
7153 ENDIF
7154 END DO
7155 cpt_l = cpt_l + 1
7156 ibuf1(2*(cpt_l-1)+1) = index1
7157 ibuf1(2*(cpt_l-1)+2) = index1 + siz1
7158 index1 = index1 + siz1 + siz2
7159 ENDIF
7160 END DO
7161 ibuf1(2*nrtm_l+1) = index1
7162 ibuf1(2*nrtm_l+2) = index1
7163C
7164C--- Split of ERMNODE -> IBUF2
7165 cpt_l = 0
7166 DO k=1,nrtm
7167 IF(tag_segm2(k) /= 0)THEN
7168C
7169 cpt_l = cpt_l + 1
7170 l=intbuf_tab%KREMNODE(k)
7171 siz = intbuf_tab%KREMNODE(k+1)-intbuf_tab%KREMNODE(k)
7172 siz1 = ibuf1(2*(cpt_l-1)+1)
7173 siz2 = ibuf1(2*(cpt_l-1)+2)
7174C
7175 DO m=1,siz
7176 n = intbuf_tab%REMNODE(l+m-1)
7177 IF (tag_segs2(n)/=0) THEN
7178C-- Local segment - local id is stored
7179 ibuf2(siz1) = tag_segs2(n)
7180 siz1 = siz1+1
7181 ELSE
7182C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
7183 ibuf2(siz2) = itab(intbuf_tab%IRECTS(2*(n-1)+1))
7184 ibuf2(siz2+1) = itab(intbuf_tab%IRECTS(2*(n-1)+2))
7185 siz2 = siz2+2
7186 ENDIF
7187 ENDDO
7188C
7189 ENDIF
7190 ENDDO
7191C
7192 CALL write_i_c(ibuf1,2*(nrtm_l + 1))
7193 CALL write_i_c(ibuf2,nremnode_l)
7194C
7195 DEALLOCATE(ibuf1, ibuf2)
7196C
7197 RETURN
7198 END
7199
7200!||====================================================================
7201!|| split_remnode_i25_edge ../starter/source/restart/ddsplit/inter_tools.F
7202!||--- called by ------------------------------------------------------
7203!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
7204!||--- calls -----------------------------------------------------
7205!||--- uses -----------------------------------------------------
7206!|| message_mod ../starter/share/message_module/message_mod.F
7207!||====================================================================
7208 SUBROUTINE split_remnode_i25_edge(PROC , INTBUF_TAB, NEDGE , NEDGE_L,
7209 . TAG_EDGE , TAG_EDGE2 , SEGLOC ,ITAB ,
7210 . NUMNOD_L , NREMNODE_EDG_L)
7211C-----------------------------------------------
7212C M o d u l e s
7213C-----------------------------------------------
7214 USE message_mod
7215 USE intbufdef_mod
7216C-----------------------------------------------
7217C I m p l i c i t T y p e s
7218C-----------------------------------------------
7219#include "implicit_f.inc"
7220C-----------------------------------------------
7221C C o m m o n B l o c k s
7222C-----------------------------------------------
7223#include "param_c.inc"
7224C-----------------------------------------------
7225C D u m m y A r g u m e n t s
7226C-----------------------------------------------
7227 INTEGER PROC,NEDGE,NEDGE_L,
7228 . tag_edge2(*),tag_edge(*),segloc(*),
7229 . itab(*)
7230 INTEGER, INTENT(IN) :: NUMNOD_L,NREMNODE_EDG_L
7231
7232 TYPE(intbuf_struct_) :: INTBUF_TAB
7233C-----------------------------------------------
7234C F u n c t i o n
7235C-----------------------------------------------
7236! INTEGER NLOCAL
7237! EXTERNAL NLOCAL
7238C-----------------------------------------------
7239C L o c a l V a r i a b l e s
7240C-----------------------------------------------
7241 INTEGER I,J,K,SIZ,
7242 . l,siz1,siz2,m,n,cpt_l,index1,ik,
7243 . km1,em1,km2,em2,ks1,es1,ks2,es2
7244
7245 INTEGER, DIMENSION(:),ALLOCATABLE ::
7246 . IBUF1,IBUF2
7247C ----------------------------------------
7248C
7249C
7250 ALLOCATE(ibuf1(2*(nedge_l + 1)), ibuf2(nremnode_edg_l))
7251 ibuf1(1:2*(nedge_l+1)) = 0
7252 ibuf2(1:nremnode_edg_l) = 0
7253C
7254C--- Split of KERMNODE -> IBUF1
7255
7256 index1 = 1
7257 cpt_l = 0
7258 DO ik=1,nedge_l
7259 k = tag_edge(ik)
7260 em1=intbuf_tab%LEDGE(1+(k-1)*nledge)
7261 km1=0
7262 IF(em1/=.0) km1=segloc(em1)
7263 em2=intbuf_tab%LEDGE(3+(k-1)*nledge)
7264 km2=0
7265 IF(em2/=0) km2=segloc(em2)
7266 IF(km1 /= 0.OR.km2/=0)THEN
7267 siz = intbuf_tab%KREMNODE_EDG(k+1)-intbuf_tab%KREMNODE_EDG(k)
7268 l=intbuf_tab%KREMNODE_EDG(k)
7269 siz1 = 0
7270 siz2 = 0
7271 DO m=1,siz
7272 n = intbuf_tab%REMNODE_EDG(l+m-1)
7273 es1=intbuf_tab%LEDGE(1+(n-1)*nledge)
7274 ks1=0
7275 IF(es1/=0) ks1=segloc(es1)
7276 es2=intbuf_tab%LEDGE(3+(n-1)*nledge)
7277 ks2 = 0
7278 IF(es2/=0) ks2=segloc(es2)
7279 IF (km1 /= 0.AND.km2/=0.AND.ks1/=0.AND.ks2/=0) THEN
7280C-- Local segment - local id is stored
7281 siz1 = siz1 + 1
7282 ELSE
7283C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
7284 siz2 = siz2 + 2
7285 ENDIF
7286 END DO
7287 cpt_l = cpt_l + 1
7288 ibuf1(2*(cpt_l-1)+1) = index1
7289 ibuf1(2*(cpt_l-1)+2) = index1 + siz1
7290 index1 = index1 + siz1 + siz2
7291 ENDIF
7292 END DO
7293 ibuf1(2*nedge_l+1) = index1
7294 ibuf1(2*nedge_l+2) = index1
7295
7296C
7297C--- Split of ERMNODE -> IBUF2
7298 cpt_l = 0
7299 DO ik=1,nedge_l
7300 k = tag_edge(ik)
7301 em1=intbuf_tab%LEDGE(1+(k-1)*nledge)
7302 km1=0
7303 IF(em1/=0) km1=segloc(em1)
7304 em2=intbuf_tab%LEDGE(3+(k-1)*nledge)
7305 km2=0
7306 IF(em2/=0) km2=segloc(em2)
7307 IF(km1 /= 0.OR.km2/=0)THEN
7308C
7309 cpt_l = cpt_l + 1
7310 l=intbuf_tab%KREMNODE_EDG(k)
7311 siz = intbuf_tab%KREMNODE_EDG(k+1)-intbuf_tab%KREMNODE_EDG(k)
7312 siz1 = ibuf1(2*(cpt_l-1)+1)
7313 siz2 = ibuf1(2*(cpt_l-1)+2)
7314C
7315 DO m=1,siz
7316 n = intbuf_tab%REMNODE_EDG(l+m-1)
7317 ks1=0
7318 es1=intbuf_tab%LEDGE(1+(n-1)*nledge)
7319 IF(es1/=0) ks1=segloc(es1)
7320 es2=intbuf_tab%LEDGE(3+(n-1)*nledge)
7321 ks2 = 0
7322 IF(es2/=0) ks2=segloc(es2)
7323 IF (km1 /= 0.AND.km2/=0.AND.ks1/=0.AND.ks2/=0) THEN
7324C-- Local segment - local id is stored
7325 ibuf2(siz1) = tag_edge2(n)
7326 siz1 = siz1+1
7327 ELSE
7328C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
7329 ibuf2(siz2) = itab(intbuf_tab%LEDGE(5+(n-1)*nledge))
7330 ibuf2(siz2+1) = itab(intbuf_tab%LEDGE(6+(n-1)*nledge))
7331 siz2 = siz2+2
7332 ENDIF
7333 ENDDO
7334C
7335 ENDIF
7336 ENDDO
7337C
7338 CALL write_i_c(ibuf1,2*(nedge_l + 1))
7339 CALL write_i_c(ibuf2,nremnode_edg_l)
7340C
7341 DEALLOCATE(ibuf1, ibuf2)
7342C
7343 RETURN
7344 END
7345
7346!||====================================================================
7347!|| split_remnode_i25_e2s ../starter/source/restart/ddsplit/inter_tools.F
7348!||--- called by ------------------------------------------------------
7349!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
7350!||--- calls -----------------------------------------------------
7351!||--- uses -----------------------------------------------------
7352!|| message_mod ../starter/share/message_module/message_mod.F
7353!||====================================================================
7354 SUBROUTINE split_remnode_i25_e2s(PROC , INTBUF_TAB, NRTM , NRTM_L,
7355 . TAG_EDGE , TAG_EDGE2 , SEGLOC ,ITAB ,
7356 . NUMNOD_L , NREMNODE_E2S_L)
7357C-----------------------------------------------
7358C M o d u l e s
7359C-----------------------------------------------
7360 USE message_mod
7361 USE intbufdef_mod
7362C-----------------------------------------------
7363C I m p l i c i t T y p e s
7364C-----------------------------------------------
7365#include "implicit_f.inc"
7366C-----------------------------------------------
7367C C o m m o n B l o c k s
7368C-----------------------------------------------
7369#include "param_c.inc"
7370C-----------------------------------------------
7371C D u m m y A r g u m e n t s
7372C-----------------------------------------------
7373 INTEGER PROC,NRTM,NRTM_L,
7374 . TAG_EDGE2(*),TAG_EDGE(*),SEGLOC(*),
7375 . ITAB(*)
7376 INTEGER, INTENT(IN) :: NUMNOD_L,NREMNODE_E2S_L
7377
7378 TYPE(intbuf_struct_) :: INTBUF_TAB
7379C-----------------------------------------------
7380C F u n c t i o n
7381C-----------------------------------------------
7382! INTEGER NLOCAL
7383! EXTERNAL NLOCAL
7384C-----------------------------------------------
7385C L o c a l V a r i a b l e s
7386C-----------------------------------------------
7387 INTEGER I,J,K,SIZ,
7388 . l,siz1,siz2,m,n,cpt_l,index1,ik,
7389 . km1,em1,km2,em2,ks1,es1,ks2,es2
7390
7391 INTEGER, DIMENSION(:),ALLOCATABLE ::
7392 . ibuf1,ibuf2
7393C ----------------------------------------
7394C
7395C
7396 ALLOCATE(ibuf1(2*(nrtm_l + 1)), ibuf2(nremnode_e2s_l))
7397 ibuf1(1:2*(nrtm_l+1)) = 0
7398 ibuf2(1:nremnode_e2s_l) = 0
7399C
7400C--- Split of KERMNODE -> IBUF1
7401
7402 index1 = 1
7403 cpt_l = 0
7404 DO k=1,nrtm
7405 IF(segloc(k) > 0) THEN
7406 siz = intbuf_tab%KREMNODE_E2S(k+1)-intbuf_tab%KREMNODE_E2S(k)
7407 l=intbuf_tab%KREMNODE_E2S(k)
7408 siz1 = 0
7409 siz2 = 0
7410 DO m=1,siz
7411 n = intbuf_tab%REMNODE_E2S(l+m-1)
7412 es1=intbuf_tab%LEDGE(1+(n-1)*nledge)
7413 IF(segloc(es1) > 0) THEN
7414C-- Local segment - local id is stored
7415 siz1 = siz1 + 1
7416 ELSE
7417C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
7418 siz2 = siz2 + 2
7419 ENDIF
7420 END DO
7421 cpt_l = cpt_l + 1
7422 ibuf1(2*(cpt_l-1)+1) = index1
7423 ibuf1(2*(cpt_l-1)+2) = index1 + siz1
7424 index1 = index1 + siz1 + siz2
7425 ENDIF
7426 END DO
7427 ibuf1(2*nrtm_l+1) = index1
7428 ibuf1(2*nrtm_l+2) = index1
7429
7430C
7431C--- Split of REMNODE -> IBUF2
7432 cpt_l = 0
7433 DO k=1,nrtm
7434 IF(segloc(k) > 0) THEN
7435C
7436 cpt_l = cpt_l + 1
7437 l=intbuf_tab%KREMNODE_E2S(k)
7438 siz = intbuf_tab%KREMNODE_E2S(k+1)-intbuf_tab%KREMNODE_E2S(k)
7439 siz1 = ibuf1(2*(cpt_l-1)+1)
7440 siz2 = ibuf1(2*(cpt_l-1)+2)
7441C
7442 DO m=1,siz
7443 n = intbuf_tab%REMNODE_E2S(l+m-1)
7444 es1=intbuf_tab%LEDGE(1+(n-1)*nledge)
7445 IF(segloc(es1) > 0) THEN
7446C-- Local segment - local id is stored
7447 ibuf2(siz1) = tag_edge2(n)
7448 siz1 = siz1+1
7449 ELSE
7450C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
7451 ibuf2(siz2) = itab(intbuf_tab%LEDGE(5+(n-1)*nledge))
7452 ibuf2(siz2+1) = itab(intbuf_tab%LEDGE(6+(n-1)*nledge))
7453 siz2 = siz2+2
7454 ENDIF
7455 ENDDO
7456C
7457 ENDIF
7458 ENDDO
7459C
7460 CALL write_i_c(ibuf1,2*(nrtm_l + 1))
7461 CALL write_i_c(ibuf2,nremnode_e2s_l)
7462C
7463 DEALLOCATE(ibuf1, ibuf2)
7464C
7465 RETURN
7466 END
compress_i_nnz
subroutine compress_i_nnz(array, len)
Definition compress_nnz.F:91
compress_r_nnz
subroutine compress_r_nnz(array, len)
Definition compress_nnz.F:154
my_real
#define my_real
Definition cppsort.cpp:32
ddsplit
subroutine ddsplit(p, cep, cel, igeo, mat_elem, ipm, icode, iskew, iskn, insel, ibcslag, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, detonators, ipartx, npc, ixtg, group_param_tab, ixtg6, ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, itab, itabm1, gjbufi, nale, ale_connectivity, kxx, ixx, ibcl, ibfv, las, laccelm, nnlink, lllink, iparg, igrav, lgrav, ibvel, lbvel, iactiv, factiv, kinet, ipari, nprw, lprw, iexmad, npby, lpby, ixri, nstrf, ljoint, pornod, monvol, icontact, lagbuf, fr_iad, x, d, v, vr, dr, thke, dampr, damp, ms, in, tf, pm, skew, xframe, geo, eani, bufmat, bufgeo, bufsf, brmpc, gjbufr, w, veul, fill, dfill, wb, dsav, asav, msnf, spbuf, fac, vel, fsav, fzero, xlas, accelm, fbvel, gravfac, fr_wave, failwave, parts0, elbuf, rwl, rwsav, rby, rivet, secbuf, rvolu, rconx, nloc_dmg, fvmain, libagale, lenthg, lbufmat, lbufgeo, lbufsf, lenxlas, lnom_opt, lenlas, lenvolu, npts, cne, lcne, addcne, cni2, lcni2g, addcni2, cepi2, celi2, i2nsnt, probint, ddstat, pm1shf, dd_iad, kxsp, ixsp, nod2sp, cepsp, nthwa, nairwa, nmnt, l_mul_lag1, l_mul_lag, lwaspio, ipartsp, ispcond, pm1sph, wma, eigipm, eigibuf, eigrpm, iflow, rflow, memflow, iexlnk, fasolfr, iparth, fxbipm, fxbrpm, fxbnod, fxbmod, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxbdep, fxbvit, fxbacc, fxbelm, fxbsig, fxbgrvi, fxbgrvr, iadll, lll, ibmpc, lambda, lrbagale, iskwp, nskwp, isensp, nsensp, iaccp, naccp, ipart_state, mcp, temp, unitab, intstamp, iframe, clusters, partsav, ibft, fbft, ibcv, fconv, irbe3, lrbe3, frbe3, front_rm, rbym, irbym, lcrbym, inoise, fnoise, ms0, admsms, nom_sect, ispsym, sh4tree, sh3tree, ipadmesh, ibfflux, fbfflux, sh4trim, sh3trim, padmesh, msc, mstg, inc, intg, ptg, mcpc, mcptg, rcontact, acontact, pcontact, mscnd, incnd, mssa, mstr, msp, msrt, ibcr, fradia, dmelc, dmeltg, dmels, dmeltr, dmelp, dmelrt, res_sms, isphio, lprtsph, lonfsph, vsphio, sphveln, alph, ifill, ims, irbe2, lrbe2, ms_ply, zi_ply, inod_pxfem, iel_pxfem, icodply, iskwply, addcne_pxfem, cne_pxfem, cel_pxfem, ithvar, xdp, table, celsph, icfield, lcfield, cfield, msz2, itask, diag_sms, iloadp, lloadp, loadp, inod_crkxfem, iel_crkxfem, addcne_crkxfem, cne_crkxfem, cel_crkxfem, ibufssg_io, intercep, ibordnode, iedgesh, ibordedge, linale, nodedge, iedge, cep_crkxfem, iedge_tmp, crknodiad, elbuf_tab, nom_opt, lgauge, gauge, igaup, ngaup, nodlevxf, frontb_r2r, dflow, vflow, wflow, sph2sol, sol2sph, irst, elcutc, nodenr, kxfenod2elc, enrtag, intbuf_tab, i11flag, xfem_tab, lenthgr, rthbuf, ixig3d, kxig3d, knot, ipartig3d, wige, ncrkpart, indx_crk, crklvset, crkshell, crksky, crkavx, crkedge, sensors, stack, xfem_phantom, t8, tab_ump, poin_ump, sol2sph_typ, addcsrect, csrect, drape, loads, itagnd, icnds10, addcncnd, cepcnd, celcnd, cncnd, nativ_sms, i24maxnsne, multi_fvm, segquadfr, intbuf_fric_tab, subset, igrnod, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart, igrsurf, igrslin, poin_part_shell, poin_part_tri, poin_part_sol, mid_pid_shell, mid_pid_tri, mid_pid_sol, tag_nm, nindx_nm, indx_nm, tag_scratch, nindx_scrt, indx_scrt, flag_24_25, numnod_l, tag_skn, multiple_skew, igrsurf_proc, knotlocpc, knotlocel, ale_elm, size_ale_elm, pinch_data, tag_skins6, ibcscyc, lbcscyc, t_monvol, indx_s, indx_q, indx_tg, face_elm_s, face_elm_q, face_elm_tg, nbr_th_monvol, ebcs_tab, kloadpinter, loadpinter, dgaploadint, s_loadpinter, len_cep, dynain_data, drapeg, user_windows, output, interfaces, number_load_cyl, loads_per_proc, python, dpl0cld, vel0cld, names_and_titles, bcs_per_proc, constraint_struct, glob_therm, pblast)
Definition ddsplit.F:336
plist_ifront
subroutine plist_ifront(tab, n, cpt)
Definition ddtools.F:153
nlocal
integer function nlocal(n, p)
Definition ddtools.F:349
the
end diagonal values have been computed in the(sparse) matrix id.SOL
secnd_surface_on_domain
integer function secnd_surface_on_domain(intercep, se, proc)
Definition i24setnodes.F:143
split_node_nodloc
subroutine split_node_nodloc(tab, dim1, tag, nodlocal)
Definition inter_tools.F:749
split_seg_nodloc_i24
subroutine split_seg_nodloc_i24(tab, dim1, dim2, tag_seg, nodlocal)
Definition inter_tools.F:5422
split_nisub_i7
subroutine split_nisub_i7(intbuf_tab, nsn_l, tag_node_2ry, nrtm_l, tag_segm, nisubs, nisubm)
Definition inter_tools.F:2735
split_remnode_i24
subroutine split_remnode_i24(proc, intbuf_tab, nrtm, nrtm_l, tag_segm2, nremnode, nodlocal, itab, is2id, intercep2, nsne, nodlocal24)
Definition inter_tools.F:6954
split_node_ival
subroutine split_node_ival(tab, dim1, dim2, tag)
Definition inter_tools.F:618
copy_node_nodloc
subroutine copy_node_nodloc(tab, dim1, nodlocal)
Definition inter_tools.F:707
split_node_nodloc_p0
subroutine split_node_nodloc_p0(tab, dim1, dim2, nodlocal)
Definition inter_tools.F:1150
split_isegpt_ival
subroutine split_isegpt_ival(isegpt, nsn_l, dim2, tag_node_2ry, ni, tag_2ry_inv, proc)
Definition inter_tools.F:6889
prepare_split_i21
subroutine prepare_split_i21(proc, intbuf_tab, ipari, tag_node_2ry, tag_segm, tag_node_2ry2, tag_segs, tag_node_msr, tag_scratch, intercep, ni, intth, nodlocal, msr_l_i21, mndd_i21, nindx_scrt, indx_scrt)
Definition inter_tools.F:4858
copy_ival
subroutine copy_ival(tab, dim1, dim2)
Definition inter_tools.F:979
prepare_split_i9
subroutine prepare_split_i9(proc, intbuf_tab, ipari, tag_node_2ry, tag_node_msr, tag_scratch, tag_ieles, tag_ielem, cep, cel, nindx_scrt, indx_scrt)
Definition inter_tools.F:3422
split_node_rval_dummy
subroutine split_node_rval_dummy(dim1, dim2, tag)
Definition inter_tools.F:835
split_node_ival_i25
subroutine split_node_ival_i25(tab, dimo, dimn, tag, tag2)
Definition inter_tools.F:5839
prepare_split_i24
subroutine prepare_split_i24(proc, intbuf_tab, ipari, intercep, tag_node_2ry, tag_segm, tag_segm2, tag_nm, tag_node_msr, tag_scratch, nodlocal24, nodlocal, intercep2, numnod_l, tag_nsne, tag_segs, tag_segs2, ni, tag_2ry_inv, iedge4, tag_node_2ry2, tag_ielem, cep, cel, tag_segss, nindx_nm, indx_nm, nindx_scrt, indx_scrt, nindx_ndlocal24, indx_ndlocal24, intercep3)
Definition inter_tools.F:5158
copy_rval
subroutine copy_rval(tab, dim1, dim2)
Definition inter_tools.F:1105
split_remnode_i25_edge
subroutine split_remnode_i25_edge(proc, intbuf_tab, nedge, nedge_l, tag_edge, tag_edge2, segloc, itab, numnod_l, nremnode_edg_l)
Definition inter_tools.F:7211
split_seg_ival_i20
subroutine split_seg_ival_i20(tab, tab_nlg, dim1, dim2, tag, tag_nlg)
Definition inter_tools.F:4300
prepare_split_i25
subroutine prepare_split_i25(proc, intbuf_tab, ipari, intercep, tag_node_2ry, tag_segm, tag_segm2, tag_nm, tag_node_msr, tag_scratch, tag_sm, knor2msr, nor2msr, tag_node_2ry2, nindx_nm, indx_nm, nindx_scrt, indx_scrt, nrtm_l)
Definition inter_tools.F:5906
split_cand_i11
subroutine split_cand_i11(proc, intbuf_tab, nrts, nrts_l, tag_segm2, tag_segs, ii_stok, multimp, ncont, noint, inacti, tag_scratch, intercep, ni, ipari_l, ii_stok_l, nindx_scrt, indx_scrt)
Definition inter_tools.F:3674
w_intbuf_size
subroutine w_intbuf_size(intbuf_tab_l)
Definition inter_tools.F:32
split_cand_i7
subroutine split_cand_i7(proc, intbuf_tab, nsn, nsn_l, tag_segm2, ii_stok, multimp, ncont, noint, inacti, tag_scratch, ii_stok_l, ityp, nindx_scrt, indx_scrt, nodlocal, numnod_l, numnod, numels, len_cep, cep, type18_law151)
Definition inter_tools.F:1747
split_seg_rval_i20
subroutine split_seg_rval_i20(tab, dim1, dim2, tag_seg)
Definition inter_tools.F:4258
split_cand_ival_i21
subroutine split_cand_ival_i21(tab, ii_stok_l, tag_ii, dim1, dim2)
Definition inter_tools.F:5004
split_cand_i24
subroutine split_cand_i24(proc, intbuf_tab, nsn, nsn_l, tag_segm2, ii_stok, multimp, ncont, noint, inacti, tag_scratch, ii_stok_l, intercep2, nindx_scrt, indx_scrt, nodlocal, numnod_l)
Definition inter_tools.F:5524
prepare_split_cand
subroutine prepare_split_cand(intbuf_tab, tag_segm2, ii_stok, tag_ii)
Definition inter_tools.F:1191
copy_ival_igeo
subroutine copy_ival_igeo(tab, dim1, dim2, offset)
Definition inter_tools.F:1063
split_seg_ival_i20_2
subroutine split_seg_ival_i20_2(tag_seg, dim1, tag_nlg)
Definition inter_tools.F:4340
split_remnode_i25_e2s
subroutine split_remnode_i25_e2s(proc, intbuf_tab, nrtm, nrtm_l, tag_edge, tag_edge2, segloc, itab, numnod_l, nremnode_e2s_l)
Definition inter_tools.F:7357
split_seg_ival2
subroutine split_seg_ival2(tab, dim1, tag, tag2)
Definition inter_tools.F:1504
prepare_split_cand_i20_edge
subroutine prepare_split_cand_i20_edge(intbuf_tab, tag_nlins2, ii_stok, tag_ii)
Definition inter_tools.F:4377
prepare_split_cand_i25_edge
subroutine prepare_split_cand_i25_edge(intbuf_tab, segloc, tag_edge, nedge_l, tag_edge2, nedge, ii_stok_e, ii_stok_e_l, tag_ii_e2e, ii_stok_s, ii_stok_s_l, tag_ii_e2s, proc, flagremnode, iremi2, nrtm, tag_jj_e2e, tag_jj_e2s)
Definition inter_tools.F:2155
split_node_ival_i24
subroutine split_node_ival_i24(tab, dim1, tag, tag2)
Definition inter_tools.F:5373
filter_node_nodloc
subroutine filter_node_nodloc(tab, dim1, tag, nodlocal)
Definition inter_tools.F:663
split_node_rval
subroutine split_node_rval(tab, dim1, dim2, tag)
Definition inter_tools.F:790
split_remnode_i25
subroutine split_remnode_i25(proc, intbuf_tab, nrtm, nrtm_l, tag_segm2, nremnode, nodlocal, nremnor, nsn, nsn_l, tag_node_2ry2, itab, numnod_l)
Definition inter_tools.F:2559
prepare_split_i11
subroutine prepare_split_i11(proc, intbuf_tab, ipari, tag_node_2ry, tag_segm, tag_segm2, tag_nm, tag_segs, tag_node_msr, tag_scratch, intercep, ni, nindx_nm, indx_nm, nindx_scrt, indx_scrt, tag_segs2)
Definition inter_tools.F:3550
split_seg_edge
subroutine split_seg_edge(nsne_l, is2se, tag_nsne, tag_seg2, ni)
Definition inter_tools.F:5792
split_adskyn_25
subroutine split_adskyn_25(adskyn, iadnor, nadmsr, admsr, nadmsr_l, nrtm_l, tag_segm, tag_sm, intercep)
Definition inter_tools.F:6775
split_cand_i25_edge
subroutine split_cand_i25_edge(intbuf_tab, segloc, proc, nin, tag_edge, nedge_l, tag_edge2, nedge, ii_stok_e, ii_stok_e_l, tag_ii_e2e, ii_stok_s, ii_stok_s_l, tag_ii_e2s, tag_jj_e2e, tag_jj_e2s)
Definition inter_tools.F:2439
split_nisub_i25
subroutine split_nisub_i25(intbuf_tab, nsn_l, tag_node_2ry, nrtm_l, tag_segm, nisubs, nisubm, iedge, nedge, nedge_l, tag_edge, tag_edge2, nisube, proc)
Definition inter_tools.F:2834
copy_ival_dummy
subroutine copy_ival_dummy(dim1, dim2)
Definition inter_tools.F:1021
prepare_split_i8
subroutine prepare_split_i8(proc, intbuf_tab, ipari, intercep, tag_node_2ry, tag_segm, tag_segm2, tag_nm, tag_node_msr, tag_node_msr2, tag_lmsr, tag_lmsr2, tag_nseg, tag_nseg2, ni, t8, itab, nindx_nm, indx_nm)
Definition inter_tools.F:3223
prepare_split_i17
subroutine prepare_split_i17(proc, intbuf_tab, ipari, tag_node_2ry, tag_node_msr, cep, cel, igrbric, nsn_l, nme_l)
Definition inter_tools.F:3865
split_lbound_i25
subroutine split_lbound_i25(nadmsr, nadmsr_l, lbound, tag_sm)
Definition inter_tools.F:6837
prepare_split_i2
subroutine prepare_split_i2(proc, intbuf_tab, nsn, nmn, nrtm, tag_node_2ry, tag_segm, tag_segm2, tag_irtl, tag, itabi2m, nodlocal, nbddi2m, nir, numnod_l)
Definition inter_tools.F:1376
split_xsav
subroutine split_xsav(intbuf_tab, numnod_l, nsn, nsn_l, nmn, nmn_l, tag_scratch, tag_node_msr, tag_nm, nodlocal, proc, ni, i710xsav, nindx_scrt, indx_scrt)
Definition inter_tools.F:2980
prepare_split_i20
subroutine prepare_split_i20(proc, intbuf_tab, ipari, tag_node_2ry, tag_segm, tag_node_msr, tag_segm2, tag_nm, tag_nlins, tag_nlinm, tag_nlins2, tag_nlinm2, tag_nlg, tag_nlg2, tag_scratch, intercep, ipari_l, ni, tag_nsne, tag_nmne, tag_nsve, tag_msre, nindx_nm, indx_nm, nindx_scrt, indx_scrt)
Definition inter_tools.F:3955
prepare_split_cand_i21
subroutine prepare_split_cand_i21(intbuf_tab, tag_node_2ry2, ii_stok, tag_ii, c_ii, proc)
Definition inter_tools.F:5091
split_cand_i20
subroutine split_cand_i20(proc, intbuf_tab, nsn, nsn_l, tag_segm2, ii_stok, multimp, ncont, noint, inacti, tag_scratch, ii_stok_l, ipari_l, ni, nindx_scrt, indx_scrt)
Definition inter_tools.F:4425
split_segedge_nodloc_i24
subroutine split_segedge_nodloc_i24(tab, dim1, tag_seg, nodlocal, ni)
Definition inter_tools.F:5468
split_cand_i25
subroutine split_cand_i25(proc, intbuf_tab, nsn, nsn_l, tag_segm2, ii_stok, multimp, ncont, noint, inacti, tag_scratch, ii_stok_l, nindx_scrt, indx_scrt)
Definition inter_tools.F:6556
split_remnode_i11
subroutine split_remnode_i11(proc, intbuf_tab, nrtm, nrtm_l, tag_segm2, nodlocal, itab, numnod_l, tag_segs2, nremnode_l)
Definition inter_tools.F:7098
prepare_split_i7
subroutine prepare_split_i7(proc, intbuf_tab, ipari, intercep, tag_node_2ry, tag_segm, tag_segm2, tag_nm, tag_node_msr, tag_scratch, ni, cep, multi_fvm, i710xsav, nindx_nm, indx_nm, nindx_scrt, indx_scrt, nodlocal, numnod_l)
Definition inter_tools.F:1559
split_cand_i20_edge
subroutine split_cand_i20_edge(proc, intbuf_tab, nlins, nlins_l, tag_nlins2, ii_stoke, multimp, nconte, noint, inacti, tag_scratch, ii_stoke_l, ipari_l, ni, nindx_scrt, indx_scrt)
Definition inter_tools.F:4649
split_cand_ival
subroutine split_cand_ival(tab, ii_stok_l, tag_ii, multimp, ncont)
Definition inter_tools.F:1233
split_seg_nodloc
subroutine split_seg_nodloc(tab, dim1, dim2, tag_seg, nodlocal)
Definition inter_tools.F:880
split_ledge_i25
subroutine split_ledge_i25(nedge, nedge_l, irectm, nrtm_l, ledge, mseglo, admsr, segloc, tag_sm, nodlocal, tag_edge, itab, proc)
Definition inter_tools.F:6104
split_cand_rval_dummy
subroutine split_cand_rval_dummy(ii_stok_l, tag_ii, multimp, ncont)
Definition inter_tools.F:1319
split_2ry_cand_ival_i21
subroutine split_2ry_cand_ival_i21(tab, ii_stok_l, tag_ii, tag_node_2ry2, dim1)
Definition inter_tools.F:5048
split_cand_rval
subroutine split_cand_rval(tab, ii_stok_l, tag_ii, multimp, ncont)
Definition inter_tools.F:1275
split_remnode_i7
subroutine split_remnode_i7(proc, intbuf_tab, nrtm, nrtm_l, tag_segm2, nremnode, nodlocal, itab, numnod_l)
Definition inter_tools.F:2026
split_seg_segloc
subroutine split_seg_segloc(tab, dim1, dim2, tag_seg, seglocal)
Definition inter_tools.F:926
split_node_ival2
subroutine split_node_ival2(tab, dim1, dim2, tag_segm2, tag_node_2ry)
Definition inter_tools.F:1463
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
front_mod
Definition front_mod.F:84
groupdef_mod
Definition groupdef_mod.F:662
i25_fie_mod
Definition i25_fie_mod.F:30
i25_fie_mod::i25_split_cand
type(i25_cand_), dimension(:,:), allocatable i25_split_cand
Definition i25_fie_mod.F:53
message_mod
Definition message_mod.F:1249
split_interfaces
subroutine split_interfaces(intbuf_tab, ipari, proc, intbuf_tab_l, ipari_l, intercep, nodlocal, itab, itabi2m, nbddi2m, numnod_l, len_cep, cep, cel, igrbric, t8, multi_fvm, tag_nm, nindx_nm, indx_nm, tag_scratch, nindx_scrt, indx_scrt, flag_24_25, i24maxnsne, intbuf_fric_tab)
Definition split_interfaces.F:103
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
nl
character *2 function nl()
Definition message.F:2354
lectur
subroutine lectur(multi_fvm, lsubmodel, is_dyna, detonators, ebcs_tab, seatbelt_converted_elements, nb_seatbelt_shells, nb_dyna_include, user_windows, output, mat_elem, names_and_titles, defaults, glob_therm, pblast, sensor_user_struct)
Definition lectur.F:533
arret
subroutine arret(nn)
Definition arret.F:87
starter
program starter
Definition starter.F:39
front_mod::intersurfp
Definition front_mod.F:109
write_db
subroutine write_db(a, n)
Definition write_db.F:140
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645