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 second 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 ! Specific Igeo surface
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 Locating candidates on remote processors
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 Sorting remote candidates by proc and by ascending local nsv
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 remote node : numbering pre-calculated above
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 Second is also local
2497 cands_e2e(id) = tag_edge2(intbuf_tab%CANDS_E2E(i))
2498 ELSE
2499C Remote second C ASSERT(.FALSE.)
2500C CANDS_E2E(ID) = -INTBUF_TAB%CANDS_E2E(I)
2501 cands_e2e(id) = abs(i25_split_cand(nin,proc+1)%CANDS_E2E(jj)) + nedge_l
2502
2503 ENDIF
2504 ENDDO
2505
2506 ALLOCATE(candm_e2s(ii_stok_s_l))
2507 ALLOCATE(cands_e2s(ii_stok_s_l))
2508C local numbering of E2S candidates
2509 id = 0
2510 assert(ii_stok_s_l == i25_split_cand(nin,proc+1)%NB_CAND_E2S)
2511C WRITE(6,*) PROC,"NBCAND=",II_STOK_S_L,I25_SPLIT_CAND(NIN,PROC+1)%NB_CAND_E2S
2512
2513 DO j = 1, ii_stok_s_l
2514 i = tag_ii_e2s(j)
2515 jj = tag_jj_e2s(i)
2516C main edge is local
2517 assert(i > 0)
2518 id = id + 1
2519 candm_e2s(id) = segloc(intbuf_tab%CANDM_E2S(i))
2520C IF(TAG_EDGE2(INTBUF_TAB%CANDS_E2S(I)) > 0) THEN
2521 IF(intbuf_tab%LEDGE(9+(intbuf_tab%CANDS_E2S(i)-1)*nledge) == proc ) THEN
2522C Second is also local
2523 cands_e2s(id) = tag_edge2(intbuf_tab%CANDS_E2S(i))
2524 assert(cands_e2s(id) == i25_split_cand(nin,proc+1)%CANDS_E2S(jj))
2525 ELSE
2526C Remote second C ASSERT(.FALSE.)
2527 cands_e2s(id) = abs(i25_split_cand(nin,proc+1)%CANDS_E2S(jj)) + nedge_l
2528C CANDS_E2S(ID) = - INTBUF_TAB%CANDS_E2S(I)
2529 ENDIF
2530 ENDDO
2531
2532 CALL write_i_c(candm_e2e,ii_stok_e_l)
2533 CALL write_i_c(cands_e2e,ii_stok_e_l)
2534 CALL write_i_c(candm_e2s,ii_stok_s_l)
2535 CALL write_i_c(cands_e2s,ii_stok_s_l)
2536 DEALLOCATE(candm_e2e)
2537 DEALLOCATE(cands_e2e)
2538 DEALLOCATE(candm_e2s)
2539 DEALLOCATE(cands_e2s)
2540
2541 RETURN
2542 END
2543
2544!||====================================================================
2545!|| split_remnode_i25 ../starter/source/restart/ddsplit/inter_tools.F
2546!||--- called by ------------------------------------------------------
2547!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
2548!||--- calls -----------------------------------------------------
2549!||--- uses -----------------------------------------------------
2550!|| front_mod ../starter/share/modules1/front_mod.F
2551!|| message_mod ../starter/share/message_module/message_mod.F
2552!||====================================================================
2553 SUBROUTINE split_remnode_i25(PROC , INTBUF_TAB, NRTM , NRTM_L ,
2554 . TAG_SEGM2 , NREMNODE , NODLOCAL ,NREMNOR,
2555 . NSN , NSN_L ,TAG_NODE_2RY2,ITAB,
2556 . NUMNOD_L)
2557C-----------------------------------------------
2558C M o d u l e s
2559C-----------------------------------------------
2560 USE message_mod
2561 USE intbufdef_mod
2562 USE front_mod
2563C-----------------------------------------------
2564C I m p l i c i t T y p e s
2565C-----------------------------------------------
2566#include "implicit_f.inc"
2567C-----------------------------------------------
2568C C o m m o n B l o c k s
2569C-----------------------------------------------
2570#include "com04_c.inc"
2571C-----------------------------------------------
2572C D u m m y A r g u m e n t s
2573C-----------------------------------------------
2574 INTEGER PROC ,NRTM ,NRTM_L ,NSN ,NSN_L ,NREMNOR ,
2575 . TAG_SEGM2(*) ,NREMNODE ,NODLOCAL(*) ,
2576 . TAG_NODE_2RY2(*),ITAB(*)
2577 INTEGER, INTENT(IN) :: NUMNOD_L
2578
2579 TYPE(INTBUF_STRUCT_) :: INTBUF_TAB
2580! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
2581! NODLOCAL : integer, dimension=NUMNOD
2582! gives the local ID of a global element
2583! --> used here to avoid NLOCAL call (the NLOCAL perf is bad)
2584! NODLOCAL /= 0 if the element is on the current domain/processor
2585! and =0 if the element is not on the current domain
2586! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
2587C-----------------------------------------------
2588C F u n c t i o n
2589C-----------------------------------------------
2590! INTEGER NLOCAL
2591! EXTERNAL NLOCAL
2592C-----------------------------------------------
2593C L o c a l V a r i a b l e s
2594C-----------------------------------------------
2595 INTEGER I,J,K,SIZ,LL,
2596 . L,SIZ1 ,SIZ2 ,M ,N ,NS
2597
2598 INTEGER, DIMENSION(:),ALLOCATABLE ::
2599 . IBUF1,IBUF2,NODDEL,NODDELREMOTE
2600 INTEGER, DIMENSION(:),ALLOCATABLE ::
2601 . SIZ_TMP
2602C ----------------------------------------
2603 ALLOCATE(siz_tmp(nrtm),noddel(numnod),
2604 . noddelremote(numnod))
2605
2606 ALLOCATE(ibuf1(2*(nrtm_l + 1)), ibuf2(nremnode))
2607 ibuf1(1:2*(nrtm_l+1)) = 0
2608 ibuf2(1:nremnode) = 0
2609
2610 siz_tmp(1:nrtm) = 0
2611
2612 DO k=1,nrtm
2613 IF(tag_segm2(k) /= 0)THEN
2614 siz_tmp(tag_segm2(k)) = intbuf_tab%KREMNODE(k+1)
2615 . -intbuf_tab%KREMNODE(k)
2616 ENDIF
2617 END DO
2618
2619 ibuf1(1) = 0
2620
2621 noddel(1:numnod) = 0
2622 noddelremote(1:numnod) = 0
2623 siz1 = 0
2624 siz2 = 0
2625 DO k=1,nrtm
2626 IF(tag_segm2(k) /= 0)THEN
2627
2628 siz = siz_tmp(tag_segm2(k))
2629 ibuf1(1+2*tag_segm2(k)) =ibuf1(1+2*(tag_segm2(k)-1)) + siz
2630
2631 l=intbuf_tab%KREMNODE(k)
2632 siz1 = 0
2633 siz2 = 0
2634 DO m=1,siz
2635 n = intbuf_tab%REMNODE(l+m)
2636 IF( nodlocal(n)/=0.AND.nodlocal(n)<=numnod_l ) THEN
2637 noddel(siz1+1) = nodlocal(n)
2638 siz1 = siz1+1
2639 ENDIF
2640 ENDDO
2641 DO m=1,siz
2642 n = intbuf_tab%REMNODE(l+m)
2643 IF( nodlocal(n)==0.OR.nodlocal(n)>numnod_l ) THEN
2644 noddelremote(siz2+1) = itab(n)
2645 siz2 = siz2+1
2646 ENDIF
2647 ENDDO
2648 l=ibuf1(1+2*(tag_segm2(k)-1))
2649 DO m=1,siz1
2650 ibuf2(1+l+m-1)= noddel(m)
2651 ENDDO
2652 ibuf1(1+2*(tag_segm2(k)-1)+1) = l + siz1
2653 l=ibuf1(1+2*(tag_segm2(k)-1)+1)
2654 DO m=1,siz2
2655 ibuf2(1+l+m-1) = - noddelremote(m)
2656 ENDDO
2657 ENDIF
2658 DO m=1,siz1
2659 noddel(m) = 0
2660 ENDDO
2661 DO m=1,siz2
2662 noddelremote(m) = 0
2663 ENDDO
2664 ENDDO
2665
2666 DEALLOCATE(siz_tmp,noddel,noddelremote)
2667
2668 CALL write_i_c(ibuf1,2*(nrtm_l + 1))
2669 CALL write_i_c(ibuf2,nremnode)
2670
2671 DEALLOCATE(ibuf1, ibuf2)
2672
2673C----Tab Main segment removed for each second node----
2674c 1st : reorganizing the tab : keep only local main segments
2675
2676 ALLOCATE(ibuf1(nsn_l+1),ibuf2(nremnor))
2677
2678 ALLOCATE(noddel(nrtm))
2679
2680 ibuf1(1:nsn_l+1) = 0
2681 ibuf2(1:nremnor) = 0
2682
2683 DO n=1,nsn
2684
2685 ns = tag_node_2ry2(n)
2686 IF(ns /= 0)THEN
2687 siz = intbuf_tab%KREMNOR(n+1)-intbuf_tab%KREMNOR(n)
2688
2689 l=intbuf_tab%KREMNOR(n)
2690 siz1 = 0
2691c
2692 DO m=1,siz
2693 i = intbuf_tab%REMNOR(l+m)
2694 IF(tag_segm2(i)/=0) THEN
2695 noddel(siz1+1) = tag_segm2(i)
2696 siz1 = siz1+1
2697 ENDIF
2698 ENDDO
2699c
2700 l=ibuf1(ns)
2701 DO m=1,siz1
2702 ibuf2(l+m)= noddel(m)
2703 ENDDO
2704 ibuf1(ns+1) = l +siz1
2705
2706 DO m=1,siz1
2707 noddel(m) = 0
2708 ENDDO
2709
2710 ENDIF
2711 ENDDO
2712
2713 DEALLOCATE(noddel)
2714
2715 CALL write_i_c(ibuf1,nsn_l+1)
2716 CALL write_i_c(ibuf2,nremnor)
2717
2718 DEALLOCATE(ibuf1, ibuf2)
2719
2720
2721 RETURN
2722 END
2723!||====================================================================
2724!|| split_nisub_i7 ../starter/source/restart/ddsplit/inter_tools.F
2725!||--- called by ------------------------------------------------------
2726!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
2727!||--- calls -----------------------------------------------------
2728!||--- uses -----------------------------------------------------
2729!|| message_mod ../starter/share/message_module/message_mod.F
2730!||====================================================================
2731 SUBROUTINE split_nisub_i7(INTBUF_TAB, NSN_L , TAG_NODE_2RY, NRTM_L,
2732 . TAG_SEGM , NISUBS, NISUBM )
2733C-----------------------------------------------
2734C M o d u l e s
2735C-----------------------------------------------
2736 USE message_mod
2737 USE intbufdef_mod
2738C-----------------------------------------------
2739C I m p l i c i t T y p e s
2740C-----------------------------------------------
2741#include "implicit_f.inc"
2742C-----------------------------------------------
2743C D u m m y A r g u m e n t s
2744C-----------------------------------------------
2745 INTEGER NSN_L,NRTM_L,NISUBS,NISUBM,
2746 . TAG_NODE_2RY(*),TAG_SEGM(*)
2747
2748 TYPE(intbuf_struct_) :: INTBUF_TAB
2749C-----------------------------------------------
2750C L o c a l V a r i a b l e s
2751C-----------------------------------------------
2752 INTEGER I,J,K,NISUBS_L,NISUBM_L
2753
2754 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF1 !KD(29)
2755 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF2 !KD(30)
2756 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF3 !KD(31)
2757 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF4 !KD(32)
2758 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF5
2759 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF6
2760C ----------------------------------------
2761 ALLOCATE(IBUF1(NSN_L+1))
2762 ALLOCATE(IBUF2(NRTM_L+1))
2763 ALLOCATE(ibuf3(nisubs))
2764 ALLOCATE(ibuf4(nisubm))
2765 ALLOCATE(ibuf5(nisubs))
2766 ALLOCATE(ibuf6(nisubm))
2767
2768
2769 ibuf1(1: nsn_l+1) = 0
2770 ibuf2(1: nrtm_l+1) = 0
2771 ibuf3(1: nisubs) = 0
2772 ibuf4(1: nisubm) = 0
2773 ibuf5(1: nisubs) = 0
2774 ibuf6(1: nisubm) = 0
2775
2776 nisubs_l = 0
2777
2778 DO k=1,nsn_l
2779 ibuf1(k) = nisubs_l + 1
2780 j=tag_node_2ry(k)
2781 DO i = intbuf_tab%ADDSUBS(j),intbuf_tab%ADDSUBS(j+1)-1
2782 ibuf3(1+nisubs_l) = intbuf_tab%LISUBS(i)
2783 IF(intbuf_tab%S_INFLG_SUBS > 0) ibuf5(1+nisubs_l) = intbuf_tab%INFLG_SUBS(i)
2784 nisubs_l = nisubs_l + 1
2785 END DO
2786 END DO
2787
2788 ibuf1(nsn_l+1) = nisubs_l + 1
2789C
2790 nisubm_l = 0
2791 DO k=1,nrtm_l
2792 ibuf2(k) = nisubm_l + 1
2793 j=tag_segm(k)
2794 DO i = intbuf_tab%ADDSUBM(j),
2795 . intbuf_tab%ADDSUBM(j+1)-1
2796 ibuf4(1+nisubm_l) = intbuf_tab%LISUBM(i)
2797 IF(intbuf_tab%S_INFLG_SUBM > 0) ibuf6(1+nisubm_l) = intbuf_tab%INFLG_SUBM(i)
2798 nisubm_l = nisubm_l + 1
2799 END DO
2800 END DO
2801
2802 ibuf2(nrtm_l+1) = nisubm_l + 1
2803
2804 CALL write_i_c(ibuf1,nsn_l+1)
2805 CALL write_i_c(ibuf2,nrtm_l+1)
2806 CALL write_i_c(ibuf3,nisubs)
2807 CALL write_i_c(ibuf4,nisubm)
2808 IF(intbuf_tab%S_INFLG_SUBS > 0) CALL write_i_c(ibuf5,nisubs) !INFLG_SUBS
2809 IF(intbuf_tab%S_INFLG_SUBM > 0) CALL write_i_c(ibuf6,nisubm) !INFLG_SUBM
2810
2811 DEALLOCATE(ibuf1,ibuf2,ibuf3,ibuf4,ibuf5,ibuf6)
2812
2813 RETURN
2814 END
2815!||====================================================================
2816!|| split_nisub_i25 ../starter/source/restart/ddsplit/inter_tools.F
2817!||--- called by ------------------------------------------------------
2818!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
2819!||--- calls -----------------------------------------------------
2820!||--- uses -----------------------------------------------------
2821!|| message_mod ../starter/share/message_module/message_mod.F
2822!||====================================================================
2823 SUBROUTINE split_nisub_i25(INTBUF_TAB, NSN_L , TAG_NODE_2RY, NRTM_L,
2824 1 TAG_SEGM , NISUBS, NISUBM ,
2825 2 IEDGE,
2826 3 NEDGE,
2827 4 NEDGE_L,
2828 5 TAG_EDGE,
2829 6 TAG_EDGE2,
2830 7 NISUBE,
2831 9 PROC)
2832
2833C-----------------------------------------------
2834C M o d u l e s
2835C-----------------------------------------------
2836 USE message_mod
2837 USE intbufdef_mod
2838C-----------------------------------------------
2839C I m p l i c i t T y p e s
2840C-----------------------------------------------
2841#include "implicit_f.inc"
2842C-----------------------------------------------
2843C C o m m o n B l o c k s
2844C-----------------------------------------------
2845#include "param_c.inc"
2846C-----------------------------------------------
2847C D u m m y A r g u m e n t s
2848C-----------------------------------------------
2849 INTEGER NSN_L,NRTM_L,NISUBS,NISUBM,
2850 . TAG_NODE_2RY(*),TAG_SEGM(*)
2851 INTEGER, INTENT(IN) :: IEDGE
2852 INTEGER, INTENT(IN) :: NEDGE
2853 INTEGER, INTENT(IN) :: NEDGE_L
2854 INTEGER, INTENT(IN) :: TAG_EDGE(NEDGE_L) ! Local To global
2855 INTEGER, INTENT(IN) :: TAG_EDGE2(NEDGE) ! Global to local
2856 INTEGER, INTENT(IN) :: NISUBE !local number
2857 INTEGER, INTENT(IN) :: PROC !local number
2858
2859
2860
2861
2862 TYPE(intbuf_struct_) :: INTBUF_TAB
2863C-----------------------------------------------
2864C L o c a l V a r i a b l e s
2865C-----------------------------------------------
2866 INTEGER I,J,K,NISUBS_L,NISUBM_L,NISUBE_L
2867
2868 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF1
2869 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF2
2870 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF3
2871 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF4
2872 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF5
2873 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF6
2874C ----------------------------------------
2875 ALLOCATE(IBUF1(NSN_L+1))
2876 ALLOCATE(IBUF2(NRTM_L+1))
2877 ALLOCATE(IBUF3(NISUBS))
2878 ALLOCATE(IBUF4(NISUBM))
2879 ALLOCATE(IBUF5(NISUBS))
2880 ALLOCATE(IBUF6(NISUBM))
2881
2882 IBUF1(1: NSN_L+1) = 0
2883 ibuf2(1: nrtm_l+1) = 0
2884 ibuf3(1: nisubs) = 0
2885 ibuf4(1: nisubm) = 0
2886 ibuf5(1: nisubs) = 0
2887 ibuf6(1: nisubm) = 0
2888
2889 nisubs_l = 0
2890
2891 DO k=1,nsn_l
2892 ibuf1(k) = nisubs_l + 1
2893 j=tag_node_2ry(k)
2894 DO i = intbuf_tab%ADDSUBS(j),intbuf_tab%ADDSUBS(j+1)-1
2895 ibuf3(1+nisubs_l) = intbuf_tab%LISUBS(i)
2896 ibuf5(1+nisubs_l) = intbuf_tab%INFLG_SUBS(i)
2897 nisubs_l = nisubs_l + 1
2898 END DO
2899 END DO
2900
2901 ibuf1(nsn_l+1) = nisubs_l + 1
2902C
2903 nisubm_l = 0
2904 DO k=1,nrtm_l
2905 ibuf2(k) = nisubm_l + 1
2906 j=tag_segm(k)
2907 DO i = intbuf_tab%ADDSUBM(j),
2908 . intbuf_tab%ADDSUBM(j+1)-1
2909 ibuf4(1+nisubm_l) = intbuf_tab%LISUBM(i)
2910 ibuf6(1+nisubm_l) = intbuf_tab%INFLG_SUBM(i)
2911 nisubm_l = nisubm_l + 1
2912 END DO
2913 END DO
2914
2915 ibuf2(nrtm_l+1) = nisubm_l + 1
2916
2917 CALL write_i_c(ibuf1,nsn_l+1) !ADDSUBS
2918 CALL write_i_c(ibuf2,nrtm_l+1) ! ADDSUBM
2919 CALL write_i_c(ibuf3,nisubs) !LISUBSS
2920 CALL write_i_c(ibuf4,nisubm) !LISUBMI
2921 CALL write_i_c(ibuf5,nisubs) !INFLG_SUBS
2922 CALL write_i_c(ibuf6,nisubm) !INFLG_SUBM
2923
2924 DEALLOCATE(ibuf1,ibuf2,ibuf3,ibuf4,ibuf5,ibuf6)
2925
2926 IF(iedge/=0)THEN ! FAIRE SPMD
2927C CALL COPY_IVAL(INTBUF_TAB(NI)%ADDSUBE,NEDGE+1,1)
2928C CALL COPY_IVAL(INTBUF_TAB(NI)%LISUBE,NISUBE_L,1)
2929C CALL COPY_IVAL(INTBUF_TAB(NI)%INFLG_SUBE,NISUBE_L,1)
2930
2931 ALLOCATE(ibuf1(nedge_l+1))
2932 ALLOCATE(ibuf3(nisube))
2933 ALLOCATE(ibuf5(nisube))
2934
2935 ibuf1(1: nedge_l+1) = 0
2936 ibuf3(1: nisube) = 0
2937 ibuf5(1: nisube) = 0
2938
2939 nisube_l = 0
2940
2941 DO k=1,nedge_l
2942 ibuf1(k) = nisube_l + 1
2943 j=tag_edge(k)
2944 IF(intbuf_tab%LEDGE(nledge*(j-1)+9) == proc ) THEN ! IF current proc own the edge
2945 DO i = intbuf_tab%ADDSUBE(j),intbuf_tab%ADDSUBE(j+1)-1
2946 ibuf3(1+nisube_l) = intbuf_tab%LISUBE(i)
2947 ibuf5(1+nisube_l) = intbuf_tab%INFLG_SUBE(i)
2948 nisube_l = nisube_l + 1
2949 END DO
2950 ENDIF
2951 END DO
2952
2953 ibuf1(nedge_l+1) = nisube_l + 1
2954 CALL write_i_c(ibuf1,nedge_l+1) !ADDSUBE
2955 CALL write_i_c(ibuf3,nisube) !LISUBES
2956 CALL write_i_c(ibuf5,nisube) !INFLG_SUBE
2957 DEALLOCATE(ibuf1)
2958 DEALLOCATE(ibuf3)
2959 DEALLOCATE(ibuf5)
2960 assert(nisube == nisube_l)
2961
2962
2963 END IF
2964
2965
2966 RETURN
2967 END
2968!||====================================================================
2969!|| split_xsav ../starter/source/restart/ddsplit/inter_tools.F
2970!||--- calls -----------------------------------------------------
2971!|| nlocal ../starter/source/spmd/node/ddtools.F
2972!||--- uses -----------------------------------------------------
2973!||====================================================================
2974 SUBROUTINE split_xsav(INTBUF_TAB, NUMNOD_L, NSN, NSN_L,
2975 . NMN , NMN_L , TAG_SCRATCH, TAG_NODE_MSR,
2976 . TAG_NM , NODLOCAL, PROC , NI ,I710XSAV,
2977 . NINDX_SCRT, INDX_SCRT)
2978
2979C-----------------------------------------------
2980C M o d u l e s
2981C-----------------------------------------------
2982 USE intbufdef_mod
2983C-----------------------------------------------
2984C I m p l i c i t T y p e s
2985C-----------------------------------------------
2986#include "implicit_f.inc"
2987C-----------------------------------------------
2988C C o m m o n B l o c k s
2989C-----------------------------------------------
2990#include "com04_c.inc"
2991C-----------------------------------------------
2992C D u m m y A r g u m e n t s
2993C-----------------------------------------------
2994 INTEGER NUMNOD_L,NSN,NSN_L,NMN,
2995 . nmn_l, nod, proc, ni
2996 INTEGER TAG_SCRATCH(*), TAG_NODE_MSR(*),
2997 . tag_nm(*), nodlocal(*)
2998 INTEGER, INTENT(INOUT) :: NINDX_SCRT
2999 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_SCRT
3000
3001 TYPE(intbuf_struct_) :: INTBUF_TAB
3002 INTEGER I710XSAV(*)
3003C-----------------------------------------------
3004C F u n c t i o n
3005C-----------------------------------------------
3006 INTEGER NLOCAL
3007 EXTERNAL NLOCAL
3008C-----------------------------------------------
3009C L o c a l V a r i a b l e s
3010C-----------------------------------------------
3011 INTEGER I,J,K,L,N,N2,NSN_L2,NMN_L2,
3012 . siz_xsav,tag
3013
3014 my_real, DIMENSION(:),ALLOCATABLE :: rbuf
3015C ----------------------------------------
3016
3017 siz_xsav = 3*min(numnod_l,nsn_l+nmn_l)
3018 ALLOCATE(rbuf(siz_xsav))
3019 rbuf(1:siz_xsav) = zero
3020
3021C XSAVE
3022C NSN+NMN < NUMNOD
3023#include "vectorize.inc"
3024 DO k=1,nindx_scrt
3025 n = indx_scrt(k)
3026 tag_scratch(n) = 0
3027 ENDDO
3028 nindx_scrt = 0
3029 IF (nsn+nmn<=numnod)THEN
3030C NSN_L + NMN_L < NUMNOD_L
3031 IF (nsn_l+nmn_l<=numnod_l)THEN
3032C 1st part nsn
3033 nsn_l2 = 0
3034! TAG_SCRATCH(1:NUMNOD)=0
3035 DO k=1,nsn
3036 n=intbuf_tab%NSV(k)
3037 IF(nlocal(n,proc+1)==1.AND.
3038 . tag_scratch(n)==0) THEN
3039 rbuf(3*(nsn_l2)+1) =
3040 * intbuf_tab%XSAV(3*(k-1)+1)
3041 rbuf(3*(nsn_l2)+2) =
3042 * intbuf_tab%XSAV(3*(k-1)+2)
3043 rbuf(3*(nsn_l2)+3) =
3044 * intbuf_tab%XSAV(3*(k-1)+3)
3045 nsn_l2 = nsn_l2 + 1
3046 tag_scratch(n)=1
3047 nindx_scrt = nindx_scrt + 1
3048 indx_scrt(nindx_scrt) = n
3049 ENDIF
3050 ENDDO
3051
3052C 2nd part NMN
3053 DO k=1,nmn
3054 n = intbuf_tab%MSR(k)
3055 IF(nlocal(n,proc+1)==1)THEN
3056 nod = nodlocal(n)
3057 DO l=1,nmn
3058 IF (i710xsav(l)==nod)THEN
3059 rbuf(3*nsn_l+3*(l-1)+1)=
3060 * intbuf_tab%XSAV(3*nsn+3*(k-1)+1)
3061 rbuf(3*nsn_l+3*(l-1)+2)=
3062 * intbuf_tab%XSAV(3*nsn+3*(k-1)+2)
3063 rbuf(3*nsn_l+3*(l-1)+3)=
3064 * intbuf_tab%XSAV(3*nsn+3*(k-1)+3)
3065 GOTO 600
3066 ENDIF
3067 ENDDO
3068 ENDIF
3069 600 CONTINUE
3070 ENDDO
3071
3072 ELSE
3073C NSN_L + NMN_L > NUMNOD_L
3074C 1st part nsn
3075 nsn_l2 = 0
3076! TAG_SCRATCH(1:NUMNOD)=0
3077 DO k=1,nsn
3078 n = intbuf_tab%NSV(k)
3079 IF(nlocal(n,proc+1)==1.AND.
3080 . tag_scratch(n)==0) THEN
3081 n2 = nodlocal(n)
3082 rbuf(3*(n2-1)+1) =
3083 * intbuf_tab%XSAV(3*(k-1)+1)
3084 rbuf(3*(n2-1)+2) =
3085 * intbuf_tab%XSAV(3*(k-1)+2)
3086 rbuf(3*(n2-1)+3) =
3087 * intbuf_tab%XSAV(3*(k-1)+3)
3088 nsn_l2 = nsn_l2 + 1
3089 tag_scratch(n)=1
3090 nindx_scrt = nindx_scrt + 1
3091 indx_scrt(nindx_scrt) = n
3092 ENDIF
3093 ENDDO
3094
3095C 2nd part NMN
3096 nmn_l2 = 0
3097 DO k=1,nmn
3098 n=intbuf_tab%MSR(k)
3099 IF(nlocal(n,proc+1)==1)THEN
3100 n2 = nodlocal(n)
3101 IF (tag_nm(n)==1)THEN
3102 rbuf(3*(n2-1)+1) =
3103 * intbuf_tab%XSAV(3*nsn+3*(k-1)+1)
3104 rbuf(3*(n2-1)+2) =
3105 * intbuf_tab%XSAV(3*nsn+3*(k-1)+2)
3106 rbuf(3*(n2-1)+3) =
3107 * intbuf_tab%XSAV(3*nsn+3*(k-1)+3)
3108 nmn_l2 = nmn_l2 + 1
3109 ENDIF
3110 ENDIF
3111 ENDDO
3112 ENDIF
3113
3114 ELSE
3115C NSN+NMN > NUMNOD
3116 IF(nsn_l+ nmn_l < numnod_l)THEN
3117C NSN_L+NMN_L < NUMNOD_L
3118 nsn_l2 = 0
3119 DO k=1,nsn
3120 n=intbuf_tab%NSV(k)
3121 IF(nlocal(n,proc+1)==1) THEN
3122 n2=nodlocal(n)
3123 rbuf(3*nsn_l2+1) =
3124 * intbuf_tab%XSAV(3*(n-1)+1)
3125 rbuf(3*nsn_l2+2) =
3126 * intbuf_tab%XSAV(3*(n-1)+2)
3127 rbuf(3*nsn_l2+3) =
3128 * intbuf_tab%XSAV(3*(n-1)+3)
3129 nsn_l2 = nsn_l2 + 1
3130 tag_scratch(n)=1
3131 nindx_scrt = nindx_scrt + 1
3132 indx_scrt(nindx_scrt) = n
3133 ENDIF
3134 ENDDO
3135
3136 DO k=1,nmn
3137 n=intbuf_tab%MSR(k)
3138 IF(nlocal(n,proc+1)==1)THEN
3139 nod = nodlocal(n)
3140 DO l=1,nmn
3141c IF (I710SAV(NI)%P(L)==NOD)THEN
3142 tag = tag_node_msr(l)
3143 IF (intbuf_tab%MSR(tag)==nod)THEN
3144 rbuf(3*nsn_l2+3*(l-1)) =
3145 * intbuf_tab%XSAV(3*(n-1)+1)
3146 rbuf(3*nsn_l2+3*(l-1)+1) =
3147 * intbuf_tab%XSAV(3*(n-1)+2)
3148 rbuf(3*nsn_l2+3*(l-1)+2) =
3149 * intbuf_tab%XSAV(3*(n-1)+3)
3150 GOTO 610
3151 ENDIF
3152 ENDDO
3153 ENDIF
3154 610 CONTINUE
3155 ENDDO
3156
3157C NSN_L+NMN_L > NUMNOD_L
3158 ELSE
3159 nsn_l2 = 0
3160 DO k=1,nsn
3161 n=intbuf_tab%NSV(k)
3162 IF(nlocal(n,proc+1)==1) THEN
3163 n2=nodlocal(n)
3164 rbuf(3*(n2-1)+1) = intbuf_tab%XSAV(3*(n-1)+1)
3165 rbuf(3*(n2-1)+2) = intbuf_tab%XSAV(3*(n-1)+2)
3166 rbuf(3*(n2-1)+3) = intbuf_tab%XSAV(3*(n-1)+3)
3167 nsn_l2 = nsn_l2 + 1
3168 tag_scratch(n)=1
3169 nindx_scrt = nindx_scrt + 1
3170 indx_scrt(nindx_scrt) = n
3171 ENDIF
3172 ENDDO
3173
3174 DO k=1,nmn
3175 n=intbuf_tab%MSR(k)
3176 IF(nlocal(n,proc+1)==1)THEN
3177 IF (tag_nm(n)==1)THEN
3178 n2=nodlocal(n)
3179 rbuf(3*(n2-1)+1) =
3180 * intbuf_tab%XSAV(3*(n-1)+1)
3181 rbuf(3*(n2-1)+2) =
3182 * intbuf_tab%XSAV(3*(n-1)+2)
3183 rbuf(3*(n2-1)+3) =
3184 * intbuf_tab%XSAV(3*(n-1)+3)
3185 ENDIF
3186 ENDIF
3187 ENDDO
3188 ENDIF
3189 ENDIF
3190
3191 CALL write_db(rbuf,siz_xsav)
3192
3193
3194 DEALLOCATE(rbuf)
3195
3196 RETURN
3197 END
3198
3199C=======================================================================
3200C END SPECIFIC ROUTINES INT7
3201C=======================================================================
3202
3203C=======================================================================
3204C SPECIFIC ROUTINES INT8
3205C=======================================================================
3206!||====================================================================
3207!|| prepare_split_i8 ../starter/source/restart/ddsplit/inter_tools.F
3208!||--- called by ------------------------------------------------------
3209!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
3210!||--- calls -----------------------------------------------------
3211!|| nlocal ../starter/source/spmd/node/ddtools.F
3212!||--- uses -----------------------------------------------------
3213!|| front_mod ../starter/share/modules1/front_mod.F
3214!||====================================================================
3215 SUBROUTINE prepare_split_i8(PROC , INTBUF_TAB , IPARI ,
3216 . INTERCEP , TAG_NODE_2RY, TAG_SEGM ,
3217 . TAG_SEGM2, TAG_NM , TAG_NODE_MSR,
3218 . TAG_NODE_MSR2,TAG_LMSR,TAG_LMSR2,
3219 . TAG_NSEG,TAG_NSEG2,
3220 . NI,T8,ITAB,NINDX_NM,INDX_NM)
3221C Computes the TAGS used to split the data
3222C Local renumbering of T8%BUFFER ID
3223C-----------------------------------------------
3224C M o d u l e s
3225C-----------------------------------------------
3226 USE intbufdef_mod
3227 USE front_mod
3228 USE int8_mod
3229C-----------------------------------------------
3230C I m p l i c i t T y p e s
3231C-----------------------------------------------
3232#include "implicit_f.inc"
3233C-----------------------------------------------
3234C C o m m o n B l o c k s
3235C-----------------------------------------------
3236#include "com01_c.inc"
3237C-----------------------------------------------
3238C D u m m y A r g u m e n t s
3239C-----------------------------------------------
3240 TYPE(intbuf_struct_) :: INTBUF_TAB
3241 TYPE(INTERSURFP) :: INTERCEP
3242 TYPE(INT8_STRUCT_) :: T8
3243 INTEGER NI,PROC,IPARI(*),
3244 . TAG_NODE_2RY(*),TAG_SEGM(*),TAG_NM(*),TAG_NODE_MSR(*),
3245 . TAG_NODE_MSR2(*),TAG_LMSR(*),TAG_LMSR2(*),
3246 . TAG_NSEG(*),TAG_NSEG2(*),
3247 . TAG_SEGM2(*),ITAB(*)
3248 INTEGER, INTENT(INOUT) :: NINDX_NM
3249 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_NM
3250C-----------------------------------------------
3251C F u n c t i o n
3252C-----------------------------------------------
3253 INTEGER NLOCAL
3254 EXTERNAL NLOCAL
3255C-----------------------------------------------
3256C L o c a l V a r i a b l e s
3257C-----------------------------------------------
3258 INTEGER
3259 . NSN,NRTM,NMN,NMN_L,
3260 . I,J,K,N,N1,N2,N3,N4,P2,
3261 . CNSN_L,CNRTM_L,CNMN_L,CLMSR_L,
3262 . IBEGIN,IEND
3263C ----------------------------------------
3264 NRTM = ipari(4)
3265 nsn = ipari(5)
3266 nmn = ipari(6)
3267
3268 cnsn_l = 0
3269 DO k=1, nsn
3270 n=intbuf_tab%ILOCS(k)
3271 n=intbuf_tab%MSR(n)
3272 IF(nlocal(n,proc+1)==1) THEN
3273 cnsn_l = cnsn_l+1
3274 tag_node_2ry(k) = 1
3275 ENDIF
3276 ENDDO
3277
3278! prepare SPLIT_NRTM_R
3279 cnrtm_l = 0
3280 cnmn_l = 0
3281! already done in split_interface
3282! TAG_NM(1:NUMNOD) = 0
3283 DO k=1,nrtm
3284 n1 = intbuf_tab%IRECTM(4*(k-1)+1)
3285 n2 = intbuf_tab%IRECTM(4*(k-1)+2)
3286 n3 = intbuf_tab%IRECTM(4*(k-1)+3)
3287 n4 = intbuf_tab%IRECTM(4*(k-1)+4)
3288
3289 n1 = intbuf_tab%MSR(n1)
3290 n2 = intbuf_tab%MSR(n2)
3291 n3 = intbuf_tab%MSR(n3)
3292 n4 = intbuf_tab%MSR(n4)
3293
3294 IF(intercep%P(k)==proc+1)THEN
3295 cnrtm_l = cnrtm_l + 1
3296 tag_segm(cnrtm_l) = k
3297 tag_segm2(k) = cnrtm_l
3298 IF(tag_nm(n1)==0)THEN
3299 tag_nm(n1)=1
3300 cnmn_l = cnmn_l +1
3301 nindx_nm = nindx_nm + 1
3302 indx_nm(nindx_nm) = n1
3303 ENDIF
3304 IF(tag_nm(n2)==0)THEN
3305 tag_nm(n2)=1
3306 cnmn_l = cnmn_l +1
3307 nindx_nm = nindx_nm + 1
3308 indx_nm(nindx_nm) = n2
3309 ENDIF
3310 IF(tag_nm(n3)==0)THEN
3311 tag_nm(n3)=1
3312 cnmn_l = cnmn_l +1
3313 nindx_nm = nindx_nm + 1
3314 indx_nm(nindx_nm) = n3
3315 ENDIF
3316 IF(tag_nm(n4)==0)THEN
3317 tag_nm(n4)=1
3318 cnmn_l = cnmn_l +1
3319 nindx_nm = nindx_nm + 1
3320 indx_nm(nindx_nm) = n4
3321 ENDIF
3322 ENDIF
3323 ENDDO
3324
3325C WRITE(6,*) __FILE__,__LINE__,CNMN_L,CNRTM_L,NRTM
3326c IF(NI == 1) THEN
3327c DO I=1,NMN
3328c N = INTBUF_TAB%MSR(I)
3329c !if the node is local
3330c IF(TAG_NM(N)==1)THEN
3331c WRITE(700+PROC,*) ITAB(N)
3332c ENDIF
3333c ENDDO
3334c DO N=1,NUMNOD
3335c !if the node is local
3336c IF(TAG_NM(N)==1)THEN
3337c WRITE(800+PROC,*) ITAB(N)
3338c ENDIF
3339c ENDDO
3340c ENDIF
3341
3342C Compute TAG_LMSR,TAG_LMSR2,TAG_NSEG
3343 nmn_l = cnmn_l
3344 IF(nmn_l > 0) tag_nseg(1) = 1
3345 cnmn_l = 0
3346 clmsr_l = 0
3347 DO i=1,nmn
3348 n = intbuf_tab%MSR(i)
3349 !if the node is local
3350 IF(tag_nm(n)==1)THEN
3351 cnmn_l = cnmn_l + 1
3352 tag_node_msr(cnmn_l) = i
3353 tag_node_msr2(i) = cnmn_l
3354 ibegin = intbuf_tab%NSEGM(i)
3355 iend = intbuf_tab%NSEGM(i+1)-1
3356 DO j=ibegin,iend
3357 k = intbuf_tab%LMSR(j)
3358 IF(intercep%P(k)==proc+1)THEN
3359 ! TAG filled with local number of seg
3360 tag_nseg(cnmn_l + 1) = tag_nseg(cnmn_l + 1) + 1
3361 clmsr_l = clmsr_l + 1
3362 tag_lmsr(clmsr_l) = j
3363 tag_lmsr2(j) = clmsr_l
3364 ENDIF
3365 ENDDO
3366 ENDIF
3367 ENDDO
3368
3369 !Cumulate sum of TAG_SEGM
3370 !It becomes the local version of NSEGM
3371 DO j=2,cnmn_l+1
3372 tag_nseg(j) = tag_nseg(j) + tag_nseg(j-1)
3373 ENDDO
3374
3375 IF(nspmd > 1) THEN
3376 ! renumber MAIN_ID locally
3377 DO p2=1,nspmd
3378 IF(p2/=proc + 1) THEN
3379 DO i = 1,t8%BUFFER(p2)%NBMAIN
3380 t8%BUFFER(p2)%MAIN_ID(i) =
3381 . tag_node_msr2(t8%BUFFER(p2)%MAIN_ID(i))
3382 ENDDO
3383 ENDIF
3384 ENDDO
3385
3386 DO i = 1,t8%S_COMM
3387 t8%SPMD_COMM_PATTERN(i)%UID = itab(
3388 . intbuf_tab%MSR(t8%SPMD_COMM_PATTERN(i)%NUMLOC))
3389 t8%SPMD_COMM_PATTERN(i)%NUMLOC =
3390 . tag_node_msr2(t8%SPMD_COMM_PATTERN(i)%NUMLOC)
3391 ENDDO
3392 ENDIF
3393
3394
3395
3396
3397 RETURN
3398 END SUBROUTINE prepare_split_i8
3399C=======================================================================
3400C END SPECIFIC ROUTINES INT8
3401C=======================================================================
3402
3403
3404C=======================================================================
3405C SPECIFIC ROUTINES INT 9
3406C=======================================================================
3407!||====================================================================
3408!|| prepare_split_i9 ../starter/source/restart/ddsplit/inter_tools.F
3409!||--- called by ------------------------------------------------------
3410!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
3411!||--- calls -----------------------------------------------------
3412!|| nlocal ../starter/source/spmd/node/ddtools.F
3413!||--- uses -----------------------------------------------------
3414!|| front_mod ../starter/share/modules1/front_mod.F
3415!||====================================================================
3416 SUBROUTINE prepare_split_i9(PROC , INTBUF_TAB , IPARI ,
3417 . TAG_NODE_2RY, TAG_NODE_MSR, TAG_SCRATCH ,
3418 . TAG_IELES , TAG_IELEM ,
3419 . CEP , CEL ,NINDX_SCRT,INDX_SCRT)
3420C-----------------------------------------------
3421C M o d u l e s
3422C-----------------------------------------------
3423 USE intbufdef_mod
3424 USE front_mod
3425C-----------------------------------------------
3426C I m p l i c i t T y p e s
3427C-----------------------------------------------
3428#include "implicit_f.inc"
3429C-----------------------------------------------
3430C D u m m y A r g u m e n t s
3431C-----------------------------------------------
3432 TYPE(intbuf_struct_) :: INTBUF_TAB
3433
3434 INTEGER PROC,IPARI(*),
3435 . tag_node_2ry(*),tag_node_msr(*),
3436 . tag_ieles(*) ,tag_ielem(*),
3437 . tag_scratch(*),cep(*),cel(*)
3438 INTEGER, INTENT(INOUT) :: NINDX_SCRT
3439 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_SCRT
3440C-----------------------------------------------
3441C F u n c t i o n
3442C-----------------------------------------------
3443 INTEGER NLOCAL
3444 EXTERNAL nlocal
3445C-----------------------------------------------
3446C L o c a l V a r i a b l e s
3447C-----------------------------------------------
3448 INTEGER
3449 . NSN,NRTM,NRTS,NMN,
3450 . I,J,K,N,IE,IE_LOC,PROC2,
3451 . CNSN_L,CNMN_L,CNRTS_L,CNRTM_L
3452C ----------------------------------------
3453 NRTS = ipari(3)
3454 nrtm = ipari(4)
3455 nsn = ipari(5)
3456 nmn = ipari(6)
3457
3458 cnsn_l = 0
3459 DO k=1, nsn
3460 n=intbuf_tab%NSV(k)
3461 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0) THEN
3462 cnsn_l = cnsn_l+1
3463 tag_node_2ry(cnsn_l) = k
3464 tag_scratch(n)=1
3465 nindx_scrt = nindx_scrt + 1
3466 indx_scrt(nindx_scrt) = n
3467 ENDIF
3468 ENDDO
3469
3470 !reflush to zero only part of TAG_SCRATCH that has been used
3471! DO K=1, NSN
3472! N=INTBUF_TAB%NSV(K)
3473! TAG_SCRATCH(N) = 0
3474! ENDDO
3475#include "vectorize.inc"
3476 DO k=1,nindx_scrt
3477 n = indx_scrt(k)
3478 tag_scratch(n) = 0
3479 ENDDO
3480 nindx_scrt = 0
3481
3482 cnmn_l = 0
3483 DO i=1,nmn
3484 n = intbuf_tab%MSR(i)
3485 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0)THEN
3486 cnmn_l = cnmn_l + 1
3487 tag_node_msr(cnmn_l) = i
3488 ENDIF
3489 ENDDO
3490
3491 !reflush to zero only part of TAG_SCRATCH that has been used
3492 DO k=1, nmn
3493 n=intbuf_tab%MSR(k)
3494 tag_scratch(n) = 0
3495 ENDDO
3496
3497 !IELES
3498 cnrts_l = 0
3499 DO k = 1, nrts
3500 ie = intbuf_tab%IELES(k)
3501 proc2 = cep(ie)
3502 IF(proc2==proc) THEN
3503 ie_loc = cel(ie)
3504 ELSE
3505 ie_loc = -ie
3506 ENDIF
3507 cnrts_l = cnrts_l + 1
3508 tag_ieles(cnrts_l) = ie_loc
3509 ENDDO
3510
3511 !IELEM
3512 cnrtm_l = 0
3513 DO k = 1, nrtm
3514 ie = intbuf_tab%IELEM(k)
3515 proc2 = cep(ie)
3516 IF(proc2==proc) THEN
3517 ie_loc = cel(ie)
3518 ELSE
3519 ie_loc = -ie
3520 ENDIF
3521 cnrtm_l = cnrtm_l + 1
3522 tag_ielem(cnrtm_l) = ie_loc
3523 ENDDO
3524
3525 RETURN
3526 END
3527C=======================================================================
3528C END SPECIFIC ROUTINES INT9
3529C=======================================================================
3530
3531C=======================================================================
3532C SPECIFIC ROUTINES INT 11
3533C=======================================================================
3534!||====================================================================
3535!|| prepare_split_i11 ../starter/source/restart/ddsplit/inter_tools.F
3536!||--- called by ------------------------------------------------------
3537!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
3538!||--- calls -----------------------------------------------------
3539!|| nlocal ../starter/source/spmd/node/ddtools.F
3540!||--- uses -----------------------------------------------------
3541!|| front_mod ../starter/share/modules1/front_mod.f
3542!||====================================================================
3543 SUBROUTINE prepare_split_i11(PROC , INTBUF_TAB, IPARI ,
3544 . TAG_NODE_2RY, TAG_SEGM , TAG_SEGM2 ,
3545 . TAG_NM , TAG_SEGS , TAG_NODE_MSR,
3546 . TAG_SCRATCH , INTERCEP , NI ,NINDX_NM,INDX_NM,
3547 . NINDX_SCRT , INDX_SCRT ,TAG_SEGS2)
3548C-----------------------------------------------
3549C M o d u l e s
3550C-----------------------------------------------
3551 USE intbufdef_mod
3552 USE front_mod
3553C-----------------------------------------------
3554C I m p l i c i t T y p e s
3555C-----------------------------------------------
3556#include "implicit_f.inc"
3557C-----------------------------------------------
3558C C o m m o n B l o c k s
3559C-----------------------------------------------
3560#include "com04_c.inc"
3561C-----------------------------------------------
3562C D u m m y A r g u m e n t s
3563C-----------------------------------------------
3564 INTEGER
3565 . ipari(*),ni
3566
3567 INTEGER PROC,TAG_NODE_2RY(*),TAG_SEGM(*),TAG_SEGM2(*),
3568 . tag_nm(*),tag_segs(*),tag_node_msr(*),tag_scratch(*),tag_segs2(*)
3569 INTEGER, INTENT(INOUT) :: NINDX_NM,NINDX_SCRT
3570 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_NM,INDX_SCRT
3571
3572 TYPE(intbuf_struct_) :: INTBUF_TAB
3573 TYPE(intersurfp) :: INTERCEP(3,NINTER)
3574C-----------------------------------------------
3575C F u n c t i o n
3576C-----------------------------------------------
3577 INTEGER NLOCAL
3578 EXTERNAL NLOCAL
3579C-----------------------------------------------
3580C L o c a l V a r i a b l e s
3581C-----------------------------------------------
3582 INTEGER
3583 . NSN,NRTM,NMN,NRTS
3584
3585 INTEGER
3586 . I,J,K,L,M,N,N1,N2,JJ,
3587 . CNRTM_L,CNRTS_L,CNSN_L,CNMN_L
3588C ----------------------------------------
3589 NRTS = ipari(3)
3590 nrtm = ipari(4)
3591 nsn = ipari(5)
3592 nmn = ipari(6)
3593
3594C IRECTS
3595 cnrts_l = 0
3596 DO k=1,nrts
3597 IF(intercep(2,ni)%P(k)==proc+1)THEN
3598 cnrts_l = cnrts_l + 1
3599 tag_segs(cnrts_l) = k
3600 tag_segs2(k) = cnrts_l
3601 ENDIF
3602 ENDDO
3603
3604 cnsn_l = 0
3605 DO k=1, nsn
3606 n=intbuf_tab%NSV(k)
3607 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0) THEN
3608 cnsn_l = cnsn_l+1
3609 tag_node_2ry(cnsn_l) = k
3610 tag_scratch(n)=1
3611 nindx_scrt = nindx_scrt + 1
3612 indx_scrt(nindx_scrt) = n
3613 ENDIF
3614 ENDDO
3615
3616 !reflush to zero only part of TAG_SCRATCH that has been used
3617#include "vectorize.inc"
3618 DO k=1, nindx_scrt
3619 n=indx_scrt(k)
3620 tag_scratch(n) = 0
3621 ENDDO
3622 nindx_scrt = 0
3623
3624 cnrtm_l = 0
3625 DO k=1,nrtm
3626 n1 = intbuf_tab%IRECTM(2*(k-1)+1)
3627 n2 = intbuf_tab%IRECTM(2*(k-1)+2)
3628 IF(intercep(1,ni)%P(k)==proc+1)THEN
3629 cnrtm_l = cnrtm_l + 1
3630 tag_segm(cnrtm_l) = k
3631 tag_segm2(k) = cnrtm_l
3632 IF(tag_nm(n1)==0)THEN
3633 tag_nm(n1)=1
3634 nindx_nm = nindx_nm + 1
3635 indx_nm(nindx_nm) = n1
3636 ENDIF
3637 IF(tag_nm(n2)==0)THEN
3638 tag_nm(n2)=1
3639 nindx_nm = nindx_nm + 1
3640 indx_nm(nindx_nm) = n2
3641 ENDIF
3642 ENDIF
3643 ENDDO
3644
3645 cnmn_l = 0
3646 DO i=1,nmn
3647 n = intbuf_tab%MSR(i)
3648 IF(tag_nm(n)==1)THEN
3649 cnmn_l = cnmn_l + 1
3650 tag_node_msr(cnmn_l) = i
3651 ENDIF
3652 ENDDO
3653
3654
3655 RETURN
3656 END
3657!||====================================================================
3658!|| split_cand_i11 ../starter/source/restart/ddsplit/inter_tools.F
3659!||--- called by ------------------------------------------------------
3660!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
3661!||--- calls -----------------------------------------------------
3662!|| nlocal ../starter/source/spmd/node/ddtools.F
3663!||--- uses -----------------------------------------------------
3664!|| front_mod ../starter/share/modules1/front_mod.F
3665!|| message_mod ../starter/share/message_module/message_mod.F
3666!||====================================================================
3667 SUBROUTINE split_cand_i11(PROC , INTBUF_TAB, NRTS , NRTS_L ,
3668 . TAG_SEGM2 , TAG_SEGS , II_STOK, MULTIMP,
3669 . NCONT , NOINT , INACTI ,
3670 . TAG_SCRATCH, INTERCEP , NI , IPARI_L,
3671 . II_STOK_L ,NINDX_SCRT ,INDX_SCRT)
3672C-----------------------------------------------
3673C M o d u l e s
3674C-----------------------------------------------
3675 USE message_mod
3676 USE front_mod
3677 USE intbufdef_mod
3678C-----------------------------------------------
3679C I m p l i c i t T y p e s
3680C-----------------------------------------------
3681#include "implicit_f.inc"
3682C-----------------------------------------------
3683C C o m m o n B l o c k s
3684C-----------------------------------------------
3685#include "com01_c.inc"
3686#include "com04_c.inc"
3687#include "param_c.inc"
3688C-----------------------------------------------
3689C D u m m y A r g u m e n t s
3690C-----------------------------------------------
3691 INTEGER PROC,NRTS,NRTS_L,II_STOK,MULTIMP,NCONT,
3692 . noint,inacti,ni,ipari_l(npari,ninter),
3693 . tag_segm2(*),tag_segs(*),tag_scratch(*),ii_stok_l
3694 INTEGER, INTENT(INOUT) :: NINDX_SCRT
3695 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_SCRT
3696
3697 TYPE(intbuf_struct_) :: INTBUF_TAB
3698 TYPE(INTERSURFP) :: INTERCEP(3,NINTER)
3699C-----------------------------------------------
3700C F u n c t i o n
3701C-----------------------------------------------
3702 INTEGER NLOCAL
3703 EXTERNAL nlocal
3704C-----------------------------------------------
3705C L o c a l V a r i a b l e s
3706C-----------------------------------------------
3707 INTEGER I,J,K,L,N,N1,N2,P,E,MULTOK,MSGID,
3708 . SPLIST,C_NRTSR
3709 INTEGER NUMP(NSPMD),WORK(70000)
3710
3711 INTEGER, DIMENSION(:),ALLOCATABLE ::
3712 . IBUF_E,IBUF_N,NRTSLOCAL,CPULOCAL,CANDR,PLIST,
3713 . INDEX,CANDS
3714
3715 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ITRI
3716
3717C ----------------------------------------
3718 ALLOCATE(IBUF_E(MULTIMP*NCONT),IBUF_N(MULTIMP*NCONT))
3719 IBUF_E(1:MULTIMP*NCONT) = 0
3720 ibuf_n(1:multimp*ncont) = 0
3721
3722 ii_stok_l = 0
3723
3724 IF(inacti==5.OR.inacti==6.OR.inacti==7) THEN
3725 IF(nrts>0) THEN
3726 ALLOCATE(nrtslocal(nrts))
3727 ALLOCATE(cpulocal(nrts))
3728 ALLOCATE(candr(nrts))
3729 END IF
3730
3731 nump(1:nspmd) = 0
3732
3733! optimize loop with PLIST tool
3734 ALLOCATE(plist(nspmd))
3735 plist(1:nspmd) = -1
3736
3737 DO k=1,nrts
3738 n1 = intbuf_tab%IRECTS(2*(k-1)+1)
3739 n2 = intbuf_tab%IRECTS(2*(k-1)+2)
3740 nrtslocal(k) = 0
3741 IF(intercep(2,ni)%P(k)==proc+1)THEN
3742 nump(proc+1) = nump(proc+1) + 1
3743 nrtslocal(k) = nump(proc+1)
3744 cpulocal(k) = proc+1
3745 ENDIF
3746 ENDDO
3747 DEALLOCATE(plist)
3748C
3749C Locating candidates on remote processors
3750C
3751 c_nrtsr = 0
3752 DO k = 1, ii_stok
3753 e = intbuf_tab%CAND_E(k)
3754 IF (tag_segm2(e)/=0) THEN
3755 n = intbuf_tab%CAND_N(k)
3756 IF(tag_scratch(n)==0) THEN
3757 tag_scratch(n) = 1
3758 nindx_scrt = nindx_scrt + 1
3759 indx_scrt(nindx_scrt) = n
3760 IF(nlocal(intbuf_tab%NSV(n),proc+1)/=1)THEN
3761 c_nrtsr = c_nrtsr + 1
3762 candr(c_nrtsr) = n
3763 END IF
3764 END IF
3765 ENDIF
3766 ENDDO
3767
3768 !reflush TAG_SCRATCH to zero only when value has changes
3769#include "vectorize.inc"
3770 DO k=1, nindx_scrt
3771! E = INTBUF_TAB%CAND_E(K)
3772! IF (TAG_SEGM2(E)/=0) THEN
3773 n = indx_scrt(k)
3774 tag_scratch(n) = 0
3775! ENDIF
3776 ENDDO
3777 nindx_scrt = 0
3778
3779C
3780C Sorting remote candidates by proc and by ascending local nsv
3781C
3782 IF(c_nrtsr>0) THEN
3783 ALLOCATE(index(2*c_nrtsr))
3784 ALLOCATE(itri(2,c_nrtsr))
3785 END IF
3786 DO i = 1, c_nrtsr
3787 n = candr(i)
3788 itri(1,i) = cpulocal(n)
3789 itri(2,i) = nrtslocal(n)
3790 ENDDO
3791 CALL my_orders(0,work,itri,index,c_nrtsr,2)
3792C
3793 DO i = 1, c_nrtsr
3794 index(c_nrtsr+index(i)) = i
3795 ENDDO
3796 DO i = 1, c_nrtsr
3797 index(i)=index(c_nrtsr+i)
3798 ENDDO
3799C
3800 ii_stok_l = 0
3801
3802 c_nrtsr = 0
3803 DO k = 1, ii_stok
3804 e = intbuf_tab%CAND_E(k)
3805 IF (tag_segm2(e)/=0) THEN
3806 ii_stok_l = ii_stok_l + 1
3807 ibuf_e(ii_stok_l)=tag_segm2(e)
3808 l = intbuf_tab%CAND_N(k)
3809 n1 = intbuf_tab%IRECTS(2*(l-1)+1)
3810 n2 = intbuf_tab%IRECTS(2*(l-1)+2)
3811 IF(cpulocal(l) == (proc+1))THEN
3812 ibuf_n(ii_stok_l) = nrtslocal(l)
3813 ELSE
3814C remote node : numbering pre-calculated above
3815 IF(tag_scratch(l)==0) THEN
3816 c_nrtsr =c_nrtsr + 1
3817 ibuf_n(ii_stok_l) = index(c_nrtsr)+nrts_l
3818 tag_scratch(l) = index(c_nrtsr)+nrts_l
3819 nindx_scrt = nindx_scrt + 1
3820 indx_scrt(nindx_scrt) = l
3821 ELSE
3822 ibuf_n(ii_stok_l) = tag_scratch(l)
3823 END IF
3824 END IF
3825 ENDIF
3826 ENDDO
3827
3828
3829 IF(nrts>0) DEALLOCATE(nrtslocal,cpulocal,candr)
3830 IF(c_nrtsr>0) DEALLOCATE(index,itri)
3831
3832 IF(inacti==5.OR.inacti==6.OR.inacti==7)ipari_l(24,ni)= c_nrtsr
3833
3834 ENDIF !END INACTI=5,6,7
3835
3836 CALL write_i_c(ibuf_e,multimp*ncont)
3837 CALL write_i_c(ibuf_n,multimp*ncont)
3838
3839 DEALLOCATE(ibuf_e,ibuf_n)
3840
3841 RETURN
3842 END
3843C=======================================================================
3844C END SPECIFIC ROUTINES INT11
3845C=======================================================================
3846
3847C=======================================================================
3848C SPECIFIC ROUTINES INT 17
3849C=======================================================================
3850!||====================================================================
3851!|| prepare_split_i17 ../starter/source/restart/ddsplit/inter_tools.F
3852!||--- called by ------------------------------------------------------
3853!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
3854!||--- calls -----------------------------------------------------
3855!|| nlocal ../starter/source/spmd/node/ddtools.F
3856!||--- uses -----------------------------------------------------
3857!|| front_mod ../starter/share/modules1/front_mod.F
3858!||====================================================================
3859 SUBROUTINE prepare_split_i17(PROC , INTBUF_TAB , IPARI ,
3860 . TAG_NODE_2RY , TAG_NODE_MSR ,
3861 . CEP , CEL , IGRBRIC ,
3862 . NSN_L , NME_L)
3863C-----------------------------------------------
3864C M o d u l e s
3865C-----------------------------------------------
3866 USE intbufdef_mod
3867 USE front_mod
3868 USE groupdef_mod
3869C-----------------------------------------------
3870C I m p l i c i t T y p e s
3871C-----------------------------------------------
3872#include "implicit_f.inc"
3873C-----------------------------------------------
3874C C o m m o n B l o c k s
3875C-----------------------------------------------
3876#include "com04_c.inc"
3877C-----------------------------------------------
3878C D u m m y A r g u m e n t s
3879C-----------------------------------------------
3880 TYPE(intbuf_struct_) :: INTBUF_TAB
3881
3882 INTEGER PROC,IPARI(*),
3883 . tag_node_2ry(*),tag_node_msr(*),
3884 . cep(*),cel(*),
3885 . nme_l,nsn_l
3886
3887C-----------------------------------------------
3888 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
3889C-----------------------------------------------
3890C F u n c t i o n
3891C-----------------------------------------------
3892 INTEGER NLOCAL
3893 EXTERNAL nlocal
3894C-----------------------------------------------
3895C L o c a l V a r i a b l e s
3896C-----------------------------------------------
3897 INTEGER
3898 . nsn,nrtm,nrts,nme,
3899 . j,k,ie,
3900 . ige,ign,nad,ead,nas,
3901 . cnme_l,cnsn_l
3902
3903C ----------------------------------------
3904 nrts = ipari(4)
3905 nme = ipari(4)
3906 nsn = ipari(5)
3907 ige = ipari(34)
3908 ign = ipari(36)
3909!
3910 cnsn_l = 0
3911 DO k=1, nsn
3912 ie = igrbric(ign)%ENTITY(k)
3913C IF(CEP(IE)==PROC) THEN
3914 cnsn_l = cnsn_l+1
3915 tag_node_2ry(cnsn_l) = k
3916C ENDIF
3917 ENDDO
3918 cnme_l = 0
3919 DO k=1,nme
3920 ie = igrbric(ige)%ENTITY(k)
3921C IF(CEP(IE)==PROC)THEN
3922 cnme_l = cnme_l + 1
3923 tag_node_msr(cnme_l) = k
3924C ENDIF
3925 ENDDO
3926
3927 RETURN
3928 END
3929C=======================================================================
3930C END SPECIFIC ROUTINES INT17
3931C=======================================================================
3932
3933C=======================================================================
3934C SPECIFIC ROUTINES INT20
3935C=======================================================================
3936!||====================================================================
3937!|| prepare_split_i20 ../starter/source/restart/ddsplit/inter_tools.F
3938!||--- called by ------------------------------------------------------
3939!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
3940!||--- calls -----------------------------------------------------
3941!|| nlocal ../starter/source/spmd/node/ddtools.F
3942!||--- uses -----------------------------------------------------
3943!|| front_mod ../starter/share/modules1/front_mod.F
3944!||====================================================================
3945 SUBROUTINE prepare_split_i20(
3946 . PROC , INTBUF_TAB, IPARI ,
3947 . TAG_NODE_2RY, TAG_SEGM , TAG_NODE_MSR,
3948 . TAG_SEGM2 , TAG_NM , TAG_NLINS,TAG_NLINM,
3949 . TAG_NLINS2 , TAG_NLINM2, TAG_NLG ,TAG_NLG2,
3950 . TAG_SCRATCH , INTERCEP , IPARI_L ,NI ,TAG_NSNE,
3951 . TAG_NMNE , TAG_NSVE , TAG_MSRE ,NINDX_NM,INDX_NM,
3952 . NINDX_SCRT , INDX_SCRT)
3953C-----------------------------------------------
3954C M o d u l e s
3955C-----------------------------------------------
3956 USE intbufdef_mod
3957 USE front_mod
3958C-----------------------------------------------
3959C I m p l i c i t T y p e s
3960C-----------------------------------------------
3961#include "implicit_f.inc"
3962C-----------------------------------------------
3963C C o m m o n B l o c k s
3964C-----------------------------------------------
3965#include "com04_c.inc"
3966#include "param_c.inc"
3967C-----------------------------------------------
3968C D u m m y A r g u m e n t s
3969C-----------------------------------------------
3970 TYPE(intbuf_struct_) :: INTBUF_TAB
3971 TYPE(intersurfp) :: INTERCEP(3,NINTER)
3972
3973 INTEGER PROC,IPARI(*),NI,
3974 . tag_node_2ry(*),tag_segm(*),tag_nm(*),tag_node_msr(*),
3975 . tag_segm2(*),tag_scratch(*),ipari_l(npari,ninter),
3976 . tag_nlins(*), tag_nlinm(*),tag_nlins2(*), tag_nlinm2(*),
3977 . tag_nlg(*),tag_nsne(*),tag_nmne(*),tag_nsve(*),tag_msre(*),
3978 . tag_nlg2(*)
3979 INTEGER, INTENT(INOUT) ::NINDX_NM,NINDX_SCRT
3980 INTEGER, DIMENSION(*), INTENT(INOUT) ::INDX_NM,INDX_SCRT
3981C-----------------------------------------------
3982C F u n c t i o n
3983C-----------------------------------------------
3984 INTEGER NLOCAL
3985 EXTERNAL NLOCAL
3986C-----------------------------------------------
3987C L o c a l V a r i a b l e s
3988C-----------------------------------------------
3989 INTEGER
3990 . NSN,NRTM,NMN,NLN,
3991 . nlins,nlinm,nlinsa,nlinma,nsne,nmne,
3992 . i,j,k,l,n,n1,n2,n3,n4,e,
3993 . nl,n1l,n2l,n3l,n4l,
3994 . ncont,ncont1,ncont2,
3995 . cnsn_l,cnrtm_l,cnmn_l,cnln_l,
3996 . cnlins_l,cnlinsa_l,cnlinm_l,
3997 . cnlinma_l,cnmne_l ,cnsne_l
3998 my_real
3999 . rcont
4000C ----------------------------------------
4001
4002 nrtm = ipari(4)
4003 nsn = ipari(5)
4004 nmn = ipari(6)
4005
4006 nln = ipari(35)
4007 nlins = ipari(51)
4008 nlinm = ipari(52)
4009 nlinsa = ipari(53)
4010 nlinma = ipari(54)
4011 nsne = ipari(55)
4012 nmne = ipari(56)
4013
4014 ! for type20, TAG_NM is used to tag main nodes, second nodes,
4015 ! second line, line main
4016
4017 ! prepare SPLIT_NRTM_R
4018 cnrtm_l = 0
4019 DO k=1,nrtm
4020 IF(intercep(1,ni)%P(k)==proc+1)THEN
4021 n1l = intbuf_tab%IRECTM(4*(k-1)+1)
4022 n2l = intbuf_tab%IRECTM(4*(k-1)+2)
4023 n3l = intbuf_tab%IRECTM(4*(k-1)+3)
4024 n4l = intbuf_tab%IRECTM(4*(k-1)+4)
4025 n1 = intbuf_tab%NLG(n1l)
4026 n2 = intbuf_tab%NLG(n2l)
4027 n3 = intbuf_tab%NLG(n3l)
4028 n4 = intbuf_tab%NLG(n4l)
4029 cnrtm_l = cnrtm_l + 1
4030 tag_segm(cnrtm_l) = k
4031 tag_segm2(k) = cnrtm_l
4032 IF(tag_nm(n1)==0)THEN
4033 tag_nm(n1)=1
4034 nindx_nm = nindx_nm + 1
4035 indx_nm(nindx_nm) = n1
4036 ENDIF
4037 IF(tag_nm(n2)==0)THEN
4038 tag_nm(n2)=1
4039 nindx_nm = nindx_nm + 1
4040 indx_nm(nindx_nm) = n2
4041 ENDIF
4042 IF(tag_nm(n3)==0)THEN
4043 tag_nm(n3)=1
4044 nindx_nm = nindx_nm + 1
4045 indx_nm(nindx_nm) = n3
4046 ENDIF
4047 IF(tag_nm(n4)==0)THEN
4048 tag_nm(n4)=1
4049 nindx_nm = nindx_nm + 1
4050 indx_nm(nindx_nm) = n4
4051 ENDIF
4052 ENDIF
4053 ENDDO
4054
4055 cnmn_l = 0
4056 DO i=1,nmn
4057 n = intbuf_tab%MSR(i)
4058 n1 = intbuf_tab%NLG(n)
4059 IF(tag_nm(n1)==1)THEN
4060 cnmn_l = cnmn_l + 1
4061 tag_node_msr(cnmn_l) = i
4062 ENDIF
4063 ENDDO
4064
4065 cnln_l = 0
4066 cnsn_l = 0
4067 DO k=1, nsn
4068 nl=intbuf_tab%NSV(k)
4069 n =intbuf_tab%NLG(nl)
4070 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0) THEN
4071 cnsn_l = cnsn_l+1
4072 tag_node_2ry(cnsn_l) = k
4073 tag_scratch(n)=1
4074 nindx_scrt = nindx_scrt + 1
4075 indx_scrt(nindx_scrt) = n
4076 IF(tag_nm(n)==0)THEN
4077 cnln_l = cnln_l + 1
4078 tag_nm(n)=1
4079 nindx_nm = nindx_nm + 1
4080 indx_nm(nindx_nm) = n
4081 ENDIF
4082 ENDIF
4083 ENDDO
4084
4085 !reflush to zero only part of TAG_SCRATCH that has been used
4086#include "vectorize.inc"
4087 DO k=1,nindx_scrt
4088 n = indx_scrt(k)
4089 tag_scratch(n) = 0
4090 ENDDO
4091 nindx_scrt = 0
4092C
4093C Line part
4094CTAG_SCRATCH(K)
4095 cnlins_l = 0
4096 cnlinsa_l= 0
4097 cnlinm_l = 0
4098 cnlinma_l= 0
4099 cnmne_l = 0
4100 cnsne_l = 0
4101
4102 DO k=1,nlins
4103 n1l = intbuf_tab%IXLINS(2*(k-1)+1)
4104 n2l = intbuf_tab%IXLINS(2*(k-1)+2)
4105 n1 = intbuf_tab%NLG(n1l)
4106 n2 = intbuf_tab%NLG(n2l)
4107 IF(intercep(3,ni)%P(k)==proc+1) THEN
4108 cnlins_l = cnlins_l + 1
4109 tag_nlins(cnlins_l) = k
4110 tag_nlins2(k) = cnlins_l
4111C Active line count
4112 IF(k<=nlinsa)cnlinsa_l = cnlinsa_l + 1
4113 IF (tag_scratch(n1)==0) THEN
4114 cnsne_l = cnsne_l + 1
4115 tag_nsne(cnsne_l) = n1
4116 tag_nsve(cnsne_l) = n1l
4117 tag_scratch(n1) = 1
4118 nindx_scrt = nindx_scrt + 1
4119 indx_scrt(nindx_scrt) = n1
4120 IF(tag_nm(n1)==0)THEN
4121 cnln_l = cnln_l + 1
4122 tag_nm(n1) = 1
4123 nindx_nm = nindx_nm + 1
4124 indx_nm(nindx_nm) = n1
4125 END IF
4126 ENDIF
4127 IF (tag_scratch(n2)==0) THEN
4128 cnsne_l = cnsne_l + 1
4129 tag_nsne(cnsne_l) = n2
4130 tag_nsve(cnsne_l) = n2l
4131 tag_scratch(n2) = 1
4132 nindx_scrt = nindx_scrt + 1
4133 indx_scrt(nindx_scrt) = n2
4134 IF(tag_nm(n2)==0)THEN
4135 cnln_l = cnln_l + 1
4136 tag_nm(n2) = 1
4137 nindx_nm = nindx_nm + 1
4138 indx_nm(nindx_nm) = n2
4139 END IF
4140 ENDIF
4141 ENDIF
4142 ENDDO
4143 !reflush to zero only part of TAG_SCRATCH that has been used
4144#include "vectorize.inc"
4145 DO k=1,nlins
4146 n1l = intbuf_tab%IXLINS(2*(k-1)+1)
4147 n2l = intbuf_tab%IXLINS(2*(k-1)+2)
4148 n1 = intbuf_tab%NLG(n1l)
4149 n2 = intbuf_tab%NLG(n2l)
4150 tag_scratch(n1) = 0
4151 tag_scratch(n2) = 0
4152 ENDDO
4153 nindx_scrt = 0
4154 DO k=1,nlinm
4155 n1l = intbuf_tab%IXLINM(2*(k-1)+1)
4156 n2l = intbuf_tab%IXLINM(2*(k-1)+2)
4157 n1 = intbuf_tab%NLG(n1l)
4158 n2 = intbuf_tab%NLG(n2l)
4159 IF(intercep(2,ni)%P(k)==proc+1) THEN
4160 cnlinm_l = cnlinm_l + 1
4161 tag_nlinm(cnlinm_l) = k
4162 tag_nlinm2(k) = cnlinm_l
4163C Active line count
4164 IF(k<=nlinma)cnlinma_l = cnlinma_l + 1
4165 IF (tag_scratch(n1)==0) THEN
4166 cnmne_l = cnmne_l + 1
4167 tag_nmne(cnmne_l) = n1
4168 tag_msre(cnmne_l) = n1l
4169 tag_scratch(n1) = 1
4170 nindx_scrt = nindx_scrt + 1
4171 indx_scrt(nindx_scrt) = n1
4172 IF(tag_nm(n1)==0)THEN
4173 cnmn_l = cnmn_l + 1
4174 tag_nm(n1) = 1
4175 nindx_nm = nindx_nm + 1
4176 indx_nm(nindx_nm) = n1
4177 END IF
4178 ENDIF
4179 IF (tag_scratch(n2)==0) THEN
4180 cnmne_l = cnmne_l + 1
4181 tag_nmne(cnmne_l) = n2
4182 tag_msre(cnmne_l) = n2l
4183 tag_scratch(n2) = 1
4184 nindx_scrt = nindx_scrt + 1
4185 indx_scrt(nindx_scrt) = n2
4186 IF(tag_nm(n2)==0)THEN
4187 cnmn_l = cnmn_l + 1
4188 tag_nm(n2) = 1
4189 nindx_nm = nindx_nm + 1
4190 indx_nm(nindx_nm) = n2
4191 END IF
4192 ENDIF
4193 ENDIF
4194 ENDDO
4195
4196 !reflush to zero only part of TAG_SCRATCH that has been used
4197#include "vectorize.inc"
4198 DO k=1,nlinm
4199 n1l = intbuf_tab%IXLINM(2*(k-1)+1)
4200 n2l = intbuf_tab%IXLINM(2*(k-1)+2)
4201 n1 = intbuf_tab%NLG(n1l)
4202 n2 = intbuf_tab%NLG(n2l)
4203 tag_scratch(n1) = 0
4204 tag_scratch(n2) = 0
4205 ENDDO
4206C
4207C Calculating NCONT taking the max of edge and non edge
4208C
4209 ncont1 = 0
4210 IF(nmn/=0) THEN
4211 rcont = cnmn_l
4212 rcont = rcont/nmn
4213 ncont = nint(nsn*rcont)
4214 IF(cnmn_l>0.AND.nsn>0) ncont1 = max(ncont,1)
4215 ENDIF
4216
4217 ncont2 = 0
4218 IF(nmne/=0) THEN
4219 rcont = cnmne_l
4220 rcont = rcont/nmne
4221 ncont = nint(nsne*rcont)
4222 IF(cnmne_l>0.AND.nsne>0) ncont2 = max(ncont,1)
4223 ENDIF
4224 ncont = max(ncont1,ncont2)
4225
4226C
4227C
4228c fill node global to local
4229 k = 0
4230 DO l = 1, nln
4231 i = intbuf_tab%NLG(l)
4232 IF(tag_nm(i) == 1) THEN
4233 k = k + 1
4234C TAGG(I) = K => node I to local interface node number on the proc
4235 tag_nlg(k) = l
4236 tag_nlg2(i) = k
4237 END IF
4238 END DO
4239
4240 ipari_l(35,ni) = cnln_l
4241 ipari_l(51,ni) = cnlins_l
4242 ipari_l(52,ni) = cnlinm_l
4243 ipari_l(53,ni) = cnlinsa_l
4244 ipari_l(54,ni) = cnlinma_l
4245 ipari_l(55,ni) = cnsne_l
4246 ipari_l(56,ni) = cnmne_l
4247
4248 RETURN
4249 END
4250!||====================================================================
4251!|| split_seg_rval_i20 ../starter/source/restart/ddsplit/inter_tools.F
4252!||--- calls -----------------------------------------------------
4253!||--- uses -----------------------------------------------------
4254!||====================================================================
4255 SUBROUTINE split_seg_rval_i20(TAB,DIM1,DIM2,TAG_SEG)
4256C-----------------------------------------------
4257C M o d u l e s
4258C-----------------------------------------------
4259 USE intbufdef_mod
4260C-----------------------------------------------
4261C I m p l i c i t T y p e s
4262C-----------------------------------------------
4263#include "implicit_f.inc"
4264C-----------------------------------------------
4265C D u m m y A r g u m e n t s
4266C-----------------------------------------------
4267 INTEGER TAG_SEG(*),DIM1,DIM2
4268
4269 my_real tab(*)
4270C-----------------------------------------------
4271C L o c a l V a r i a b l e s
4272C-----------------------------------------------
4273 INTEGER I,J,K
4274
4275 my_real, DIMENSION(:),ALLOCATABLE :: rbuf
4276C ----------------------------------------
4277 ALLOCATE(rbuf(dim1*dim2))
4278 DO i=1, dim1
4279 k=tag_seg(i)
4280 DO j=1,dim2
4281 rbuf(dim2*(i-1)+j) = tab(dim2*(k-1)+j)
4282 ENDDO
4283 ENDDO
4284
4285 CALL write_db(rbuf,dim1*dim2)
4286 DEALLOCATE(rbuf)
4287
4288 RETURN
4289 END
4290!||====================================================================
4291!|| split_seg_ival_i20 ../starter/source/restart/ddsplit/inter_tools.F
4292!||--- called by ------------------------------------------------------
4293!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
4294!||--- calls -----------------------------------------------------
4295!||--- uses -----------------------------------------------------
4296!||====================================================================
4297 SUBROUTINE split_seg_ival_i20(TAB,TAB_NLG,DIM1,DIM2,TAG,TAG_NLG)
4298C-----------------------------------------------
4299C M o d u l e s
4300C-----------------------------------------------
4301 USE intbufdef_mod
4302C-----------------------------------------------
4303C I m p l i c i t T y p e s
4304C-----------------------------------------------
4305#include "implicit_f.inc"
4306C-----------------------------------------------
4307C D u m m y A r g u m e n t s
4308C-----------------------------------------------
4309 INTEGER TAB(*),TAG(*),TAB_NLG(*),TAG_NLG(*),DIM1,DIM2
4310C-----------------------------------------------
4311C L o c a l V a r i a b l e s
4312C-----------------------------------------------
4313 INTEGER I,J,K,N
4314 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
4315C ----------------------------------------
4316 ALLOCATE(IBUF(DIM1*DIM2))
4317 DO I=1, dim1
4318 k=tag(i)
4319 DO j=1,dim2
4320 n = tab_nlg(tab(dim2*(k-1)+j))
4321 ibuf(dim2*(i-1)+j) = tag_nlg(n)
4322 ENDDO
4323 ENDDO
4324
4325 CALL write_i_c(ibuf,dim1*dim2)
4326 DEALLOCATE(ibuf)
4327
4328 RETURN
4329 END
4330!||====================================================================
4331!|| split_seg_ival_i20_2 ../starter/source/restart/ddsplit/inter_tools.F
4332!||--- called by ------------------------------------------------------
4333!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
4334!||--- calls -----------------------------------------------------
4335!||--- uses -----------------------------------------------------
4336!||====================================================================
4337 SUBROUTINE split_seg_ival_i20_2(TAG_SEG,DIM1,TAG_NLG)
4338c specific inter 20 + redirection local to global
4339C-----------------------------------------------
4340C M o d u l e s
4341C-----------------------------------------------
4342 USE intbufdef_mod
4343C-----------------------------------------------
4344C I m p l i c i t T y p e s
4345C-----------------------------------------------
4346#include "implicit_f.inc"
4347C-----------------------------------------------
4348C D u m m y A r g u m e n t s
4349C-----------------------------------------------
4350 INTEGER TAG_SEG(*),TAG_NLG(*),DIM1
4351C-----------------------------------------------
4352C L o c a l V a r i a b l e s
4353C-----------------------------------------------
4354 INTEGER I,J,K
4355 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
4356C ----------------------------------------
4357 ALLOCATE(IBUF(DIM1))
4358 DO I=1, dim1
4359 k=tag_seg(i)
4360 ibuf(i) = tag_nlg(k)
4361 ENDDO
4362
4363 CALL write_i_c(ibuf,dim1)
4364 DEALLOCATE(ibuf)
4365
4366 RETURN
4367 END
4368!||====================================================================
4369!|| prepare_split_cand_i20_edge ../starter/source/restart/ddsplit/inter_tools.F
4370!||--- called by ------------------------------------------------------
4371!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
4372!||--- uses -----------------------------------------------------
4373!||====================================================================
4374 SUBROUTINE prepare_split_cand_i20_edge(INTBUF_TAB, TAG_NLINS2, II_STOK, TAG_II)
4375C-----------------------------------------------
4376C M o d u l e s
4377C-----------------------------------------------
4378 USE intbufdef_mod
4379C-----------------------------------------------
4380C I m p l i c i t T y p e s
4381C-----------------------------------------------
4382#include "implicit_f.inc"
4383C-----------------------------------------------
4384C D u m m y A r g u m e n t s
4385C-----------------------------------------------
4386 INTEGER TAG_NLINS2(*),TAG_II(*),II_STOK
4387
4388 TYPE(intbuf_struct_) :: INTBUF_TAB
4389C-----------------------------------------------
4390C L o c a l V a r i a b l e s
4391C-----------------------------------------------
4392 INTEGER
4393 . k,e,c_ii
4394C ----------------------------------------
4395
4396! prepare split candidates
4397 c_ii = 0
4398 DO k = 1, ii_stok
4399 e = intbuf_tab%LCAND_N(k)
4400 IF (tag_nlins2(e)/=0) THEN
4401 c_ii = c_ii + 1
4402 tag_ii(c_ii) = k
4403 ENDIF
4404 ENDDO
4405
4406 RETURN
4407 END
4408!||====================================================================
4409!|| split_cand_i20 ../starter/source/restart/ddsplit/inter_tools.F
4410!||--- called by ------------------------------------------------------
4411!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
4412!||--- calls -----------------------------------------------------
4413!|| ancmsg ../starter/source/output/message/message.F
4414!|| nlocal ../starter/source/spmd/node/ddtools.F
4415!|| plist_ifront ../starter/source/spmd/node/ddtools.F
4416!||--- uses -----------------------------------------------------
4417!|| message_mod ../starter/share/message_module/message_mod.F
4418!||====================================================================
4419 SUBROUTINE split_cand_i20(PROC , INTBUF_TAB, NSN , NSN_L ,
4420 . TAG_SEGM2 , II_STOK , MULTIMP, NCONT ,
4421 . NOINT , INACTI , TAG_SCRATCH ,
4422 . II_STOK_L , IPARI_L,NI,NINDX_SCRT,INDX_SCRT)
4423C-----------------------------------------------
4424C M o d u l e s
4425C-----------------------------------------------
4426 USE message_mod
4427 USE intbufdef_mod
4428C-----------------------------------------------
4429C I m p l i c i t T y p e s
4430C-----------------------------------------------
4431#include "implicit_f.inc"
4432C-----------------------------------------------
4433C C o m m o n B l o c k s
4434C-----------------------------------------------
4435#include "com01_c.inc"
4436#include "com04_c.inc"
4437#include "param_c.inc"
4438C-----------------------------------------------
4439C D u m m y A r g u m e n t s
4440C-----------------------------------------------
4441 INTEGER PROC,NSN,NSN_L,II_STOK,MULTIMP,NCONT,
4442 . TAG_SEGM2(*),NOINT,INACTI,NI,
4443 . TAG_SCRATCH(*) , II_STOK_L, IPARI_L(NPARI,NINTER)
4444 INTEGER, INTENT(INOUT) ::NINDX_SCRT
4445 INTEGER, DIMENSION(*), INTENT(INOUT) ::INDX_SCRT
4446
4447 TYPE(INTBUF_STRUCT_) :: INTBUF_TAB
4448C-----------------------------------------------
4449C F u n c t i o n
4450C-----------------------------------------------
4451 INTEGER NLOCAL
4452 EXTERNAL NLOCAL
4453C-----------------------------------------------
4454C L o c a l V a r i a b l e s
4455C-----------------------------------------------
4456 INTEGER I,J,K,N,P,E,MULTOK,MSGID,
4457 . SPLIST,C_NSNR
4458 INTEGER NUMP(NSPMD),WORK(70000)
4459
4460 INTEGER, DIMENSION(:),ALLOCATABLE ::
4461 . IBUF_E,IBUF_N,NSNLOCAL,CPULOCAL,CANDR,PLIST,
4462 . INDEX
4463
4464 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ITRI
4465C ----------------------------------------
4466 ALLOCATE(ibuf_e(multimp*ncont),ibuf_n(multimp*ncont))
4467
4468 ibuf_e(1:multimp*ncont) = 0
4469 ibuf_n(1:multimp*ncont) = 0
4470 ii_stok_l = 0 !mandatory in case of inacti ne 5,6,7
4471
4472 IF(inacti==5.OR.inacti==6.OR.inacti==7) THEN
4473 IF(nsn>0) THEN
4474 ALLOCATE(nsnlocal(nsn))
4475 ALLOCATE(cpulocal(nsn))
4476 ALLOCATE(candr(nsn))
4477 END IF
4478
4479 nump(1:nspmd) = 0
4480
4481 ALLOCATE(plist(nspmd))
4482 plist(1:nspmd) = -1
4483 nindx_scrt=0
4484 DO k=1,nsn
4485 n = intbuf_tab%NSV(k)
4486 nsnlocal(k) = 0
4487 IF(tag_scratch(n)==0) THEN
4488 splist=0
4489 CALL plist_ifront(plist,n,splist)
4490 DO i=1,splist
4491 p=plist(i)
4492 nump(p) = nump(p)+1
4493 ENDDO
4494 IF(nlocal(n,proc+1)==1) THEN
4495 nsnlocal(k) = nump(proc+1)
4496 cpulocal(k) = proc+1
4497 ELSE
4498 p = plist(1)
4499 nsnlocal(k) = nump(p)
4500 cpulocal(k) = p
4501 ENDIF
4502 tag_scratch(n) = 1
4503 nindx_scrt = nindx_scrt + 1
4504 indx_scrt(nindx_scrt) = n
4505 ENDIF
4506 ENDDO
4507 DEALLOCATE(plist)
4508
4509 !reflush TAG_SCRATCH to zero only when value has changes
4510#include "vectorize.inc"
4511 DO k=1,nindx_scrt
4512 n = indx_scrt(k)
4513 tag_scratch(n) = 0
4514 ENDDO
4515 nindx_scrt = 0
4516C
4517C Locating candidates on remote processors
4518C
4519 c_nsnr = 0
4520
4521 DO k = 1, ii_stok
4522 e = intbuf_tab%CAND_E(k)
4523 IF (tag_segm2(e)/=0) THEN
4524 n = intbuf_tab%CAND_N(k)
4525 IF(tag_scratch(n)==0) THEN
4526 tag_scratch(n) = 1
4527 nindx_scrt = nindx_scrt + 1
4528 indx_scrt(nindx_scrt) = n
4529 IF(nlocal(intbuf_tab%NSV(n),proc+1)/=1)THEN
4530 c_nsnr = c_nsnr + 1
4531 candr(c_nsnr) = n
4532 END IF
4533 END IF
4534 ENDIF
4535 ENDDO
4536
4537 !reflush TAG_SCRATCH to zero only when value has changes
4538#include "vectorize.inc"
4539 DO k=1,nindx_scrt
4540 n = indx_scrt(k)
4541 tag_scratch(n) = 0
4542 ENDDO
4543 nindx_scrt = 0
4544C
4545C Sorting remote candidates by proc and by ascending local nsv
4546C
4547 IF(c_nsnr>0) THEN
4548 ALLOCATE(index(2*c_nsnr))
4549 ALLOCATE(itri(2,c_nsnr))
4550 END IF
4551 DO i = 1, c_nsnr
4552 n = candr(i)
4553 itri(1,i) = cpulocal(n)
4554 itri(2,i) = nsnlocal(n)
4555 ENDDO
4556 CALL my_orders(0,work,itri,index,c_nsnr,2)
4557C
4558 DO i = 1, c_nsnr
4559 index(c_nsnr+index(i)) = i
4560 ENDDO
4561 DO i = 1, c_nsnr
4562 index(i)=index(c_nsnr+i)
4563 ENDDO
4564C
4565 ii_stok_l = 0
4566
4567 c_nsnr = 0
4568 DO k = 1, ii_stok
4569 e = intbuf_tab%CAND_E(k)
4570 IF (tag_segm2(e)/=0) THEN
4571 ii_stok_l = ii_stok_l + 1
4572 END IF
4573 END DO
4574
4575 IF(ii_stok_l>multimp*ncont)THEN
4576 multok= ii_stok_l/ncont
4577 CALL ancmsg(msgid=626,
4578 . msgtype=msgerror,
4579 . anmode=aninfo,
4580 . i1=multok,
4581 . i2=noint)
4582 ELSE
4583 ii_stok_l = 0
4584C
4585 DO k = 1, ii_stok
4586 e = intbuf_tab%CAND_E(k)
4587 IF (tag_segm2(e)/=0) THEN
4588 n = intbuf_tab%CAND_N(k)
4589 ii_stok_l = ii_stok_l + 1
4590 ibuf_e(ii_stok_l)=tag_segm2(e)
4591
4592 IF(nlocal(intbuf_tab%NSV(n),proc+1)==1) THEN
4593 ibuf_n(ii_stok_l)=nsnlocal(n)
4594 ELSE
4595C remote node : numbering pre-calculated above
4596c IF(TAG(N)==0) THEN
4597 IF(tag_scratch(n)==0) THEN
4598 c_nsnr = c_nsnr + 1
4599 ibuf_n(ii_stok_l)=index(c_nsnr)+nsn_l
4600 tag_scratch(n) = index(c_nsnr)+nsn_l
4601 nindx_scrt = nindx_scrt + 1
4602 indx_scrt(nindx_scrt) = n
4603 ELSE
4604 ibuf_n(ii_stok_l) = tag_scratch(n)
4605 END IF ! TAG(N)==0
4606 END IF ! NLOCAL(INTBUF_TAB%NSV(N),PROC+1)==1
4607 ENDIF !TAG_SEGM_2(E)/=0
4608 ENDDO !K = 1, II_STOK
4609 END IF !II_STOK_L>MULTIMP*NCONT
4610
4611 !reflush TAG_SCRATCH to zero only when value has changes
4612#include "vectorize.inc"
4613 DO k=1,nindx_scrt
4614 n = indx_scrt(k)
4615 tag_scratch(n) = 0
4616 ENDDO
4617 nindx_scrt = 0
4618
4619 IF(nsn>0) DEALLOCATE(nsnlocal,cpulocal,candr)
4620 IF(c_nsnr>0) DEALLOCATE(index,itri)
4621
4622 IF(inacti==5.OR.inacti==6.OR.inacti==7)ipari_l(24,ni)= c_nsnr
4623
4624 ENDIF !END INACTI=5,6,7
4625
4626 CALL write_i_c(ibuf_e,multimp*ncont)
4627 CALL write_i_c(ibuf_n,multimp*ncont)
4628
4629 DEALLOCATE(ibuf_e,ibuf_n)
4630
4631 RETURN
4632 END
4633!||====================================================================
4634!|| split_cand_i20_edge ../starter/source/restart/ddsplit/inter_tools.f
4635!||--- called by ------------------------------------------------------
4636!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
4637!||--- calls -----------------------------------------------------
4638!|| nlocal ../starter/source/spmd/node/ddtools.F
4639!||--- uses -----------------------------------------------------
4640!|| message_mod ../starter/share/message_module/message_mod.F
4641!||====================================================================
4642 SUBROUTINE split_cand_i20_edge(PROC , INTBUF_TAB, NLINS , NLINS_L ,
4643 . TAG_NLINS2, II_STOKE , MULTIMP, NCONTE ,
4644 . NOINT , INACTI , TAG_SCRATCH ,
4645 . II_STOKE_L, IPARI_L , NI ,NINDX_SCRT ,
4646 . INDX_SCRT)
4647C-----------------------------------------------
4648C M o d u l e s
4649C-----------------------------------------------
4650 USE message_mod
4651 USE intbufdef_mod
4652C-----------------------------------------------
4653C I m p l i c i t T y p e s
4654C-----------------------------------------------
4655#include "implicit_f.inc"
4656C-----------------------------------------------
4657C C o m m o n B l o c k s
4658C-----------------------------------------------
4659#include "com01_c.inc"
4660#include "com04_c.inc"
4661#include "param_c.inc"
4662C-----------------------------------------------
4663C D u m m y A r g u m e n t s
4664C-----------------------------------------------
4665 INTEGER PROC,NLINS,NLINS_L,II_STOKE,MULTIMP,NCONTE,
4666 . TAG_NLINS2(*),NOINT,INACTI,NI,
4667 . TAG_SCRATCH(*) , II_STOKE_L , IPARI_L(NPARI,NINTER)
4668 INTEGER, INTENT(INOUT) :: NINDX_SCRT
4669 INTEGER, DIMENSION(*), INTENT(INOUT) ::INDX_SCRT
4670
4671 TYPE(intbuf_struct_) :: INTBUF_TAB
4672C-----------------------------------------------
4673C F u n c t i o n
4674C-----------------------------------------------
4675 INTEGER NLOCAL
4676 EXTERNAL nlocal
4677C-----------------------------------------------
4678C L o c a l V a r i a b l e s
4679C-----------------------------------------------
4680 INTEGER I,J,K,L,N,P,N1L,N2L,N1,N2,E,MULTOK,MSGID,
4681 . SPLIST,C_NLINSR
4682 INTEGER NUMP(NSPMD),WORK(70000)
4683
4684 INTEGER, DIMENSION(:),ALLOCATABLE ::
4685 . ibuf_e,ibuf_n,nrtslocal,cpulocal,candr,plist,
4686 . index
4687
4688 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ITRI
4689C ----------------------------------------
4690 ALLOCATE(ibuf_e(multimp*nconte),ibuf_n(multimp*nconte))
4691 ibuf_e(1:multimp*nconte) = 0
4692 ibuf_n(1:multimp*nconte) = 0
4693 ii_stoke_l = 0 !mandatory in case of inacti ne 5,6,7
4694
4695 IF(inacti==5.OR.inacti==6.OR.inacti==7) THEN
4696 IF(nlins>0) THEN
4697 ALLOCATE(nrtslocal(nlins))
4698 ALLOCATE(cpulocal(nlins))
4699 ALLOCATE(candr(nlins))
4700 END IF
4701
4702 nump(1:nspmd) = 0
4703
4704 DO k=1,nlins
4705 n1l = intbuf_tab%IXLINS(2*(k-1)+1)
4706 n2l = intbuf_tab%IXLINS(2*(k-1)+2)
4707 n1 = intbuf_tab%NLG(n1l)
4708 n2 = intbuf_tab%NLG(n2l)
4709 nrtslocal(k) = 0
4710 IF(nlocal(n1,proc+1)==1.AND.
4711 . nlocal(n2,proc+1)==1) THEN
4712 nump(proc+1) = nump(proc+1) + 1
4713 nrtslocal(k) = nump(proc+1)
4714 cpulocal(k) = proc+1
4715 END IF
4716 DO p = 1, nspmd
4717 IF(p/=proc+1.AND.nlocal(n1,p)==1.AND.
4718 . nlocal(n2,p)==1) THEN
4719 IF(nrtslocal(k)==0) THEN
4720 nump(p) = nump(p) + 1
4721 nrtslocal(k) = nump(p)
4722 cpulocal(k) = p
4723 END IF
4724 END IF
4725 END DO
4726 ENDDO
4727C
4728C Locating candidates on remote processors
4729C
4730 !TAG_SCRATCH must have been reflush correctly to 0
4731 c_nlinsr = 0
4732 DO k = 1, ii_stoke
4733 e = intbuf_tab%LCAND_N(k)
4734 IF (tag_nlins2(e)/=0) THEN
4735 n = intbuf_tab%LCAND_S(k)
4736 IF(tag_scratch(n)==0) THEN
4737 tag_scratch(n) = 1
4738 nindx_scrt = nindx_scrt + 1
4739 indx_scrt(nindx_scrt) = n
4740 n1l = intbuf_tab%IXLINS(2*(n-1)+1)
4741 n2l = intbuf_tab%IXLINS(2*(n-1)+2)
4742 n1 = intbuf_tab%NLG(n1l)
4743 n2 = intbuf_tab%NLG(n2l)
4744 IF(cpulocal(n)/=proc+1)THEN
4745 c_nlinsr = c_nlinsr + 1
4746 candr(c_nlinsr) = n
4747 END IF
4748 END IF
4749 ENDIF
4750 ENDDO
4751
4752 !reflush TAG_SCRATCH to zero only when value has changes
4753#include "vectorize.inc"
4754 DO k=1,nindx_scrt
4755 n = indx_scrt(k)
4756 tag_scratch(n) = 0
4757 ENDDO
4758 nindx_scrt = 0
4759C
4760C Sorting remote candidates by proc and by ascending local nsv
4761C
4762 IF(c_nlinsr>0) THEN
4763 ALLOCATE(index(2*c_nlinsr))
4764 ALLOCATE(itri(2,c_nlinsr))
4765 END IF
4766 DO i = 1, c_nlinsr
4767 n = candr(i)
4768 itri(1,i) = cpulocal(n)
4769 itri(2,i) = nrtslocal(n)
4770 ENDDO
4771 CALL my_orders(0,work,itri,index,c_nlinsr,2)
4772C
4773 DO i = 1, c_nlinsr
4774 index(c_nlinsr+index(i)) = i
4775 ENDDO
4776 DO i = 1, c_nlinsr
4777 index(i)=index(c_nlinsr+i)
4778 ENDDO
4779C
4780 ii_stoke_l = 0
4781 ii_stoke_l = 0
4782 c_nlinsr = 0
4783C
4784 DO k = 1, ii_stoke
4785 e = intbuf_tab%LCAND_N(k)
4786 IF (tag_nlins2(e)/=0) THEN
4787 ii_stoke_l = ii_stoke_l + 1
4788 ibuf_e(ii_stoke_l)=tag_nlins2(e)
4789 l = intbuf_tab%LCAND_N(k)
4790 n1l = intbuf_tab%IXLINS(2*(l-1)+1)
4791 n2l = intbuf_tab%IXLINS(2*(l-1)+2)
4792 n1 = intbuf_tab%IXLINS(n1l)
4793 n2 = intbuf_tab%IXLINS(n2l)
4794 IF(cpulocal(l) == proc+1)THEN
4795 ibuf_n(ii_stoke_l)=nrtslocal(l)
4796 ELSE
4797C remote node : numbering pre-calculated above
4798 IF(tag_scratch(l)==0) THEN
4799 c_nlinsr = c_nlinsr + 1
4800 ibuf_n(ii_stoke_l) = index(c_nlinsr)+nlins_l
4801 tag_scratch(l) = index(c_nlinsr)+nlins_l
4802 nindx_scrt = nindx_scrt + 1
4803 indx_scrt(nindx_scrt) = l
4804 ELSE
4805 ibuf_n(ii_stoke_l) = tag_scratch(l)
4806 END IF
4807 END IF
4808 ENDIF !TAG_NLINS2(E)/=0
4809 ENDDO !K = 1, II_STOKE
4810
4811 !reflush TAG_SCRATCH to zero only when value has changes
4812#include "vectorize.inc"
4813 DO k=1,nindx_scrt
4814 n = indx_scrt(k)
4815 tag_scratch(n) = 0
4816 ENDDO
4817 nindx_scrt = 0
4818
4819 IF(nlins>0) DEALLOCATE(nrtslocal,cpulocal,candr)
4820 IF(c_nlinsr>0) DEALLOCATE(index,itri)
4821
4822 IF(inacti==5.OR.inacti==6.OR.inacti==7) ipari_l(57,ni)= c_nlinsr
4823
4824 ENDIF !END INACTI=5,6,7
4825
4826 CALL write_i_c(ibuf_e,multimp*nconte)
4827 CALL write_i_c(ibuf_n,multimp*nconte)
4828
4829 DEALLOCATE(ibuf_e,ibuf_n)
4830
4831 RETURN
4832 END
4833C=======================================================================
4834C END SPECIFIC ROUTINES INT20
4835C=======================================================================
4836
4837C=======================================================================
4838C SPECIFIC ROUTINES INT 21
4839C=======================================================================
4840!||====================================================================
4841!|| prepare_split_i21 ../starter/source/restart/ddsplit/inter_tools.F
4842!||--- called by ------------------------------------------------------
4843!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
4844!||--- calls -----------------------------------------------------
4845!|| nlocal ../starter/source/spmd/node/ddtools.F
4846!|| plist_ifront ../starter/source/spmd/node/ddtools.F
4847!||--- uses -----------------------------------------------------
4848!|| front_mod ../starter/share/modules1/front_mod.F
4849!||====================================================================
4850 SUBROUTINE prepare_split_i21(PROC , INTBUF_TAB , IPARI ,
4851 . TAG_NODE_2RY, TAG_SEGM , TAG_NODE_2RY2,
4852 . TAG_SEGS , TAG_NODE_MSR,
4853 . TAG_SCRATCH , INTERCEP , NI, INTTH ,
4854 . NODLOCAL ,MSR_L_I21 ,MNDD_I21 ,
4855 . NINDX_SCRT ,INDX_SCRT)
4856C-----------------------------------------------
4857C M o d u l e s
4858C-----------------------------------------------
4859 USE intbufdef_mod
4860 USE front_mod
4861C-----------------------------------------------
4862C I m p l i c i t T y p e s
4863C-----------------------------------------------
4864#include "implicit_f.inc"
4865C-----------------------------------------------
4866C C o m m o n B l o c k s
4867C-----------------------------------------------
4868#include "com01_c.inc"
4869#include "com04_c.inc"
4870C-----------------------------------------------
4871C D u m m y A r g u m e n t s
4872C-----------------------------------------------
4873 INTEGER
4874 . ipari(*),ni
4875
4876 INTEGER PROC,TAG_NODE_2RY(*),TAG_SEGM(*),TAG_NODE_2RY2(*),
4877 . tag_segs(*),tag_node_msr(*),tag_scratch(*), nodlocal(*),
4878 . msr_l_i21(*),mndd_i21(*)
4879 INTEGER, INTENT(INOUT) :: NINDX_SCRT
4880 INTEGER, DIMENSION(*), INTENT(INOUT) ::INDX_SCRT
4881
4882 TYPE(intbuf_struct_) :: INTBUF_TAB
4883 TYPE(intersurfp) :: INTERCEP(3,NINTER)
4884C-----------------------------------------------
4885C F u n c t i o n
4886C-----------------------------------------------
4887 INTEGER NLOCAL
4888 EXTERNAL NLOCAL
4889C-----------------------------------------------
4890C L o c a l V a r i a b l e s
4891C-----------------------------------------------
4892
4893 INTEGER, DIMENSION(:),ALLOCATABLE :: PLIST
4894 INTEGER
4895 . nsn,nrtm,nmn,nrts,intth, nmng,flagloadp
4896
4897 INTEGER
4898 . i,j,k,l,m,n,n1,n2,n3,n4,jj,splist,
4899 . cnrtm_l,cnrts_l,cnsn_l,cnmn_l
4900C ----------------------------------------
4901 nrts = ipari(3)
4902 nrtm = ipari(4)
4903 nsn = ipari(5)
4904 nmn = ipari(6)
4905 nmng = ipari(8)
4906 flagloadp = ipari(95)
4907
4908 cnrts_l = 0
4909 DO k=1,nrts
4910 IF(intercep(1,ni)%P(k)==proc+1)THEN
4911 cnrts_l = cnrts_l + 1
4912 tag_segs(cnrts_l) = k
4913 ENDIF
4914 ENDDO
4915
4916 cnsn_l = 0
4917 DO k=1, nsn
4918 n=intbuf_tab%NSV(k)
4919 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0) THEN
4920 cnsn_l = cnsn_l+1
4921 tag_node_2ry(cnsn_l) = k
4922 tag_node_2ry2(k) = cnsn_l
4923 tag_scratch(n)=1
4924 nindx_scrt = nindx_scrt + 1
4925 indx_scrt(nindx_scrt) = n
4926 ENDIF
4927 ENDDO
4928
4929 !reflush to zero only part of TAG_SCRATCH that has been used
4930#include "vectorize.inc"
4931 DO k=1,nindx_scrt
4932 n = indx_scrt(k)
4933 tag_scratch(n) = 0
4934 ENDDO
4935 nindx_scrt = 0
4936
4937 cnrtm_l = 0
4938 DO k=1,nrtm
4939 cnrtm_l = cnrtm_l + 1
4940 tag_segm(cnrtm_l) = k
4941 ENDDO
4942
4943 cnmn_l = 0
4944 DO i=1,nmn
4945 n = intbuf_tab%MSR(i)
4946 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0) THEN
4947 cnmn_l = cnmn_l + 1
4948 tag_node_msr(cnmn_l) = i
4949 tag_scratch(n)=1
4950 nindx_scrt = nindx_scrt + 1
4951 indx_scrt(nindx_scrt) = n
4952 ENDIF
4953 ENDDO
4954
4955 !reflush to zero only part of TAG_SCRATCH that has been used
4956#include "vectorize.inc"
4957 DO k=1,nindx_scrt
4958 n = indx_scrt(k)
4959 tag_scratch(n) = 0
4960 ENDDO
4961 nindx_scrt = 0
4962
4963 !PREPARE MNDD TAB FOR main TEMPERATURE COMMUNICATION
4964 ALLOCATE(plist(nspmd))
4965 plist(1:nspmd) = -1
4966 IF (intth == 2.OR.flagloadp > 0) THEN
4967 DO k=1,nmng
4968 n = intbuf_tab%MSR(k)
4969 IF(nlocal(n,proc+1)==1) THEN
4970 ! node on domain
4971 mndd_i21(k) = 0
4972 ELSE
4973 ! node is not on domain, set value to first domain of node
4974 CALL plist_ifront(plist,n,splist)
4975 mndd_i21(k) = plist(1)
4976 ENDIF
4977 END DO
4978 ENDIF
4979 DEALLOCATE(plist)
4980 ! PREPARE MSRL TAB FOR LOCAL NODES NUMBERING==> main TEMPERATURE COMMUNICATION
4981 IF (intth == 2.OR.flagloadp > 0) THEN
4982 msr_l_i21(1:nmng)=0
4983 DO i=1,nmng
4984 n = intbuf_tab%MSR(i)
4985 IF(nlocal(n,proc+1)==1) THEN
4986 msr_l_i21(i) = nodlocal(n)
4987 ENDIF
4988 END DO
4989 ENDIF
4990
4991 RETURN
4992 END
4993!||====================================================================
4994!|| split_cand_ival_i21 ../starter/source/restart/ddsplit/inter_tools.F
4995!||--- called by ------------------------------------------------------
4996!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
4997!||--- calls -----------------------------------------------------
4998!||--- uses -----------------------------------------------------
4999!||====================================================================
5000 SUBROUTINE split_cand_ival_i21(TAB , II_STOK_L, TAG_II,
5001 . DIM1, DIM2 )
5002C introduce a second dimension
5003C-----------------------------------------------
5004C M o d u l e s
5005C-----------------------------------------------
5006 USE intbufdef_mod
5007C-----------------------------------------------
5008C I m p l i c i t T y p e s
5009C-----------------------------------------------
5010#include "implicit_f.inc"
5011C-----------------------------------------------
5012C D u m m y A r g u m e n t s
5013C-----------------------------------------------
5014 INTEGER TAB(*),TAG_II(*),II_STOK_L,MULTIMP,NCONT,
5015 . dim1,dim2
5016C-----------------------------------------------
5017C L o c a l V a r i a b l e s
5018C-----------------------------------------------
5019 INTEGER I,J,K
5020 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
5021C ----------------------------------------
5022 ALLOCATE(ibuf(dim1*dim2))
5023 ibuf(1:dim1*dim2) = 0
5024
5025 DO i=1,ii_stok_l
5026 k=tag_ii(i)
5027 DO j=1,dim2
5028 ibuf(dim2*(i-1)+j) = tab(dim2*(k-1)+j)
5029 ENDDO
5030 ENDDO
5031
5032 CALL write_i_c(ibuf,dim1*dim2)
5033 DEALLOCATE(ibuf)
5034
5035 RETURN
5036 END
5037!||====================================================================
5038!|| split_2ry_cand_ival_i21 ../starter/source/restart/ddsplit/inter_tools.F
5039!||--- called by ------------------------------------------------------
5040!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5041!||--- calls -----------------------------------------------------
5042!||--- uses -----------------------------------------------------
5043!||====================================================================
5044 SUBROUTINE split_2ry_cand_ival_i21(TAB , II_STOK_L, TAG_II,TAG_NODE_2RY2,
5045 . DIM1 )
5046C introduce a second dimension
5047C-----------------------------------------------
5048C M o d u l e s
5049C-----------------------------------------------
5050 USE intbufdef_mod
5051C-----------------------------------------------
5052C I m p l i c i t T y p e s
5053C-----------------------------------------------
5054#include "implicit_f.inc"
5055C-----------------------------------------------
5056C D u m m y A r g u m e n t s
5057C-----------------------------------------------
5058 INTEGER TAB(*),TAG_II(*),II_STOK_L,
5059 . dim1,tag_node_2ry2(*)
5060C-----------------------------------------------
5061C L o c a l V a r i a b l e s
5062C-----------------------------------------------
5063 INTEGER I,J,K,N
5064 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
5065C ----------------------------------------
5066 ALLOCATE(ibuf(dim1))
5067 ibuf(1:dim1) = 0
5068
5069 DO i=1,ii_stok_l
5070 k=tag_ii(i)
5071 n = tab(k)
5072 ibuf(i) = tag_node_2ry2(n)
5073 ENDDO
5074
5075 CALL write_i_c(ibuf,dim1)
5076 DEALLOCATE(ibuf)
5077
5078 RETURN
5079 END
5080!||====================================================================
5081!|| prepare_split_cand_i21 ../starter/source/restart/ddsplit/inter_tools.F
5082!||--- called by ------------------------------------------------------
5083!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5084!||--- calls -----------------------------------------------------
5085!|| nlocal ../starter/source/spmd/node/ddtools.f
5086!||--- uses -----------------------------------------------------
5087!||====================================================================
5088 SUBROUTINE prepare_split_cand_i21(INTBUF_TAB, TAG_NODE_2RY2, II_STOK, TAG_II,C_II,PROC)
5089C-----------------------------------------------
5090C M o d u l e s
5091C-----------------------------------------------
5092 USE intbufdef_mod
5093C-----------------------------------------------
5094C I m p l i c i t T y p e s
5095C-----------------------------------------------
5096#include "implicit_f.inc"
5097C-----------------------------------------------
5098C D u m m y A r g u m e n t s
5099C-----------------------------------------------
5100 INTEGER TAG_NODE_2RY2(*),TAG_II(*),II_STOK, PROC
5101
5102 TYPE(intbuf_struct_) :: INTBUF_TAB
5103C-----------------------------------------------
5104C F u n c t i o n
5105C-----------------------------------------------
5106 INTEGER NLOCAL
5107 EXTERNAL nlocal
5108C-----------------------------------------------
5109C L o c a l V a r i a b l e s
5110C-----------------------------------------------
5111 INTEGER
5112 . K,M,N,C_II
5113C ----------------------------------------
5114
5115! prepare split candidates
5116 c_ii = 0
5117 DO k = 1, ii_stok
5118 m = intbuf_tab%CAND_N(k)
5119 n = intbuf_tab%NSV(m)
5120 IF (nlocal(n,proc+1)==1) THEN
5121 IF(abs(intbuf_tab%IRTLM(2*(m-1)+1))==intbuf_tab%CAND_E(k)) THEN
5122 c_ii = c_ii + 1
5123 tag_ii(c_ii) = k
5124 ENDIF
5125 ENDIF
5126 ENDDO
5127
5128 RETURN
5129 END
5130C=======================================================================
5131C END SPECIFIC ROUTINES INT21
5132C=======================================================================
5133
5134C=======================================================================
5135C SPECIFIC ROUTINES INT 24
5136C=======================================================================
5137!||====================================================================
5138!|| prepare_split_i24 ../starter/source/restart/ddsplit/inter_tools.F
5139!||--- called by ------------------------------------------------------
5140!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5141!||--- calls -----------------------------------------------------
5142!|| nlocal ../starter/source/spmd/node/ddtools.F
5143!|| secnd_surface_on_domain ../starter/source/interfaces/inter3d1/i24setnodes.F
5144!||--- uses -----------------------------------------------------
5145!|| front_mod ../starter/share/modules1/front_mod.F
5146!||====================================================================
5147 SUBROUTINE prepare_split_i24(PROC , INTBUF_TAB , IPARI ,
5148 . INTERCEP , TAG_NODE_2RY, TAG_SEGM ,
5149 . TAG_SEGM2, TAG_NM , TAG_NODE_MSR,
5150 . TAG_SCRATCH,NODLOCAL24 ,NODLOCAL,
5151 . INTERCEP2,
5152 . NUMNOD_L,TAG_NSNE,TAG_SEGS,TAG_SEGS2,NI,TAG_2RY_INV,
5153 . IEDGE4,TAG_NODE_2RY2,TAG_IELEM,CEP,CEL,TAG_SEGSS,
5154 . NINDX_NM,INDX_NM,NINDX_SCRT,INDX_SCRT,
5155 . NINDX_NDLOCAL24,INDX_NDLOCAL24,INTERCEP3)
5156C-----------------------------------------------
5157C M o d u l e s
5158C-----------------------------------------------
5159 USE intbufdef_mod
5160 USE front_mod
5161C-----------------------------------------------
5162C I m p l i c i t T y p e s
5163C-----------------------------------------------
5164#include "implicit_f.inc"
5165C-----------------------------------------------
5166C C o m m o n B l o c k s
5167C-----------------------------------------------
5168#include "com04_c.inc"
5169C-----------------------------------------------
5170C D u m m y A r g u m e n t s
5171C-----------------------------------------------
5172 TYPE(intbuf_struct_) :: INTBUF_TAB
5173 TYPE(INTERSURFP) :: INTERCEP,INTERCEP2,INTERCEP3
5174
5175 INTEGER PROC,INTNITSCHE,IPARI(*),
5176 . TAG_NODE_2RY(*),TAG_SEGM(*),TAG_NM(*),TAG_NODE_MSR(*),
5177 . TAG_SEGM2(*),TAG_SCRATCH(*),NODLOCAL24(*) ,NODLOCAL(*),
5178 . numnod_l,tag_nsne(*),tag_segs(*),tag_segs2(*),ni,tag_2ry_inv(*),iedge4,
5179 . tag_node_2ry2(*),tag_ielem(*),cep(*),cel(*),tag_segss(*)
5180 INTEGER, INTENT(INOUT) ::NINDX_NM,NINDX_SCRT,NINDX_NDLOCAL24
5181 INTEGER, DIMENSION(*), INTENT(INOUT) ::INDX_NM,INDX_SCRT,INDX_NDLOCAL24
5182! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
5183! NODLOCAL : integer, dimension=NUMNOD
5184! gives the local ID of a global element
5185! --> used here to avoid NLOCAL call (the NLOCAL perf is bad)
5186! NODLOCAL /= 0 if the element is on the current domain/processor
5187! and =0 if the element is not on the current domain
5188! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
5189
5190C-----------------------------------------------
5191C F u n c t i o n
5192C-----------------------------------------------
5193 INTEGER NLOCAL
5194 EXTERNAL NLOCAL
5195C-----------------------------------------------
5196C L o c a l V a r i a b l e s
5197C-----------------------------------------------
5198 INTEGER
5199 . NSN,NRTM,NMN,NRTS,
5200 . I,J,K,N,N1,N2,N3,N4,E,IE,IE_LOC,PROC2,
5201 . CNSN_L,CNRTM_L,CNMN_L,NRTSE,NSNE,NSN0,NSNE_COUNT,SE1,
5202 . cnrts_l
5203 INTEGER
5204 . secnd_surface_on_domain,nrtse_count
5205 EXTERNAL secnd_surface_on_domain
5206C ----------------------------------------
5207 nrts = ipari(3)
5208 nrtm = ipari(4)
5209 nsn = ipari(5)
5210 nmn = ipari(6)
5211 nrtse= ipari(52)
5212 nsne = ipari(55)
5213 nsn0 = nsn - nsne
5214 intnitsche = ipari(86)
5215
5216 cnsn_l = 0
5217 DO k=1, nsn0
5218 n=intbuf_tab%NSV(k)
5219 IF( (nodlocal(n)/=0.AND.nodlocal(n)<=numnod_l)
5220 + .AND.tag_scratch(n)==0) THEN
5221 cnsn_l = cnsn_l+1
5222 tag_node_2ry(cnsn_l) = k
5223 IF(iedge4 > 0) tag_2ry_inv(k)=cnsn_l
5224 tag_scratch(n)=1
5225 nindx_scrt = nindx_scrt + 1
5226 indx_scrt(nindx_scrt) = n
5227 ENDIF
5228 ENDDO
5229
5230 DO k=1+nsn0, nsne+nsn0
5231 n=intbuf_tab%NSV(k)-numnod
5232 se1 = intbuf_tab%IS2SE(2*(n-1)+1)
5233 IF (intercep2%P(se1)==proc+1)THEN
5234 cnsn_l = cnsn_l+1
5235 tag_node_2ry(cnsn_l) = k
5236 tag_2ry_inv(k)=cnsn_l
5237 ENDIF
5238 ENDDO
5239
5240 !reflush to zero only part of TAG_SCRATCH that has been used
5241#include "vectorize.inc"
5242 DO k=1,nindx_scrt
5243 n = indx_scrt(k)
5244 tag_scratch(n) = 0
5245 ENDDO
5246 nindx_scrt = 0
5247
5248
5249
5250! prepare SPLIT_NRTM_R
5251 cnrtm_l = 0
5252 DO k=1,nrtm
5253 n1 = intbuf_tab%IRECTM(4*(k-1)+1)
5254 n2 = intbuf_tab%IRECTM(4*(k-1)+2)
5255 n3 = intbuf_tab%IRECTM(4*(k-1)+3)
5256 n4 = intbuf_tab%IRECTM(4*(k-1)+4)
5257 IF(intercep%P(k)==proc+1)THEN
5258 cnrtm_l = cnrtm_l + 1
5259 tag_segm(cnrtm_l) = k
5260 tag_segm2(k) = cnrtm_l
5261 IF(tag_nm(n1)==0)THEN
5262 tag_nm(n1)=1
5263 nindx_nm = nindx_nm + 1
5264 indx_nm(nindx_nm) = n1
5265 ENDIF
5266 IF(tag_nm(n2)==0)THEN
5267 tag_nm(n2)=1
5268 nindx_nm = nindx_nm + 1
5269 indx_nm(nindx_nm) = n2
5270 ENDIF
5271 IF(tag_nm(n3)==0)THEN
5272 tag_nm(n3)=1
5273 nindx_nm = nindx_nm + 1
5274 indx_nm(nindx_nm) = n3
5275 ENDIF
5276 IF(tag_nm(n4)==0)THEN
5277 tag_nm(n4)=1
5278 nindx_nm = nindx_nm + 1
5279 indx_nm(nindx_nm) = n4
5280 ENDIF
5281 ENDIF
5282 ENDDO
5283
5284 cnmn_l = 0
5285 DO i=1,nmn
5286 n = intbuf_tab%MSR(i)
5287 IF(tag_nm(n)==1)THEN
5288 cnmn_l = cnmn_l + 1
5289 tag_node_msr(cnmn_l) = i
5290 ENDIF
5291 ENDDO
5292
5293 DO i=1,cnsn_l
5294 n = tag_node_2ry(i)
5295 tag_node_2ry2(n) = i
5296 ENDDO
5297
5298
5299
5300! NODLOCAL24(1:NUMNOD)=NODLOCAL(1:NUMNOD)
5301C Prepare Node ID with virtual Type 24 E2E Nodes
5302 IF (nsne > 0 ) THEN
5303
5304 nsne_count=0
5305
5306
5307 DO i = 1,nsne
5308
5309C Get First IS2SE surface
5310C If Surface is on P, than speudo node is on pocessor.
5311C Give him NODLOCAL ID (+NUMNOD_L).
5312C Evt set TAG array
5313 se1 = intbuf_tab%IS2SE(2*(i-1)+1)
5314 IF (intercep2%P(se1)==proc+1)THEN
5315 nsne_count=nsne_count+1
5316 nodlocal24(numnod+i) = numnod_l + nsne_count
5317 nindx_ndlocal24 = nindx_ndlocal24 + 1
5318 indx_ndlocal24(nindx_ndlocal24) = numnod+i
5319 tag_nsne(nsne_count)=i
5320 ENDIF
5321 END DO
5322
5323 nrtse_count=0
5324 DO i = 1,nrtse
5325 IF(intercep2%P(i)==proc+1)THEN
5326 nrtse_count=nrtse_count+1
5327 tag_segs(nrtse_count)=i
5328 tag_segs2(i)=nrtse_count
5329 ENDIF
5330 ENDDO
5331
5332
5333 END IF
5334C Nitsche Method
5335
5336 IF(intnitsche > 0) THEN
5337
5338! prepare SPLIT_NRTM_R
5339 cnrts_l = 0
5340 DO k=1,nrts
5341 IF(intercep3%P(k)==proc+1)THEN
5342 cnrts_l = cnrts_l + 1
5343 tag_segss(cnrts_l) = k
5344 ENDIF
5345 ENDDO
5346
5347 !TAG_IELEM for IELNRTS tab writing
5348
5349 DO i = 1, cnrts_l ! NRTS = NRTM only if NRT_SH = 0
5350 k = tag_segss(i)
5351 ie = intbuf_tab%IELNRTS(k)
5352c PROC2 = CEP(IE)
5353c IF(PROC2==PROC) THEN
5354 ie_loc = cel(ie)
5355 tag_ielem(i) = ie_loc
5356c ENDIF
5357 ENDDO
5358 ENDIF
5359
5360
5361 RETURN
5362 END
5363!||====================================================================
5364!|| split_node_ival_i24 ../starter/source/restart/ddsplit/inter_tools.F
5365!||--- called by ------------------------------------------------------
5366!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5367!||--- calls -----------------------------------------------------
5368!||--- uses -----------------------------------------------------
5369!||====================================================================
5370 SUBROUTINE split_node_ival_i24(TAB,DIM1,TAG,TAG2)
5371c
5372c split node array with global value specific type24 & type25
5373c (see SPLIT_NODE_NODLOC for local values)
5374c
5375C-----------------------------------------------
5376C M o d u l e s
5377C-----------------------------------------------
5378 USE intbufdef_mod
5379C-----------------------------------------------
5380C I m p l i c i t T y p e s
5381C-----------------------------------------------
5382#include "implicit_f.inc"
5383C-----------------------------------------------
5384C D u m m y A r g u m e n t s
5385C-----------------------------------------------
5386 INTEGER TAB(*),DIM1,TAG(*),TAG2(*)
5387C-----------------------------------------------
5388C L o c a l V a r i a b l e s
5389C-----------------------------------------------
5390 INTEGER I,K,N
5391 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
5392C ----------------------------------------
5393 ALLOCATE(ibuf(dim1))
5394
5395 DO i=1, dim1
5396 k=tag(i)
5397 n = tab(k)
5398 IF(n>0)THEN
5399 ibuf(i) = tag2(n)
5400 ELSEIF(n<0)THEN
5401 ibuf(i) = -tag2(-n)
5402 ELSE
5403 ibuf(i) = 0
5404 ENDIF
5405 ENDDO
5406
5407 CALL write_i_c(ibuf,dim1)
5408 DEALLOCATE(ibuf)
5409
5410 RETURN
5411 END
5412!||====================================================================
5413!|| split_seg_nodloc_i24 ../starter/source/restart/ddsplit/inter_tools.F
5414!||--- called by ------------------------------------------------------
5415!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5416!||--- calls -----------------------------------------------------
5417!||--- uses -----------------------------------------------------
5418!||====================================================================
5419 SUBROUTINE split_seg_nodloc_i24(TAB,DIM1,DIM2,TAG_SEG,NODLOCAL)
5420C-----------------------------------------------
5421C M o d u l e s
5422C-----------------------------------------------
5423 USE intbufdef_mod
5424C-----------------------------------------------
5425C I m p l i c i t T y p e s
5426C-----------------------------------------------
5427#include "implicit_f.inc"
5428C-----------------------------------------------
5429C D u m m y A r g u m e n t s
5430C-----------------------------------------------
5431 INTEGER TAB(*),TAG_SEG(*),DIM1,DIM2,NODLOCAL(*)
5432C-----------------------------------------------
5433C L o c a l V a r i a b l e s
5434C-----------------------------------------------
5435 INTEGER I,J,K,N
5436 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
5437C ----------------------------------------
5438 ALLOCATE(ibuf(dim1*dim2))
5439 DO i=1, dim1
5440 k=tag_seg(i)
5441 DO j=1,dim2
5442 n = tab(dim2*(k-1)+j)
5443
5444 IF(n>0)THEN
5445 ibuf(dim2*(i-1)+j) = nodlocal(n)
5446 ELSEIF(n<0)THEN
5447 ibuf(dim2*(i-1)+j) = -nodlocal(-n)
5448 ELSE
5449 ibuf(dim2*(i-1)+j) = 0
5450 ENDIF
5451 ENDDO
5452 ENDDO
5453 CALL write_i_c(ibuf,dim1*dim2)
5454 DEALLOCATE(ibuf)
5455
5456 RETURN
5457 END
5458!||====================================================================
5459!|| split_segedge_nodloc_i24 ../starter/source/restart/ddsplit/inter_tools.F
5460!||--- called by ------------------------------------------------------
5461!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5462!||--- calls -----------------------------------------------------
5463!||--- uses -----------------------------------------------------
5464!||====================================================================
5465 SUBROUTINE split_segedge_nodloc_i24(TAB,DIM1,TAG_SEG,NODLOCAL,NI)
5466C-----------------------------------------------
5467C M o d u l e s
5468C-----------------------------------------------
5469 USE intbufdef_mod
5470C-----------------------------------------------
5471C I m p l i c i t T y p e s
5472C-----------------------------------------------
5473#include "implicit_f.inc"
5474C-----------------------------------------------
5475C D u m m y A r g u m e n t s
5476C-----------------------------------------------
5477 INTEGER TAB(5,*),TAG_SEG(*),DIM1,DIM2,NODLOCAL(*)
5478C-----------------------------------------------
5479C L o c a l V a r i a b l e s
5480C-----------------------------------------------
5481 INTEGER I,J,K,N1,N2,N3,N4,NI
5482 INTEGER, DIMENSION(:,:),ALLOCATABLE :: IBUF
5483C ----------------------------------------
5484 ALLOCATE(ibuf(5,dim1))
5485 DO i=1, dim1
5486 k=tag_seg(i)
5487 n1 = tab(1,k)
5488 n2 = tab(2,k)
5489 n3 = tab(3,k)
5490 n4 = tab(4,k)
5491
5492 ibuf(1,i)=nodlocal(n1)
5493 ibuf(2,i)=nodlocal(n2)
5494 ibuf(3,i)=nodlocal(n3)
5495 ibuf(4,i)=nodlocal(n4)
5496
5497 ibuf(5,i)=tab(5,k)
5498 ENDDO
5499
5500 CALL write_i_c(ibuf,dim1*5)
5501
5502 DEALLOCATE(ibuf)
5503
5504 RETURN
5505 END
5506!||====================================================================
5507!|| split_cand_i24 ../starter/source/restart/ddsplit/inter_tools.F
5508!||--- called by ------------------------------------------------------
5509!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5510!||--- calls -----------------------------------------------------
5511!|| ancmsg ../starter/source/output/message/message.F
5512!|| plist_ifront ../starter/source/spmd/node/ddtools.F
5513!||--- uses -----------------------------------------------------
5514!|| front_mod ../starter/share/modules1/front_mod.F
5515!|| message_mod ../starter/share/message_module/message_mod.F
5516!||====================================================================
5517 SUBROUTINE split_cand_i24(PROC , INTBUF_TAB, NSN , NSN_L ,
5518 . TAG_SEGM2, II_STOK , MULTIMP, NCONT ,
5519 . NOINT , INACTI , TAG_SCRATCH ,II_STOK_L,
5520 . INTERCEP2, NINDX_SCRT, INDX_SCRT ,NODLOCAL ,
5521 . NUMNOD_L)
5522C-----------------------------------------------
5523C M o d u l e s
5524C-----------------------------------------------
5525 USE message_mod
5526 USE intbufdef_mod
5527 USE front_mod
5528C-----------------------------------------------
5529C I m p l i c i t T y p e s
5530C-----------------------------------------------
5531#include "implicit_f.inc"
5532C-----------------------------------------------
5533C C o m m o n B l o c k s
5534C-----------------------------------------------
5535#include "com01_c.inc"
5536#include "com04_c.inc"
5537C-----------------------------------------------
5538C D u m m y A r g u m e n t s
5539C-----------------------------------------------
5540 INTEGER PROC,NSN,NSN_L,II_STOK,MULTIMP,NCONT,
5541 . tag_segm2(*),noint,inacti,
5542 . tag_scratch(*) , ii_stok_l, ityp
5543 INTEGER, INTENT(INOUT) :: NINDX_SCRT
5544 INTEGER, INTENT(IN) :: NUMNOD_L
5545 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_SCRT
5546 INTEGER, DIMENSION(*), INTENT(IN) :: NODLOCAL
5547
5548 TYPE(intbuf_struct_) :: INTBUF_TAB
5549 TYPE(INTERSURFP) :: INTERCEP2
5550! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
5551! INDX_XXX : size = NUMNOD
5552! index of non-zero TAG_XXX value
5553! used for optimize the initialization
5554! of TAG_XXX array (XXX = NM or SCRT for SCRATCH)
5555! allocated array in lectur and threadprivate array
5556! NINDX_XXX : number of non-zero TAG_XXX value
5557! TAG_XXX : size = NUMNOD + NUMELS + I24MAXNSNE2
5558! array used to tag an element for
5559! a given interface ; allocated in lectur
5560! allocated array in lectur and threadprivate array
5561! NODLOCAL : integer, dimension=NUMNOD
5562! gives the local ID of a global element
5563! --> used here to avoid NLOCAL call (the NLOCAL perf is bad)
5564! NODLOCAL /= 0 if the element is on the current domain/processor
5565! and =0 if the element is not on the current domain
5566! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
5567C-----------------------------------------------
5568C F u n c t i o n
5569C-----------------------------------------------
5570! INTEGER NLOCAL
5571! EXTERNAL NLOCAL
5572C-----------------------------------------------
5573C L o c a l V a r i a b l e s
5574C-----------------------------------------------
5575 INTEGER I,J,K,N,P,E,MULTOK,MSGID,
5576 . splist,c_nsnr,nn,se1,my_node
5577 INTEGER NUMP(NSPMD),WORK(70000)
5578
5579 INTEGER, DIMENSION(:),ALLOCATABLE ::
5580 . ibuf_e,ibuf_n,nsnlocal,cpulocal,candr,plist,
5581 . index
5582
5583 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ITRI
5584 LOGICAL CONDITION
5585C ----------------------------------------
5586C w to be done :modif w/ edge
5587C ----------------------------------------
5588 ALLOCATE(ibuf_e(multimp*ncont),ibuf_n(multimp*ncont))
5589 ibuf_e(1:multimp*ncont) = 0
5590 ibuf_n(1:multimp*ncont) = 0
5591 ii_stok_l = 0 !mandatory in case of inacti ne 5,6,7
5592
5593 IF(nsn>0) THEN
5594 ALLOCATE(nsnlocal(nsn))
5595 ALLOCATE(cpulocal(nsn))
5596 ALLOCATE(candr(nsn))
5597 END IF
5598
5599 nump(1:nspmd) = 0
5600
5601 ALLOCATE(plist(nspmd))
5602 plist(1:nspmd) = -1
5603 DO k=1,nsn
5604 n = intbuf_tab%NSV(k)
5605 nsnlocal(k) = 0
5606 IF(tag_scratch(n)==0) THEN
5607 splist=0
5608 IF(n<=numnod)THEN
5609 CALL plist_ifront(plist,n,splist)
5610 DO i=1,splist
5611 p=plist(i)
5612 nump(p) = nump(p)+1
5613 ENDDO
5614 IF( nodlocal( n )/=0.AND.nodlocal(n)<=numnod_l ) THEN
5615 nsnlocal(k) = nump(proc+1)
5616 cpulocal(k) = proc+1
5617 ELSE
5618 p = plist(1)
5619 nsnlocal(k) = nump(p)
5620 cpulocal(k) = p
5621 ENDIF
5622 ELSE
5623C T24 E2E Nodes can be on 1 SPMD domain only
5624 nn = n - numnod
5625 se1 = intbuf_tab%IS2SE(2*(nn-1)+1)
5626 p = intercep2%P(se1)
5627 nump(p) = nump(p)+1
5628 nsnlocal(k) = nump(p)
5629 cpulocal(k) = p
5630 ENDIF
5631
5632 tag_scratch(n) = 1
5633 nindx_scrt = nindx_scrt + 1
5634 indx_scrt(nindx_scrt) = n
5635 ENDIF
5636 ENDDO
5637 DEALLOCATE(plist)
5638
5639 !reflush TAG_SCRATCH to zero only when value has changes
5640#include "vectorize.inc"
5641 DO k=1,nindx_scrt
5642 n = indx_scrt(k)
5643 tag_scratch(n) = 0
5644 ENDDO
5645 nindx_scrt = 0
5646C
5647C Locating candidates on remote processors
5648C
5649 c_nsnr = 0
5650
5651 DO k = 1, ii_stok
5652 e = intbuf_tab%CAND_E(k)
5653 IF (tag_segm2(e)/=0) THEN
5654 n = intbuf_tab%CAND_N(k)
5655C IF (INTBUF_TAB%NSV(N)> NUMNOD) CYCLE
5656 IF(tag_scratch(n)==0) THEN
5657 tag_scratch(n) = 1
5658 nindx_scrt = nindx_scrt + 1
5659 indx_scrt(nindx_scrt) = n
5660 IF(intbuf_tab%NSV(n) <= numnod)THEN
5661 my_node = intbuf_tab%NSV(n)
5662 IF( nodlocal( my_node ) ==0.OR.nodlocal( my_node )>numnod_l ) THEN
5663 c_nsnr = c_nsnr + 1
5664 candr(c_nsnr) = n
5665 END IF
5666 ELSE
5667 nn = intbuf_tab%NSV(n) - numnod
5668 se1 = intbuf_tab%IS2SE(2*(nn-1)+1)
5669 p = intercep2%P(se1)
5670 IF(p/= (proc+1) ) THEN
5671 c_nsnr = c_nsnr + 1
5672 candr(c_nsnr) = n
5673 ENDIF
5674 ENDIF
5675 END IF
5676 ENDIF
5677 ENDDO
5678
5679 !reflush TAG_SCRATCH to zero only when value has changes
5680#include "vectorize.inc"
5681 DO k=1,nindx_scrt
5682 n = indx_scrt(k)
5683 tag_scratch(n) = 0
5684 ENDDO
5685 nindx_scrt = 0
5686C
5687C Sorting remote candidates by proc and by ascending local nsv
5688C
5689 IF(c_nsnr>0) THEN
5690 ALLOCATE(index(2*c_nsnr))
5691 ALLOCATE(itri(2,c_nsnr))
5692 END IF
5693 DO i = 1, c_nsnr
5694 n = candr(i)
5695 itri(1,i) = cpulocal(n)
5696 itri(2,i) = nsnlocal(n)
5697 ENDDO
5698 CALL my_orders(0,work,itri,index,c_nsnr,2)
5699C
5700 DO i = 1, c_nsnr
5701 index(c_nsnr+index(i)) = i
5702 ENDDO
5703 DO i = 1, c_nsnr
5704 index(i)=index(c_nsnr+i)
5705 ENDDO
5706C
5707 ii_stok_l = 0
5708
5709 c_nsnr = 0
5710 DO k = 1, ii_stok
5711 e = intbuf_tab%CAND_E(k)
5712 IF (tag_segm2(e)/=0) THEN
5713 ii_stok_l = ii_stok_l + 1
5714 END IF
5715 END DO
5716
5717 IF(ii_stok_l>multimp*ncont)THEN
5718 multok= ii_stok_l/ncont
5719 CALL ancmsg(msgid=626,
5720 . msgtype=msgerror,
5721 . anmode=aninfo,
5722 . i1=multok,
5723 . i2=noint)
5724 ELSE
5725 ii_stok_l = 0
5726C
5727 DO k = 1, ii_stok
5728 e = intbuf_tab%CAND_E(k)
5729 IF (tag_segm2(e)/=0) THEN
5730 n = intbuf_tab%CAND_N(k)
5731 ii_stok_l = ii_stok_l + 1
5732 ibuf_e(ii_stok_l)=tag_segm2(e)
5733 IF (intbuf_tab%NSV(n)>numnod) THEN
5734 nn = intbuf_tab%NSV(n)-numnod
5735 se1 = intbuf_tab%IS2SE(2*(nn-1)+1)
5736 p=0
5737 IF(intercep2%P(se1)==(proc+1)) p=1
5738 ELSE
5739 p = 0
5740 my_node = intbuf_tab%NSV(n)
5741 IF( nodlocal( my_node )/=0.AND.nodlocal( my_node )<=numnod_l ) p=1
5742 ENDIF
5743
5744 IF(p==1 ) THEN
5745 ibuf_n(ii_stok_l)=nsnlocal(n)
5746 ELSE
5747C remote node : numbering pre-calculated above
5748c IF(TAG(N)==0) THEN
5749 IF(tag_scratch(n)==0) THEN
5750 c_nsnr = c_nsnr + 1
5751 ibuf_n(ii_stok_l)=index(c_nsnr)+nsn_l
5752 tag_scratch(n) = index(c_nsnr)+nsn_l
5753 nindx_scrt = nindx_scrt + 1
5754 indx_scrt(nindx_scrt) = n
5755 ELSE
5756 ibuf_n(ii_stok_l) = tag_scratch(n)
5757 END IF ! TAG(N)==0
5758 END IF ! NLOCAL(INTBUF_TAB%NSV(N),PROC+1)==1
5759 ENDIF !TAG_SEGM_2(E)/=0
5760 ENDDO !K = 1, II_STOK
5761 END IF !II_STOK_L>MULTIMP*NCONT
5762
5763 !reflush TAG_SCRATCH to zero only when value has changes
5764#include "vectorize.inc"
5765 DO k=1,nindx_scrt
5766 n = indx_scrt(k)
5767 tag_scratch(n) = 0
5768 ENDDO
5769 nindx_scrt = 0
5770
5771 IF(nsn>0) DEALLOCATE(nsnlocal,cpulocal,candr)
5772 IF(c_nsnr>0) DEALLOCATE(index,itri)
5773
5774
5775 CALL write_i_c(ibuf_e,multimp*ncont)
5776 CALL write_i_c(ibuf_n,multimp*ncont)
5777
5778 DEALLOCATE(ibuf_e,ibuf_n)
5779
5780 RETURN
5781 END
5782C
5783!||====================================================================
5784!|| split_seg_edge ../starter/source/restart/ddsplit/inter_tools.F
5785!||--- called by ------------------------------------------------------
5786!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5787!||--- calls -----------------------------------------------------
5788!||====================================================================
5789 SUBROUTINE split_seg_edge(NSNE_L,IS2SE,TAG_NSNE,TAG_SEG2,NI)
5790C-----------------------------------------------
5791C I m p l i c i t T y p e s
5792C-----------------------------------------------
5793#include "implicit_f.inc"
5794C-----------------------------------------------
5795C D u m m y A r g u m e n t s
5796C-----------------------------------------------
5797 INTEGER IS2SE(2,*),NSNE_L,TAG_NSNE(*),TAG_SEG2(*)
5798C-----------------------------------------------
5799C L o c a l V a r i a b l e s
5800C-----------------------------------------------
5801 INTEGER I,SEG,SE1,SE2,NI
5802 INTEGER, DIMENSION(:,:),ALLOCATABLE :: IBUF
5803C-----------------------------------------------
5804 ALLOCATE(ibuf(2,nsne_l))
5805 DO i=1,nsne_l
5806 seg=tag_nsne(i)
5807 se1 = is2se(1,seg)
5808 se2 = is2se(2,seg)
5809 ibuf(1,i)=tag_seg2(se1)
5810
5811 IF(se2 /=0)THEN
5812 ibuf(2,i)=tag_seg2(se2)
5813 ELSE
5814 ibuf(2,i)=0
5815 ENDIF
5816 ENDDO
5817 CALL write_i_c(ibuf,2*nsne_l)
5818
5819 DEALLOCATE(ibuf)
5820
5821 END
5822C=======================================================================
5823C END SPECIFIC ROUTINES INT24
5824C=======================================================================
5825
5826C=======================================================================
5827C SPECIFIC ROUTINES INT 25
5828C=======================================================================
5829!||====================================================================
5830!|| split_node_ival_i25 ../starter/source/restart/ddsplit/inter_tools.F
5831!||--- called by ------------------------------------------------------
5832!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5833!||--- calls -----------------------------------------------------
5834!||--- uses -----------------------------------------------------
5835!||====================================================================
5836 SUBROUTINE split_node_ival_i25(TAB,DIMO,DIMN,TAG,TAG2)
5837c
5838c split node array with global value specific type24 & type25
5839c (see SPLIT_NODE_NODLOC for local values)
5840c
5841C-----------------------------------------------
5842C M o d u l e s
5843C-----------------------------------------------
5844 USE intbufdef_mod
5845C-----------------------------------------------
5846C I m p l i c i t T y p e s
5847C-----------------------------------------------
5848#include "implicit_f.inc"
5849C-----------------------------------------------
5850C D u m m y A r g u m e n t s
5851C-----------------------------------------------
5852 INTEGER TAB(*),DIMO,DIMN,TAG(*),TAG2(*)
5853C-----------------------------------------------
5854C L o c a l V a r i a b l e s
5855C-----------------------------------------------
5856 INTEGER I,K,N
5857 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
5858C ----------------------------------------
5859 ALLOCATE(ibuf(dimn))
5860
5861 DO i=1, dimn
5862 k=tag(i)
5863 n = tab(k)
5864 IF(n > 0)THEN
5865 IF(n > dimo)THEN
5866 n = n-dimo
5867 ibuf(i) = tag2(n)+dimn
5868 ELSE
5869 ibuf(i) = tag2(n)
5870 END IF
5871 ELSEIF(n < 0)THEN
5872 IF(n < -dimo)THEN
5873 n = n+dimo
5874 ibuf(i) = -tag2(-n)-dimn
5875 ELSE
5876 ibuf(i) = -tag2(-n)
5877 END IF
5878 ELSE
5879 ibuf(i) = 0
5880 ENDIF
5881 ENDDO
5882
5883 CALL write_i_c(ibuf,dimn)
5884 DEALLOCATE(ibuf)
5885
5886 RETURN
5887 END
5888!||====================================================================
5889!|| prepare_split_i25 ../starter/source/restart/ddsplit/inter_tools.f
5890!||--- called by ------------------------------------------------------
5891!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
5892!||--- calls -----------------------------------------------------
5893!|| nlocal ../starter/source/spmd/node/ddtools.F
5894!||--- uses -----------------------------------------------------
5895!|| front_mod ../starter/share/modules1/front_mod.F
5896!||====================================================================
5897 SUBROUTINE prepare_split_i25(PROC , INTBUF_TAB , IPARI ,
5898 . INTERCEP , TAG_NODE_2RY , TAG_SEGM ,
5899 . TAG_SEGM2 , TAG_NM , TAG_NODE_MSR ,
5900 . TAG_SCRATCH, TAG_SM ,KNOR2MSR ,
5901 . NOR2MSR ,TAG_NODE_2RY2,NINDX_NM ,
5902 . INDX_NM ,NINDX_SCRT ,INDX_SCRT ,
5903 . NRTM_L)
5904C-----------------------------------------------
5905C M o d u l e s
5906C-----------------------------------------------
5907 USE intbufdef_mod
5908 USE front_mod
5909C-----------------------------------------------
5910C I m p l i c i t T y p e s
5911C-----------------------------------------------
5912#include "implicit_f.inc"
5913C-----------------------------------------------
5914C D u m m y A r g u m e n t s
5915C-----------------------------------------------
5916 TYPE(intbuf_struct_) :: INTBUF_TAB
5917 TYPE(intersurfp) :: INTERCEP
5918
5919 INTEGER PROC,IPARI(*),
5920 . TAG_NODE_2RY(*),TAG_SEGM(*),TAG_NM(*),TAG_NODE_MSR(*),
5921 . TAG_SEGM2(*),TAG_SCRATCH(*),TAG_SM(*),
5922 . KNOR2MSR(*), NOR2MSR(*), TAG_NODE_2RY2(*)
5923 INTEGER, INTENT(INOUT) :: NINDX_NM,NINDX_SCRT
5924 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_NM,INDX_SCRT
5925C-----------------------------------------------
5926C F u n c t i o n
5927C-----------------------------------------------
5928 INTEGER NLOCAL
5929 EXTERNAL NLOCAL
5930C-----------------------------------------------
5931C L o c a l V a r i a b l e s
5932C-----------------------------------------------
5933 INTEGER
5934 . NSN,NRTM,NMN,
5935 . I,J,K,L,N,N1,N2,N3,N4,E,
5936 . CNSN_L,CNRTM_L,CNMN_L,NADMSR_L,NRTM_L
5937C ----------------------------------------
5938 NRTM = ipari(4)
5939 nsn = ipari(5)
5940 nmn = ipari(6)
5941
5942 cnsn_l = 0
5943 DO k=1, nsn
5944 n=intbuf_tab%NSV(k)
5945 IF(nlocal(n,proc+1)==1.AND.tag_scratch(n)==0) THEN
5946 cnsn_l = cnsn_l+1
5947 tag_node_2ry(cnsn_l) = k
5948 tag_scratch(n)=1
5949 tag_node_2ry2(k) = cnsn_l
5950 nindx_scrt = nindx_scrt + 1
5951 indx_scrt(nindx_scrt) = n
5952 ENDIF
5953 ENDDO
5954
5955 !reflush to zero only part of TAG_SCRATCH that has been used
5956#include "vectorize.inc"
5957 DO k=1,nindx_scrt
5958 n = indx_scrt(k)
5959 tag_scratch(n) = 0
5960 ENDDO
5961 nindx_scrt = 0
5962
5963! prepare SPLIT_NRTM_R
5964 cnrtm_l = 0
5965 DO k=1,nrtm
5966 n1 = intbuf_tab%IRECTM(4*(k-1)+1)
5967 n2 = intbuf_tab%IRECTM(4*(k-1)+2)
5968 n3 = intbuf_tab%IRECTM(4*(k-1)+3)
5969 n4 = intbuf_tab%IRECTM(4*(k-1)+4)
5970 IF(intercep%P(k)==proc+1)THEN
5971 cnrtm_l = cnrtm_l + 1
5972 tag_segm(cnrtm_l) = k
5973 tag_segm2(k) = cnrtm_l
5974 IF(tag_nm(n1)==0)THEN
5975 tag_nm(n1)=1
5976 nindx_nm = nindx_nm + 1
5977 indx_nm(nindx_nm) = n1
5978 ENDIF
5979 IF(tag_nm(n2)==0)THEN
5980 tag_nm(n2)=1
5981 nindx_nm = nindx_nm + 1
5982 indx_nm(nindx_nm) = n2
5983 ENDIF
5984 IF(tag_nm(n3)==0)THEN
5985 tag_nm(n3)=1
5986 nindx_nm = nindx_nm + 1
5987 indx_nm(nindx_nm) = n3
5988 ENDIF
5989 IF(tag_nm(n4)==0)THEN
5990 tag_nm(n4)=1
5991 nindx_nm = nindx_nm + 1
5992 indx_nm(nindx_nm) = n4
5993 ENDIF
5994 ENDIF
5995 ENDDO
5996
5997! prepare SPLIT Normals <=> Vertices
5998 nadmsr_l=0
5999 DO k=1,nrtm
6000 n1 = intbuf_tab%ADMSR(4*(k-1)+1)
6001 n2 = intbuf_tab%ADMSR(4*(k-1)+2)
6002 n3 = intbuf_tab%ADMSR(4*(k-1)+3)
6003 n4 = intbuf_tab%ADMSR(4*(k-1)+4)
6004 IF(intercep%P(k)==proc+1)THEN
6005 IF(tag_sm(n1)==0)THEN
6006 nadmsr_l=nadmsr_l+1
6007 tag_sm(n1)=nadmsr_l
6008 END IF
6009 IF(tag_sm(n2)==0)THEN
6010 nadmsr_l=nadmsr_l+1
6011 tag_sm(n2)=nadmsr_l
6012 END IF
6013 IF(tag_sm(n3)==0)THEN
6014 nadmsr_l=nadmsr_l+1
6015 tag_sm(n3)=nadmsr_l
6016 END IF
6017 IF(tag_sm(n4)==0)THEN
6018 nadmsr_l=nadmsr_l+1
6019 tag_sm(n4)=nadmsr_l
6020 END IF
6021 ENDIF
6022 ENDDO
6023
6024 cnmn_l = 0
6025 DO i=1,nmn
6026 n = intbuf_tab%MSR(i)
6027 IF(tag_nm(n)==1)THEN
6028 cnmn_l = cnmn_l + 1
6029 tag_node_msr(cnmn_l) = i
6030 ENDIF
6031 ENDDO
6032
6033C-----------------------------------------------
6034C PRETHING Addresses
6035C
6036 DO i=1,nrtm
6037 IF(intercep%P(i)==proc+1)THEN
6038 DO k=1,3
6039 n = tag_sm(intbuf_tab%ADMSR(4*(i-1)+k))
6040 knor2msr(n) = knor2msr(n) + 1
6041 END DO
6042 IF(intbuf_tab%IRECTM(4*(i-1)+3)/=intbuf_tab%IRECTM(4*(i-1)+4))THEN
6043 n = tag_sm(intbuf_tab%ADMSR(4*(i-1)+4))
6044 knor2msr(n) = knor2msr(n) + 1
6045 END IF
6046 END IF
6047 END DO
6048C
6049 DO i=1,nadmsr_l
6050 knor2msr(i+1) = knor2msr(i+1) + knor2msr(i)
6051 END DO
6052C
6053 DO i=nadmsr_l,1,-1
6054 knor2msr(i+1)=knor2msr(i)
6055 END DO
6056 knor2msr(1)=0
6057C
6058C Construction of the Nod -> Shell elt matrix
6059C
6060 DO i=1,nrtm
6061 IF(intercep%P(i)==proc+1)THEN
6062 DO k=1,3
6063 n = tag_sm(intbuf_tab%ADMSR(4*(i-1)+k))
6064 knor2msr(n) = knor2msr(n) + 1
6065 nor2msr(knor2msr(n)) = tag_segm2(i)
6066 END DO
6067 IF(intbuf_tab%IRECTM(4*(i-1)+3)/=intbuf_tab%IRECTM(4*(i-1)+4))THEN
6068 n = tag_sm(intbuf_tab%ADMSR(4*(i-1)+4))
6069 knor2msr(n) = knor2msr(n) + 1
6070 nor2msr(knor2msr(n)) = tag_segm2(i)
6071 END IF
6072 END IF
6073 END DO
6074C
6075 DO i=nadmsr_l,1,-1
6076 knor2msr(i+1)=knor2msr(i)
6077 END DO
6078 knor2msr(1)=0
6079C
6080 RETURN
6081 END
6082!||====================================================================
6083!|| split_ledge_i25 ../starter/source/restart/ddsplit/inter_tools.F
6084!||--- called by ------------------------------------------------------
6085!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
6086!||--- calls -----------------------------------------------------
6087!||--- uses -----------------------------------------------------
6088!||====================================================================
6089 SUBROUTINE split_ledge_i25(NEDGE,
6090 . NEDGE_L,
6091 . IRECTM,
6092 . NRTM_L,
6093 . LEDGE,
6094 . MSEGLO,
6095 . ADMSR,
6096 . SEGLOC,
6097 . TAG_SM,
6098 . NODLOCAL,
6099 . TAG_EDGE,
6100 . ITAB,
6101 . PROC)
6102c
6103C-----------------------------------------------
6104C M o d u l e s
6105C-----------------------------------------------
6106 USE intbufdef_mod
6107C-----------------------------------------------
6108C I m p l i c i t T y p e s
6109C-----------------------------------------------
6110#include "implicit_f.inc"
6111C-----------------------------------------------
6112C C o m m o n B l o c k s
6113C-----------------------------------------------
6114#include "param_c.inc"
6115#include "assert.inc"
6116C-----------------------------------------------
6117C D u m m y A r g u m e n t s
6118C-----------------------------------------------
6119 INTEGER NEDGE, NEDGE_L, NRTM_L, LEDGE(NLEDGE,*), MSEGLO(*), SEGLOC(*), NODLOCAL(*)
6120 INTEGER :: PROC
6121 INTEGER :: TAG_EDGE(NEDGE_L)
6122 INTEGER, INTENT(IN) :: ITAB(*)
6123 INTEGER, INTENT(IN) :: IRECTM(4,*)
6124 INTEGER, INTENT(IN) :: ADMSR(4,*)
6125 INTEGER, INTENT(IN) :: TAG_SM(*)
6126
6127C-----------------------------------------------
6128C L o c a l V a r i a b l e s
6129C-----------------------------------------------
6130 INTEGER :: I,E1,K1,E2,K2,CMPT
6131 INTEGER :: ID
6132 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
6133 INTEGER :: NB_FREE_EDGES
6134 INTEGER :: NB_INTERNAL_EDGES
6135 INTEGER :: NB_BOUNDARY_EDGES_LOCAL ! boundary edges treated by current domain
6136 INTEGER :: NB_BOUNDARY_EDGES_REMOTE ! boundary edges treated by the other domain
6137 INTEGER :: IAS,JAS,IS,N1,N2,I1,I2
6138C ----------------------------------------
6139 ALLOCATE(ibuf(nledge*nedge_l))
6140
6141 cmpt=0
6142 id = 1
6143 nb_free_edges = 0
6144C FREE EDGES
6145 DO i=1, nedge
6146 e1=ledge(1,i)
6147 k1=segloc(e1)
6148 e2=ledge(3,i)
6149 IF(e2/=0)THEN
6150! not free edge
6151 k2=segloc(e2)
6152 ELSE
6153! Free edge
6154 k2=-1
6155 END IF
6156 IF( k1 > 0 .AND. k2 == -1) THEN
6157 nb_free_edges = nb_free_edges + 1
6158! Internal edge
6159 tag_edge(id) = i
6160C at starter phase 9 and 10 are used to save PROC and local ID
6161 assert(ledge(9,i) == proc)
6162 assert(ledge(10,i) == id)
6163 ledge(9,i) = proc
6164 ledge(10,i) = id
6165
6166 id = id + 1
6167 cmpt=cmpt+1
6168 ibuf(cmpt) = k1
6169 cmpt=cmpt+1
6170 ibuf(cmpt) = ledge(2,i)
6171 cmpt=cmpt+1
6172 ibuf(cmpt) = 0
6173 cmpt=cmpt+1
6174 ibuf(cmpt) = 0
6175 cmpt=cmpt+1
6176 ibuf(cmpt) = nodlocal(ledge(5,i))
6177 cmpt=cmpt+1
6178 ibuf(cmpt) = nodlocal(ledge(6,i))
6179 cmpt=cmpt+1
6180 ibuf(cmpt) = ledge(7,i)
6181 cmpt=cmpt+1
6182 ibuf(cmpt) = i ! + 10000* ITAB(LEDGE(6,I))
6183 cmpt=cmpt+1
6184 ibuf(cmpt) = 1 ! Weight
6185C orientation segment 1
6186 cmpt=cmpt+1
6187 ias=ledge(1,i)
6188 jas=ledge(2,i)
6189 n1=ledge(5,i)
6190 n2=ledge(6,i)
6191 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6192 is= 1
6193 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6194 is=-1
6195 ELSE
6196 is = -huge(is)
6197 assert(.false.)
6198 END IF
6199 ibuf(cmpt) = is
6200 IF(is==1)THEN
6201 i1=admsr(jas,ias)
6202 i2=admsr(mod(jas,4)+1,ias)
6203 ELSE ! IM(I)==-1
6204 i2=admsr(jas,ias)
6205 i1=admsr(mod(jas,4)+1,ias)
6206 END IF
6207 cmpt=cmpt+1
6208 ibuf(cmpt) = tag_sm(i1)
6209 cmpt=cmpt+1
6210 ibuf(cmpt) = tag_sm(i2)
6211 assert(tag_sm(i1) > 0)
6212 assert(tag_sm(i2) > 0)
6213C orientation segment 2
6214 cmpt=cmpt+1
6215 ibuf(cmpt) = 0
6216 cmpt=cmpt+1
6217 ibuf(cmpt) = 0
6218 cmpt=cmpt+1
6219 ibuf(cmpt) = 0
6220 END IF
6221 ENDDO
6222
6223C INTERNAL EDGES
6224 nb_internal_edges = 0
6225 DO i=1, nedge
6226 e1=ledge(1,i)
6227 k1=segloc(e1)
6228 e2=ledge(3,i)
6229 IF(e2/=0)THEN
6230! not free edge
6231 k2=segloc(e2)
6232 ELSE
6233! Free edge
6234 k2=-1
6235 END IF
6236 IF( k1 > 0 .AND. k2 > 0) THEN
6237 nb_internal_edges = nb_internal_edges + 1
6238
6239! Internal edge
6240 tag_edge(id) = i
6241C at starter phase 9 and 10 are used to save PROC and local ID
6242 assert(ledge(9,i) == proc)
6243 assert(ledge(10,i) == id)
6244 ledge(9,i) = proc
6245 ledge(10,i) = id
6246
6247 id = id + 1
6248 cmpt=cmpt+1
6249 ibuf(cmpt) = k1
6250 cmpt=cmpt+1
6251 ibuf(cmpt) = ledge(2,i)
6252 cmpt=cmpt+1
6253 ibuf(cmpt) = k2
6254 cmpt=cmpt+1
6255 ibuf(cmpt) = ledge(4,i)
6256 cmpt=cmpt+1
6257 ibuf(cmpt) = nodlocal(ledge(5,i))
6258 cmpt=cmpt+1
6259 ibuf(cmpt) = nodlocal(ledge(6,i))
6260 cmpt=cmpt+1
6261 ibuf(cmpt) = ledge(7,i)
6262 cmpt=cmpt+1
6263 ibuf(cmpt) = i ! + 10000* ITAB(LEDGE(6,I))
6264 cmpt=cmpt+1
6265 ibuf(cmpt) = 1 ! Weight
6266C orientation segment 1
6267 cmpt=cmpt+1
6268 ias=ledge(1,i)
6269 jas=ledge(2,i)
6270 n1=ledge(5,i)
6271 n2=ledge(6,i)
6272 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6273 is= 1
6274 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6275 is=-1
6276 ELSE
6277 assert(.false.)
6278 END IF
6279 ibuf(cmpt) = is
6280 IF(is==1)THEN
6281 i1=admsr(jas,ias)
6282 i2=admsr(mod(jas,4)+1,ias)
6283 ELSE ! IM(I)==-1
6284 i2=admsr(jas,ias)
6285 i1=admsr(mod(jas,4)+1,ias)
6286 END IF
6287 cmpt = cmpt +1
6288 ibuf(cmpt) = tag_sm(i1)
6289 cmpt=cmpt+1
6290 ibuf(cmpt) = tag_sm(i2)
6291 assert(tag_sm(i1) > 0)
6292 assert(tag_sm(i2) > 0)
6293
6294C orientation segment 2
6295 cmpt=cmpt+1
6296 ias=ledge(3,i)
6297 jas=ledge(4,i)
6298 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6299 is= 1
6300 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6301 is=-1
6302 ELSE
6303 assert(.false.)
6304 END IF
6305 ibuf(cmpt) = is
6306
6307 IF(is==1)THEN
6308 i1=admsr(jas,ias)
6309 i2=admsr(mod(jas,4)+1,ias)
6310 ELSE ! IM(I)==-1
6311 i2=admsr(jas,ias)
6312 i1=admsr(mod(jas,4)+1,ias)
6313 END IF
6314 cmpt = cmpt +1
6315 ibuf(cmpt) = tag_sm(i1)
6316 cmpt=cmpt+1
6317 ibuf(cmpt) = tag_sm(i2)
6318 assert(tag_sm(i1) > 0)
6319 assert(tag_sm(i2) > 0)
6320
6321
6322
6323 END IF
6324 ENDDO
6325
6326 nb_boundary_edges_local = 0
6327 DO i=1, nedge
6328 e1=ledge(1,i)
6329 k1=segloc(e1)
6330 e2=ledge(3,i)
6331 IF(e2/=0)THEN
6332! not free edge
6333 k2=segloc(e2)
6334 ELSE
6335! Free edge
6336 k2=-1
6337 END IF
6338 IF( k1 > 0 .AND. k2 == 0) THEN
6339 nb_boundary_edges_local = nb_boundary_edges_local + 1
6340 tag_edge(id) = i
6341C at starter phase 9 and 10 are used to save PROC and local ID
6342 assert(ledge(9,i) == proc)
6343c ASSERT(LEDGE(10,I) == ID)
6344 ledge(9,i) = proc
6345 ledge(10,i) = id
6346
6347 id = id + 1
6348 cmpt=cmpt+1
6349 ibuf(cmpt) = k1
6350 cmpt=cmpt+1
6351 ibuf(cmpt) = ledge(2,i)
6352C boundary edge: remote segment
6353 cmpt=cmpt+1
6354C IBUF(CMPT) = -MSEGLO(E2)
6355 ibuf(cmpt) = -k1
6356 cmpt=cmpt+1
6357 ibuf(cmpt) = ledge(4,i)
6358C IBUF(CMPT) = LEDGE(2,I)
6359 cmpt=cmpt+1
6360 ibuf(cmpt) = nodlocal(ledge(5,i))
6361 cmpt=cmpt+1
6362 ibuf(cmpt) = nodlocal(ledge(6,i))
6363 cmpt=cmpt+1
6364 ibuf(cmpt) = ledge(7,i)
6365 cmpt=cmpt+1
6366 ibuf(cmpt) = i ! + 10000* ITAB(LEDGE(6,I))
6367 cmpt=cmpt+1
6368 ibuf(cmpt) = 1 ! Weight
6369C orientation segment 1
6370 cmpt=cmpt+1
6371 ias=ledge(1,i)
6372 jas=ledge(2,i)
6373 n1=ledge(5,i)
6374 n2=ledge(6,i)
6375 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6376 is= 1
6377 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6378 is=-1
6379 ELSE
6380 assert(.false.)
6381 END IF
6382 ibuf(cmpt) = is
6383 IF(is==1)THEN
6384 i1=admsr(jas,ias)
6385 i2=admsr(mod(jas,4)+1,ias)
6386 ELSE ! IM(I)==-1
6387 i2=admsr(jas,ias)
6388 i1=admsr(mod(jas,4)+1,ias)
6389 END IF
6390 cmpt = cmpt +1
6391 ibuf(cmpt) = tag_sm(i1)
6392 cmpt = cmpt +1
6393 ibuf(cmpt) = tag_sm(i2)
6394 assert(tag_sm(i1) > 0)
6395 assert(tag_sm(i2) > 0)
6396
6397C orientation segment 2
6398 cmpt=cmpt+1
6399 ias=ledge(3,i)
6400 jas=ledge(4,i)
6401 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6402 is= 1
6403 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6404 is=-1
6405 ELSE
6406 assert(.false.)
6407 END IF
6408 ibuf(cmpt) = is
6409 IF(is==1)THEN
6410 i1=admsr(jas,ias)
6411 i2=admsr(mod(jas,4)+1,ias)
6412 ELSE ! IM(I)==-1
6413 i2=admsr(jas,ias)
6414 i1=admsr(mod(jas,4)+1,ias)
6415 ENDIF
6416 cmpt = cmpt +1
6417 ibuf(cmpt) = tag_sm(i1)
6418 cmpt = cmpt +1
6419 ibuf(cmpt) = tag_sm(i2)
6420 assert(tag_sm(i1) > 0)
6421 assert(tag_sm(i2) > 0)
6422
6423 ENDIF
6424 ENDDO
6425
6426 nb_boundary_edges_remote = 0
6427 DO i=1, nedge
6428 e1=ledge(1,i)
6429 k1=segloc(e1)
6430 e2=ledge(3,i)
6431 IF(e2/=0)THEN
6432! not free edge
6433 k2=segloc(e2)
6434 ELSE
6435! Free edge
6436 k2=-1
6437 END IF
6438 IF( k1 == 0 .AND. k2 > 0) THEN
6439 nb_boundary_edges_remote = nb_boundary_edges_remote + 1
6440 tag_edge(id) = i
6441 id = id + 1
6442! if at least one segment belongs to this domain
6443! Put the local segment first
6444 cmpt=cmpt+1
6445 ibuf(cmpt) = k2 !1
6446 cmpt=cmpt+1
6447 ibuf(cmpt) = ledge(4,i) !2
6448 cmpt=cmpt+1
6449C IBUF(CMPT) = -MSEGLO(E1)
6450 ibuf(cmpt) = -k2 !3
6451 cmpt=cmpt+1
6452 ibuf(cmpt) = ledge(2,i) !4
6453C IBUF(CMPT) = LEDGE(4,I)
6454 cmpt=cmpt+1
6455 ibuf(cmpt) = nodlocal(ledge(5,i)) !5
6456 cmpt=cmpt+1
6457 ibuf(cmpt) = nodlocal(ledge(6,i)) !6
6458 cmpt=cmpt+1
6459 ibuf(cmpt) = ledge(7,i) !7
6460 cmpt=cmpt+1
6461 ibuf(cmpt) = i !8
6462 cmpt=cmpt+1
6463 ibuf(cmpt) = 0 !9
6464C orientation segment 1
6465 cmpt=cmpt+1
6466 ias=ledge(3,i) ! segments have been switched
6467 jas=ledge(4,i) ! The first one is 3-4
6468 n1=ledge(5,i)
6469 n2=ledge(6,i)
6470 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6471 is= 1
6472 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6473 is=-1
6474 ELSE
6475 assert(.false.)
6476 ENDIF
6477 ibuf(cmpt) = is !10
6478 IF(is==1)THEN
6479 i1=admsr(jas,ias)
6480 i2=admsr(mod(jas,4)+1,ias)
6481 ELSE ! IM(I)==-1
6482 i2=admsr(jas,ias)
6483 i1=admsr(mod(jas,4)+1,ias)
6484 END IF
6485 cmpt = cmpt +1
6486 ibuf(cmpt) = tag_sm(i1)!11
6487 cmpt = cmpt +1
6488 ibuf(cmpt) = tag_sm(i2) !12
6489 assert(tag_sm(i1) > 0)
6490 assert(tag_sm(i2) > 0)
6491
6492C orientation segment 2
6493 cmpt=cmpt+1
6494 ias=ledge(1,i) ! segments have been switched
6495 jas=ledge(2,i) ! the second one is 1-2
6496 IF(irectm(jas,ias)==n1.AND.irectm(mod(jas,4)+1,ias)==n2)THEN
6497 is= 1
6498 ELSEIF(irectm(jas,ias)==n2.AND.irectm(mod(jas,4)+1,ias)==n1)THEN
6499 is=-1
6500 ELSE
6501 assert(.false.)
6502 ENDIF
6503 ibuf(cmpt) = is ! 13
6504 IF(is==1)THEN
6505 i1=admsr(jas,ias)
6506 i2=admsr(mod(jas,4)+1,ias)
6507 ELSE ! IM(I)==-1
6508 i2=admsr(jas,ias)
6509 i1=admsr(mod(jas,4)+1,ias)
6510 END IF
6511 cmpt = cmpt +1
6512 ibuf(cmpt) = tag_sm(i1) !14
6513 cmpt = cmpt +1
6514 ibuf(cmpt) = tag_sm(i2) !15
6515 assert(tag_sm(i1) > 0)
6516 assert(tag_sm(i2) > 0)
6517
6518 ENDIF
6519 ENDDO
6520
6521
6522C WRITE(6,*) __FILE__,"NEDGE_L",NEDGE_L
6523C WRITE(6,*) "NB_FREE_EDGES=",NB_FREE_EDGES
6524C WRITE(6,*) "NB_INTERNAL_EDGES=",NB_INTERNAL_EDGES
6525C WRITE(6,*) "NB_BOUNDARY_EDGES_LOCAL=",NB_BOUNDARY_EDGES_LOCAL
6526C WRITE(6,*) "NB_BOUNDARY_EDGES_REMOTE=",NB_BOUNDARY_EDGES_REMOTE
6527
6528
6529
6530 i = nb_free_edges+nb_internal_edges+nb_boundary_edges_local + nb_boundary_edges_remote
6531 assert(nedge_l == i)
6532
6533 CALL write_i_c(ibuf,nledge*nedge_l)
6534 DEALLOCATE(ibuf)
6535
6536 RETURN
6537 END
6538
6539!||====================================================================
6540!|| split_cand_i25 ../starter/source/restart/ddsplit/inter_tools.F
6541!||--- called by ------------------------------------------------------
6542!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
6543!||--- calls -----------------------------------------------------
6544!|| ancmsg ../starter/source/output/message/message.F
6545!|| nlocal ../starter/source/spmd/node/ddtools.F
6546!|| plist_ifront ../starter/source/spmd/node/ddtools.F
6547!||--- uses -----------------------------------------------------
6548!|| message_mod ../starter/share/message_module/message_mod.F
6549!||====================================================================
6550 SUBROUTINE split_cand_i25(PROC , INTBUF_TAB, NSN , NSN_L ,
6551 . TAG_SEGM2, II_STOK , MULTIMP, NCONT ,
6552 . NOINT , INACTI , TAG_SCRATCH ,II_STOK_L,
6553 . NINDX_SCRT,INDX_SCRT)
6554C-----------------------------------------------
6555C M o d u l e s
6556C-----------------------------------------------
6557 USE message_mod
6558 USE intbufdef_mod
6559C-----------------------------------------------
6560C I m p l i c i t T y p e s
6561C-----------------------------------------------
6562#include "implicit_f.inc"
6563C-----------------------------------------------
6564C C o m m o n B l o c k s
6565C-----------------------------------------------
6566#include "com01_c.inc"
6567#include "com04_c.inc"
6568C-----------------------------------------------
6569C D u m m y A r g u m e n t s
6570C-----------------------------------------------
6571 INTEGER PROC,NSN,NSN_L,II_STOK,MULTIMP,NCONT,
6572 . tag_segm2(*),noint,inacti,
6573 . tag_scratch(*) , ii_stok_l, ityp
6574 INTEGER, INTENT(INOUT) :: NINDX_SCRT
6575 INTEGER, DIMENSION(*), INTENT(INOUT) :: INDX_SCRT
6576
6577 TYPE(intbuf_struct_) :: INTBUF_TAB
6578C-----------------------------------------------
6579C F u n c t i o n
6580C-----------------------------------------------
6581 INTEGER NLOCAL
6582 EXTERNAL nlocal
6583C-----------------------------------------------
6584C L o c a l V a r i a b l e s
6585C-----------------------------------------------
6586 INTEGER I,J,K,N,P,E,MULTOK,MSGID,
6587 . splist,c_nsnr
6588 INTEGER NUMP(NSPMD),WORK(70000)
6589
6590 INTEGER, DIMENSION(:),ALLOCATABLE ::
6591 . ibuf_e,ibuf_n,nsnlocal,cpulocal,candr,plist,
6592 . index
6593
6594 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ITRI
6595C ----------------------------------------
6596C w to be done :modif w/ edge
6597C ----------------------------------------
6598 ALLOCATE(ibuf_e(multimp*ncont),ibuf_n(multimp*ncont))
6599 ibuf_e(1:multimp*ncont) = 0
6600 ibuf_n(1:multimp*ncont) = 0
6601 ii_stok_l = 0 !mandatory in case of inacti ne 5,6,7
6602
6603 IF(nsn>0) THEN
6604 ALLOCATE(nsnlocal(nsn))
6605 ALLOCATE(cpulocal(nsn))
6606 ALLOCATE(candr(nsn))
6607 END IF
6608
6609 nump(1:nspmd) = 0
6610
6611 ALLOCATE(plist(nspmd))
6612 plist(1:nspmd) = -1
6613 DO k=1,nsn
6614 n = intbuf_tab%NSV(k)
6615 nsnlocal(k) = 0
6616 IF(tag_scratch(n)==0) THEN
6617 splist=0
6618 CALL plist_ifront(plist,n,splist)
6619 DO i=1,splist
6620 p=plist(i)
6621 nump(p) = nump(p)+1
6622 ENDDO
6623 IF(nlocal(n,proc+1)==1) THEN
6624 nsnlocal(k) = nump(proc+1)
6625 cpulocal(k) = proc+1
6626 ELSE
6627 p = plist(1)
6628 nsnlocal(k) = nump(p)
6629 cpulocal(k) = p
6630 ENDIF
6631 tag_scratch(n) = 1
6632 nindx_scrt = nindx_scrt + 1
6633 indx_scrt(nindx_scrt) = n
6634 ENDIF
6635 ENDDO
6636 DEALLOCATE(plist)
6637
6638 !reflush TAG_SCRATCH to zero only when value has changes
6639#include "vectorize.inc"
6640 DO k=1,nindx_scrt
6641 n = indx_scrt(k)
6642 tag_scratch(n) = 0
6643 ENDDO
6644 nindx_scrt = 0
6645C
6646C Locating candidates on remote processors
6647C
6648 c_nsnr = 0
6649
6650 DO k = 1, ii_stok
6651 e = intbuf_tab%CAND_E(k)
6652 IF (tag_segm2(e)/=0) THEN
6653 n = intbuf_tab%CAND_N(k)
6654 IF (intbuf_tab%NSV(n)> numnod) cycle
6655 IF(tag_scratch(n)==0) THEN
6656 tag_scratch(n) = 1
6657 nindx_scrt = nindx_scrt + 1
6658 indx_scrt(nindx_scrt) = n
6659 IF(nlocal(intbuf_tab%NSV(n),proc+1)/=1)THEN
6660 c_nsnr = c_nsnr + 1
6661 candr(c_nsnr) = n
6662 END IF
6663 END IF
6664 ENDIF
6665 ENDDO
6666
6667 !reflush TAG_SCRATCH to zero only when value has changes
6668#include "vectorize.inc"
6669 DO k=1,nindx_scrt
6670 n = indx_scrt(k)
6671 tag_scratch(n) = 0
6672 ENDDO
6673 nindx_scrt = 0
6674C
6675C Sorting remote candidates by proc and by ascending local nsv
6676C
6677C IF(C_NSNR>0) THEN
6678 ALLOCATE(index(2*c_nsnr))
6679 ALLOCATE(itri(2,c_nsnr))
6680C END IF
6681 DO i = 1, c_nsnr
6682 n = candr(i)
6683 itri(1,i) = cpulocal(n)
6684 itri(2,i) = nsnlocal(n)
6685 ENDDO
6686 CALL my_orders(0,work,itri,index,c_nsnr,2)
6687C
6688 DO i = 1, c_nsnr
6689 index(c_nsnr+index(i)) = i
6690 ENDDO
6691 DO i = 1, c_nsnr
6692 index(i)=index(c_nsnr+i)
6693 ENDDO
6694C
6695 ii_stok_l = 0
6696
6697 c_nsnr = 0
6698 DO k = 1, ii_stok
6699 e = intbuf_tab%CAND_E(k)
6700 IF (tag_segm2(e)/=0) THEN
6701 ii_stok_l = ii_stok_l + 1
6702 END IF
6703 END DO
6704
6705 IF(ii_stok_l>multimp*ncont)THEN
6706 multok= ii_stok_l/ncont
6707 CALL ancmsg(msgid=626,
6708 . msgtype=msgerror,
6709 . anmode=aninfo,
6710 . i1=multok,
6711 . i2=noint)
6712 ELSE
6713 ii_stok_l = 0
6714C
6715 DO k = 1, ii_stok
6716 e = intbuf_tab%CAND_E(k)
6717 IF (tag_segm2(e)/=0) THEN
6718 n = intbuf_tab%CAND_N(k)
6719 ii_stok_l = ii_stok_l + 1
6720 ibuf_e(ii_stok_l)=tag_segm2(e)
6721 IF (intbuf_tab%NSV(n)>numnod) THEN
6722 ibuf_n(ii_stok_l)=n
6723 ELSEIF(nlocal(intbuf_tab%NSV(n),proc+1)==1) THEN
6724 ibuf_n(ii_stok_l)=nsnlocal(n)
6725 ELSE
6726C remote node : numbering pre-calculated above
6727c IF(TAG(N)==0) THEN
6728 IF(tag_scratch(n)==0) THEN
6729 c_nsnr = c_nsnr + 1
6730 ibuf_n(ii_stok_l)=index(c_nsnr)+nsn_l
6731 tag_scratch(n) = index(c_nsnr)+nsn_l
6732 nindx_scrt = nindx_scrt + 1
6733 indx_scrt(nindx_scrt) = n
6734 ELSE
6735 ibuf_n(ii_stok_l) = tag_scratch(n)
6736 END IF ! TAG(N)==0
6737 END IF ! NLOCAL(INTBUF_TAB%NSV(N),PROC+1)==1
6738 ENDIF !TAG_SEGM_2(E)/=0
6739 ENDDO !K = 1, II_STOK
6740 END IF !ii_stok_l>multimp*ncont
6741
6742 !reflush TAG_SCRATCH to zero only when value has changes
6743 DO k=1, ii_stok
6744 e = intbuf_tab%CAND_E(k)
6745 IF (tag_segm2(e)/=0) THEN
6746 n = intbuf_tab%CAND_N(k)
6747 IF (intbuf_tab%NSV(n)<= numnod) tag_scratch(n) = 0
6748 ENDIF
6749 ENDDO
6750
6751 IF(nsn>0) DEALLOCATE(nsnlocal,cpulocal,candr)
6752 DEALLOCATE(index,itri)
6753
6754
6755 CALL write_i_c(ibuf_e,multimp*ncont)
6756 CALL write_i_c(ibuf_n,multimp*ncont)
6757
6758 DEALLOCATE(ibuf_e,ibuf_n)
6759
6760 RETURN
6761 END
6762
6763!||====================================================================
6764!|| split_adskyn_25 ../starter/source/restart/ddsplit/inter_tools.F
6765!||--- called by ------------------------------------------------------
6766!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
6767!||--- calls -----------------------------------------------------
6768!||--- uses -----------------------------------------------------
6769!|| front_mod ../starter/share/modules1/front_mod.F
6770!||====================================================================
6771 SUBROUTINE split_adskyn_25(ADSKYN,IADNOR,NADMSR,ADMSR,NADMSR_L,
6772 . NRTM_L,TAG_SEGM,TAG_SM,INTERCEP)
6773c
6774c build & write skyline matrix for normals assembling
6775c
6776C-----------------------------------------------
6777C M o d u l e s
6778C-----------------------------------------------
6779 USE intbufdef_mod
6780 USE front_mod
6781C-----------------------------------------------
6782C I m p l i c i t T y p e s
6783C-----------------------------------------------
6784#include "implicit_f.inc"
6785C-----------------------------------------------
6786C D u m m y A r g u m e n t s
6787C-----------------------------------------------
6788 INTEGER ADSKYN(NADMSR+1),IADNOR(4,*),NADMSR,NADMSR_L,NRTM_L,
6789 . ADMSR(4,*), TAG_SEGM(*),TAG_SM(*)
6790 TYPE(intersurfp) :: INTERCEP
6791C-----------------------------------------------
6792C L o c a l V a r i a b l e s
6793C-----------------------------------------------
6794 INTEGER I,J,K,IS,ISL
6795 INTEGER, DIMENSION(:),ALLOCATABLE :: ADSKYN_L,IADNOR_L, TAG_MS
6796C ----------------------------------------
6797 ALLOCATE(adskyn_l(nadmsr_l+1),iadnor_l(4*nrtm_l),tag_ms(nadmsr_l))
6798
6799 tag_ms(1:nadmsr_l)=0
6800 DO i=1, nadmsr
6801 k=tag_sm(i)
6802 IF(k /= 0) tag_ms(k) = i
6803 END DO
6804
6805 adskyn_l(1)=1
6806 DO k=1, nadmsr_l
6807 i=tag_ms(k)
6808 adskyn_l(k+1)=adskyn_l(k)+adskyn(i+1)-adskyn(i)
6809 END DO
6810
6811 DO i=1, nrtm_l
6812 k=tag_segm(i)
6813 DO j=1,4
6814 is =admsr(j,k)
6815 isl=tag_sm(is)
6816 iadnor_l(4*(i-1)+j) = iadnor(j,k) - adskyn(is) + adskyn_l(isl)
6817 ENDDO
6818 ENDDO
6819
6820 CALL write_i_c(adskyn_l,nadmsr_l+1)
6821 CALL write_i_c(iadnor_l,4*nrtm_l)
6822
6823 DEALLOCATE(adskyn_l,iadnor_l,tag_ms)
6824
6825 RETURN
6826 END
6827!||====================================================================
6828!|| split_lbound_i25 ../starter/source/restart/ddsplit/inter_tools.F
6829!||--- called by ------------------------------------------------------
6830!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
6831!||--- calls -----------------------------------------------------
6832!||--- uses -----------------------------------------------------
6833!||====================================================================
6834 SUBROUTINE split_lbound_i25(NADMSR,NADMSR_L,LBOUND,TAG_SM)
6835c
6836C-----------------------------------------------
6837C M o d u l e s
6838C-----------------------------------------------
6839 USE intbufdef_mod
6840C-----------------------------------------------
6841C I m p l i c i t T y p e s
6842C-----------------------------------------------
6843#include "implicit_f.inc"
6844C-----------------------------------------------
6845C D u m m y A r g u m e n t s
6846C-----------------------------------------------
6847 INTEGER NADMSR,NADMSR_L,LBOUND(*), TAG_SM(*)
6848C-----------------------------------------------
6849C L o c a l V a r i a b l e s
6850C-----------------------------------------------
6851 INTEGER I,K
6852 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF, TAG_MS
6853C ----------------------------------------
6854 ALLOCATE(tag_ms(nadmsr_l))
6855
6856 tag_ms(1:nadmsr_l)=0
6857 DO i=1, nadmsr
6858 k=tag_sm(i)
6859 IF(k /= 0) tag_ms(k) = i
6860 END DO
6861C ----------------------------------------
6862 ALLOCATE(ibuf(nadmsr_l))
6863
6864 DO i=1, nadmsr_l
6865 k=tag_ms(i)
6866 IF(k/=0) THEN
6867 ibuf(i) = lbound(k)
6868 END IF
6869 ENDDO
6870
6871 CALL write_i_c(ibuf,nadmsr_l)
6872 DEALLOCATE(ibuf)
6873
6874 RETURN
6875 END
6876C=======================================================================
6877C END SPECIFIC ROUTINES INT25
6878C=======================================================================
6879!||====================================================================
6880!|| split_isegpt_ival ../starter/source/restart/ddsplit/inter_tools.F
6881!||--- called by ------------------------------------------------------
6882!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
6883!||--- calls -----------------------------------------------------
6884!||--- uses -----------------------------------------------------
6885!||====================================================================
6886 SUBROUTINE split_isegpt_ival(ISEGPT,NSN_L,DIM2,TAG_NODE_2RY,NI,TAG_2RY_INV,PROC)
6887c
6888c split & write node array (type INTEGER) with global value
6889c (see SPLIT_NODE_NODLOC for local values)
6890c
6891C-----------------------------------------------
6892C M o d u l e s
6893C-----------------------------------------------
6894 USE intbufdef_mod
6895C-----------------------------------------------
6896C I m p l i c i t T y p e s
6897C-----------------------------------------------
6898#include "implicit_f.inc"
6899C-----------------------------------------------
6900C D u m m y A r g u m e n t s
6901C-----------------------------------------------
6902 INTEGER ISEGPT(*),TAG_NODE_2RY(*),NSN_L,DIM2,NI,PROC,
6903 * TAG_2RY_INV(*)
6904C-----------------------------------------------
6905C L o c a l V a r i a b l e s
6906C-----------------------------------------------
6907 INTEGER I,J,K,SN,FICT_SN
6908 INTEGER, DIMENSION(:),ALLOCATABLE :: IBUF
6909C ----------------------------------------
6910 ALLOCATE(ibuf(nsn_l))
6911
6912 DO i=1, nsn_l
6913 k=tag_node_2ry(i)
6914 DO j=1,dim2
6915 ibuf(i) = 0
6916 IF(isegpt(k)==k)THEN
6917 ibuf(i) = i
6918 ELSEIF(-isegpt(k)==k)THEN
6919 ibuf(i) = -i
6920 ELSE
6921 sn = isegpt(k)
6922 IF(sn==0)THEN
6923 ibuf(i) = sn
6924 ELSE
6925 fict_sn = tag_2ry_inv(sn)
6926 ibuf(i) = fict_sn
6927 ENDIF
6928 ENDIF
6929
6930 ENDDO
6931 ENDDO
6932
6933 CALL write_i_c(ibuf,nsn_l*dim2)
6934
6935 DEALLOCATE(ibuf)
6936
6937 RETURN
6938 END
6939!||====================================================================
6940!|| split_remnode_i24 ../starter/source/restart/ddsplit/inter_tools.F
6941!||--- called by ------------------------------------------------------
6942!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
6943!||--- calls -----------------------------------------------------
6944!|| nlocal ../starter/source/spmd/node/ddtools.F
6945!||--- uses -----------------------------------------------------
6946!|| front_mod ../starter/share/modules1/front_mod.F
6947!|| message_mod ../starter/share/message_module/message_mod.F
6948!||====================================================================
6949 SUBROUTINE split_remnode_i24(PROC , INTBUF_TAB, NRTM , NRTM_L,
6950 . TAG_SEGM2, NREMNODE , NODLOCAL, ITAB ,
6951 . IS2ID ,INTERCEP2 ,NSNE ,NODLOCAL24)
6952C-----------------------------------------------
6953C M o d u l e s
6954C-----------------------------------------------
6955 USE message_mod
6956 USE intbufdef_mod
6957 USE front_mod
6958C-----------------------------------------------
6959C I m p l i c i t T y p e s
6960C-----------------------------------------------
6961#include "implicit_f.inc"
6962C-----------------------------------------------
6963C C o m m o n B l o c k s
6964C-----------------------------------------------
6965#include "com04_c.inc"
6966C-----------------------------------------------
6967C D u m m y A r g u m e n t s
6968C-----------------------------------------------
6969 INTEGER PROC,NRTM,NRTM_L,
6970 . tag_segm2(*),nremnode,nodlocal(*),
6971 . itab(*),is2id(*),nsne,nodlocal24(*)
6972 INTEGER, DIMENSION(:),ALLOCATABLE ::
6973 . siz_tmp
6974
6975 TYPE(intbuf_struct_) :: INTBUF_TAB
6976 TYPE(intersurfp) :: INTERCEP2
6977C-----------------------------------------------
6978C F u n c t i o n
6979C-----------------------------------------------
6980 INTEGER NLOCAL
6981 EXTERNAL nlocal
6982C-----------------------------------------------
6983C L o c a l V a r i a b l e s
6984C-----------------------------------------------
6985 INTEGER I,J,K,SIZ,L,SIZ1,SIZ2,M,N,SE1,NS,NUMNODT
6986
6987 INTEGER, DIMENSION(:),ALLOCATABLE ::
6988 . ibuf1,ibuf2,noddel,noddelremote
6989C ----------------------------------------
6990 ALLOCATE(siz_tmp(nrtm),noddel(numnod+nsne),
6991 . noddelremote(numnod+nsne))
6992
6993 ALLOCATE(ibuf1(2*(nrtm_l + 1)), ibuf2(nremnode))
6994 ibuf1(1:2*(nrtm_l+1)) = 0
6995 ibuf2(1:nremnode) = 0
6996
6997 siz_tmp(1:nrtm) = 0
6998
6999 DO k=1,nrtm
7000 IF(tag_segm2(k) /= 0)THEN
7001 siz_tmp(tag_segm2(k)) = intbuf_tab%KREMNODE(k+1)
7002 . -intbuf_tab%KREMNODE(k)
7003 ENDIF
7004 END DO
7005
7006 ibuf1(1) = 0
7007 numnodt = numnod + nsne
7008 noddel(1:numnodt) = 0
7009 noddelremote(1:numnodt) = 0
7010 siz1 = 0
7011 siz2 = 0
7012 DO k=1,nrtm
7013 IF(tag_segm2(k) /= 0)THEN
7014
7015 siz = siz_tmp(tag_segm2(k))
7016 ibuf1(1+2*tag_segm2(k)) =ibuf1(1+2*(tag_segm2(k)-1)) + siz
7017 l=intbuf_tab%KREMNODE(k)
7018 siz1 = 0
7019 siz2 = 0
7020c--------add if N<=NUMNOD else nodlocal_fictive
7021 DO m=1,siz
7022 n = intbuf_tab%REMNODE(l+m)
7023 IF (n>numnod) THEN
7024 ns = n-numnod
7025 se1 = intbuf_tab%IS2SE(2*(ns-1)+1)
7026 IF (intercep2%P(se1)==proc+1)THEN
7027 noddel(siz1+1) = nodlocal24(n)
7028 siz1 = siz1+1
7029 ENDIF
7030 ELSE
7031 IF(nlocal(n,proc+1)==1) THEN
7032 noddel(siz1+1) = nodlocal(n)
7033 siz1 = siz1+1
7034 ENDIF
7035 END IF
7036 ENDDO
7037c--------add if N<=NUMNOD else IS2ID(N-NUMNOD)
7038 DO m=1,siz
7039 n = intbuf_tab%REMNODE(l+m)
7040 IF (n>numnod) THEN
7041 ns = n-numnod
7042 se1 = intbuf_tab%IS2SE(2*(ns-1)+1)
7043 IF (intercep2%P(se1)/=proc+1)THEN
7044 noddelremote(siz2+1) = is2id(ns)
7045 siz2 = siz2+1
7046 ENDIF
7047 ELSE
7048 IF(nlocal(n,proc+1)/=1) THEN
7049 noddelremote(siz2+1) = itab(n)
7050 siz2 = siz2+1
7051 ENDIF
7052 END IF
7053 ENDDO
7054c
7055 l=ibuf1(1+2*(tag_segm2(k)-1))
7056 DO m=1,siz1
7057 ibuf2(1+l+m-1)= noddel(m)
7058 ENDDO
7059c
7060 ibuf1(1+2*(tag_segm2(k)-1)+1) = l + siz1
7061 l=ibuf1(1+2*(tag_segm2(k)-1)+1)
7062 DO m=1,siz2
7063 ibuf2(1+l+m-1) = - noddelremote(m)
7064 ENDDO
7065 ENDIF
7066 DO m=1,siz1
7067 noddel(m) = 0
7068 ENDDO
7069 DO m=1,siz2
7070 noddelremote(m) = 0
7071 ENDDO
7072 ENDDO
7073c print *,'NREMNODE,SIZ1,SIZ2=',NREMNODE,SIZ1,SIZ2
7074
7075 DEALLOCATE(siz_tmp,noddel,noddelremote)
7076
7077 CALL write_i_c(ibuf1,2*(nrtm_l + 1))
7078 CALL write_i_c(ibuf2,nremnode)
7079
7080 DEALLOCATE(ibuf1, ibuf2)
7081
7082 RETURN
7083 END
7084
7085!||====================================================================
7086!|| split_remnode_i11 ../starter/source/restart/ddsplit/inter_tools.F
7087!||--- called by ------------------------------------------------------
7088!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
7089!||--- calls -----------------------------------------------------
7090!||--- uses -----------------------------------------------------
7091!|| message_mod ../starter/share/message_module/message_mod.f
7092!||====================================================================
7093 SUBROUTINE split_remnode_i11(PROC , INTBUF_TAB, NRTM , NRTM_L,
7094 . TAG_SEGM2, NODLOCAL, ITAB ,NUMNOD_L, TAG_SEGS2,
7095 . NREMNODE_L)
7096C-----------------------------------------------
7097C M o d u l e s
7098C-----------------------------------------------
7099 USE message_mod
7100 USE intbufdef_mod
7101C-----------------------------------------------
7102C I m p l i c i t T y p e s
7103C-----------------------------------------------
7104#include "implicit_f.inc"
7105C-----------------------------------------------
7106C D u m m y A r g u m e n t s
7107C-----------------------------------------------
7108 INTEGER PROC,NRTM,NRTM_L,
7109 . tag_segm2(*),nremnode,nodlocal(*),
7110 . itab(*),tag_segs2(*)
7111 INTEGER, INTENT(IN) :: NUMNOD_L,NREMNODE_L
7112
7113 TYPE(intbuf_struct_) :: INTBUF_TAB
7114C-----------------------------------------------
7115C F u n c t i o n
7116C-----------------------------------------------
7117! INTEGER NLOCAL
7118! EXTERNAL NLOCAL
7119C-----------------------------------------------
7120C L o c a l V a r i a b l e s
7121C-----------------------------------------------
7122 INTEGER I,J,K,SIZ,
7123 . l,siz1,siz2,m,n,cpt_l,index1
7124
7125 INTEGER, DIMENSION(:),ALLOCATABLE ::
7126 . ibuf1,ibuf2
7127C ----------------------------------------
7128C
7129C
7130 ALLOCATE(ibuf1(2*(nrtm_l + 1)), ibuf2(nremnode_l))
7131 ibuf1(1:2*(nrtm_l+1)) = 0
7132 ibuf2(1:nremnode_l) = 0
7133C
7134C--- Split of KERMNODE -> IBUF1
7135 index1 = 1
7136 cpt_l = 0
7137 DO k=1,nrtm
7138 IF(tag_segm2(k) /= 0)THEN
7139 siz = intbuf_tab%KREMNODE(k+1)-intbuf_tab%KREMNODE(k)
7140 l=intbuf_tab%KREMNODE(k)
7141 siz1 = 0
7142 siz2 = 0
7143 DO m=1,siz
7144 n = intbuf_tab%REMNODE(l+m-1)
7145 IF (tag_segs2(n)/=0) THEN
7146C-- Local segment - local id is stored
7147 siz1 = siz1 + 1
7148 ELSE
7149C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
7150 siz2 = siz2 + 2
7151 ENDIF
7152 END DO
7153 cpt_l = cpt_l + 1
7154 ibuf1(2*(cpt_l-1)+1) = index1
7155 ibuf1(2*(cpt_l-1)+2) = index1 + siz1
7156 index1 = index1 + siz1 + siz2
7157 ENDIF
7158 END DO
7159 ibuf1(2*nrtm_l+1) = index1
7160 ibuf1(2*nrtm_l+2) = index1
7161C
7162C--- Split of ERMNODE -> IBUF2
7163 cpt_l = 0
7164 DO k=1,nrtm
7165 IF(tag_segm2(k) /= 0)THEN
7166C
7167 cpt_l = cpt_l + 1
7168 l=intbuf_tab%KREMNODE(k)
7169 siz = intbuf_tab%KREMNODE(k+1)-intbuf_tab%KREMNODE(k)
7170 siz1 = ibuf1(2*(cpt_l-1)+1)
7171 siz2 = ibuf1(2*(cpt_l-1)+2)
7172C
7173 DO m=1,siz
7174 n = intbuf_tab%REMNODE(l+m-1)
7175 IF (tag_segs2(n)/=0) THEN
7176C-- Local segment - local id is stored
7177 ibuf2(siz1) = tag_segs2(n)
7178 siz1 = siz1+1
7179 ELSE
7180C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
7181 ibuf2(siz2) = itab(intbuf_tab%IRECTS(2*(n-1)+1))
7182 ibuf2(siz2+1) = itab(intbuf_tab%IRECTS(2*(n-1)+2))
7183 siz2 = siz2+2
7184 ENDIF
7185 ENDDO
7186C
7187 ENDIF
7188 ENDDO
7189C
7190 CALL write_i_c(ibuf1,2*(nrtm_l + 1))
7191 CALL write_i_c(ibuf2,nremnode_l)
7192C
7193 DEALLOCATE(ibuf1, ibuf2)
7194C
7195 RETURN
7196 END
7197
7198!||====================================================================
7199!|| split_remnode_i25_edge ../starter/source/restart/ddsplit/inter_tools.F
7200!||--- called by ------------------------------------------------------
7201!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
7202!||--- calls -----------------------------------------------------
7203!||--- uses -----------------------------------------------------
7204!|| message_mod ../starter/share/message_module/message_mod.F
7205!||====================================================================
7206 SUBROUTINE split_remnode_i25_edge(PROC , INTBUF_TAB, NEDGE , NEDGE_L,
7207 . TAG_EDGE , TAG_EDGE2 , SEGLOC ,ITAB ,
7208 . NUMNOD_L , NREMNODE_EDG_L)
7209C-----------------------------------------------
7210C M o d u l e s
7211C-----------------------------------------------
7212 USE message_mod
7213 USE intbufdef_mod
7214C-----------------------------------------------
7215C I m p l i c i t T y p e s
7216C-----------------------------------------------
7217#include "implicit_f.inc"
7218C-----------------------------------------------
7219C C o m m o n B l o c k s
7220C-----------------------------------------------
7221#include "param_c.inc"
7222C-----------------------------------------------
7223C D u m m y A r g u m e n t s
7224C-----------------------------------------------
7225 INTEGER PROC,NEDGE,NEDGE_L,
7226 . tag_edge2(*),tag_edge(*),segloc(*),
7227 . itab(*)
7228 INTEGER, INTENT(IN) :: NUMNOD_L,NREMNODE_EDG_L
7229
7230 TYPE(intbuf_struct_) :: INTBUF_TAB
7231C-----------------------------------------------
7232C F u n c t i o n
7233C-----------------------------------------------
7234! INTEGER NLOCAL
7235! EXTERNAL NLOCAL
7236C-----------------------------------------------
7237C L o c a l V a r i a b l e s
7238C-----------------------------------------------
7239 INTEGER I,J,K,SIZ,
7240 . l,siz1,siz2,m,n,cpt_l,index1,ik,
7241 . km1,em1,km2,em2,ks1,es1,ks2,es2
7242
7243 INTEGER, DIMENSION(:),ALLOCATABLE ::
7244 . IBUF1,IBUF2
7245C ----------------------------------------
7246C
7247C
7248 ALLOCATE(ibuf1(2*(nedge_l + 1)), ibuf2(nremnode_edg_l))
7249 ibuf1(1:2*(nedge_l+1)) = 0
7250 ibuf2(1:nremnode_edg_l) = 0
7251C
7252C--- Split of KERMNODE -> IBUF1
7253
7254 index1 = 1
7255 cpt_l = 0
7256 DO ik=1,nedge_l
7257 k = tag_edge(ik)
7258 em1=intbuf_tab%LEDGE(1+(k-1)*nledge)
7259 km1=0
7260 IF(em1/=.0) km1=segloc(em1)
7261 em2=intbuf_tab%LEDGE(3+(k-1)*nledge)
7262 km2=0
7263 IF(em2/=0) km2=segloc(em2)
7264 IF(km1 /= 0.OR.km2/=0)THEN
7265 siz = intbuf_tab%KREMNODE_EDG(k+1)-intbuf_tab%KREMNODE_EDG(k)
7266 l=intbuf_tab%KREMNODE_EDG(k)
7267 siz1 = 0
7268 siz2 = 0
7269 DO m=1,siz
7270 n = intbuf_tab%REMNODE_EDG(l+m-1)
7271 es1=intbuf_tab%LEDGE(1+(n-1)*nledge)
7272 ks1=0
7273 IF(es1/=0) ks1=segloc(es1)
7274 es2=intbuf_tab%LEDGE(3+(n-1)*nledge)
7275 ks2 = 0
7276 IF(es2/=0) ks2=segloc(es2)
7277 IF (km1 /= 0.AND.km2/=0.AND.ks1/=0.AND.ks2/=0) THEN
7278C-- Local segment - local id is stored
7279 siz1 = siz1 + 1
7280 ELSE
7281C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
7282 siz2 = siz2 + 2
7283 ENDIF
7284 END DO
7285 cpt_l = cpt_l + 1
7286 ibuf1(2*(cpt_l-1)+1) = index1
7287 ibuf1(2*(cpt_l-1)+2) = index1 + siz1
7288 index1 = index1 + siz1 + siz2
7289 ENDIF
7290 END DO
7291 ibuf1(2*nedge_l+1) = index1
7292 ibuf1(2*nedge_l+2) = index1
7293
7294C
7295C--- Split of ERMNODE -> IBUF2
7296 cpt_l = 0
7297 DO ik=1,nedge_l
7298 k = tag_edge(ik)
7299 em1=intbuf_tab%LEDGE(1+(k-1)*nledge)
7300 km1=0
7301 IF(em1/=0) km1=segloc(em1)
7302 em2=intbuf_tab%LEDGE(3+(k-1)*nledge)
7303 km2=0
7304 IF(em2/=0) km2=segloc(em2)
7305 IF(km1 /= 0.OR.km2/=0)THEN
7306C
7307 cpt_l = cpt_l + 1
7308 l=intbuf_tab%KREMNODE_EDG(k)
7309 siz = intbuf_tab%KREMNODE_EDG(k+1)-intbuf_tab%KREMNODE_EDG(k)
7310 siz1 = ibuf1(2*(cpt_l-1)+1)
7311 siz2 = ibuf1(2*(cpt_l-1)+2)
7312C
7313 DO m=1,siz
7314 n = intbuf_tab%REMNODE_EDG(l+m-1)
7315 ks1=0
7316 es1=intbuf_tab%LEDGE(1+(n-1)*nledge)
7317 IF(es1/=0) ks1=segloc(es1)
7318 es2=intbuf_tab%LEDGE(3+(n-1)*nledge)
7319 ks2 = 0
7320 IF(es2/=0) ks2=segloc(es2)
7321 IF (km1 /= 0.AND.km2/=0.AND.ks1/=0.AND.ks2/=0) THEN
7322C-- Local segment - local id is stored
7323 ibuf2(siz1) = tag_edge2(n)
7324 siz1 = siz1+1
7325 ELSE
7326C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
7327 ibuf2(siz2) = itab(intbuf_tab%LEDGE(5+(n-1)*nledge))
7328 ibuf2(siz2+1) = itab(intbuf_tab%LEDGE(6+(n-1)*nledge))
7329 siz2 = siz2+2
7330 ENDIF
7331 ENDDO
7332C
7333 ENDIF
7334 ENDDO
7335C
7336 CALL write_i_c(ibuf1,2*(nedge_l + 1))
7337 CALL write_i_c(ibuf2,nremnode_edg_l)
7338C
7339 DEALLOCATE(ibuf1, ibuf2)
7340C
7341 RETURN
7342 END
7343
7344!||====================================================================
7345!|| split_remnode_i25_e2s ../starter/source/restart/ddsplit/inter_tools.F
7346!||--- called by ------------------------------------------------------
7347!|| split_interfaces ../starter/source/restart/ddsplit/split_interfaces.F
7348!||--- calls -----------------------------------------------------
7349!||--- uses -----------------------------------------------------
7350!|| message_mod ../starter/share/message_module/message_mod.F
7351!||====================================================================
7352 SUBROUTINE split_remnode_i25_e2s(PROC , INTBUF_TAB, NRTM , NRTM_L,
7353 . TAG_EDGE , TAG_EDGE2 , SEGLOC ,ITAB ,
7354 . NUMNOD_L , NREMNODE_E2S_L)
7355C-----------------------------------------------
7356C M o d u l e s
7357C-----------------------------------------------
7358 USE message_mod
7359 USE intbufdef_mod
7360C-----------------------------------------------
7361C I m p l i c i t T y p e s
7362C-----------------------------------------------
7363#include "implicit_f.inc"
7364C-----------------------------------------------
7365C C o m m o n B l o c k s
7366C-----------------------------------------------
7367#include "param_c.inc"
7368C-----------------------------------------------
7369C D u m m y A r g u m e n t s
7370C-----------------------------------------------
7371 INTEGER PROC,NRTM,NRTM_L,
7372 . TAG_EDGE2(*),TAG_EDGE(*),SEGLOC(*),
7373 . ITAB(*)
7374 INTEGER, INTENT(IN) :: NUMNOD_L,NREMNODE_E2S_L
7375
7376 TYPE(intbuf_struct_) :: INTBUF_TAB
7377C-----------------------------------------------
7378C F u n c t i o n
7379C-----------------------------------------------
7380! INTEGER NLOCAL
7381! EXTERNAL NLOCAL
7382C-----------------------------------------------
7383C L o c a l V a r i a b l e s
7384C-----------------------------------------------
7385 INTEGER I,J,K,SIZ,
7386 . l,siz1,siz2,m,n,cpt_l,index1,ik,
7387 . km1,em1,km2,em2,ks1,es1,ks2,es2
7388
7389 INTEGER, DIMENSION(:),ALLOCATABLE ::
7390 . ibuf1,ibuf2
7391C ----------------------------------------
7392C
7393C
7394 ALLOCATE(ibuf1(2*(nrtm_l + 1)), ibuf2(nremnode_e2s_l))
7395 ibuf1(1:2*(nrtm_l+1)) = 0
7396 ibuf2(1:nremnode_e2s_l) = 0
7397C
7398C--- Split of KERMNODE -> IBUF1
7399
7400 index1 = 1
7401 cpt_l = 0
7402 DO k=1,nrtm
7403 IF(segloc(k) > 0) THEN
7404 siz = intbuf_tab%KREMNODE_E2S(k+1)-intbuf_tab%KREMNODE_E2S(k)
7405 l=intbuf_tab%KREMNODE_E2S(k)
7406 siz1 = 0
7407 siz2 = 0
7408 DO m=1,siz
7409 n = intbuf_tab%REMNODE_E2S(l+m-1)
7410 es1=intbuf_tab%LEDGE(1+(n-1)*nledge)
7411 IF(segloc(es1) > 0) THEN
7412C-- Local segment - local id is stored
7413 siz1 = siz1 + 1
7414 ELSE
7415C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
7416 siz2 = siz2 + 2
7417 ENDIF
7418 END DO
7419 cpt_l = cpt_l + 1
7420 ibuf1(2*(cpt_l-1)+1) = index1
7421 ibuf1(2*(cpt_l-1)+2) = index1 + siz1
7422 index1 = index1 + siz1 + siz2
7423 ENDIF
7424 END DO
7425 ibuf1(2*nrtm_l+1) = index1
7426 ibuf1(2*nrtm_l+2) = index1
7427
7428C
7429C--- Split of REMNODE -> IBUF2
7430 cpt_l = 0
7431 DO k=1,nrtm
7432 IF(segloc(k) > 0) THEN
7433C
7434 cpt_l = cpt_l + 1
7435 l=intbuf_tab%KREMNODE_E2S(k)
7436 siz = intbuf_tab%KREMNODE_E2S(k+1)-intbuf_tab%KREMNODE_E2S(k)
7437 siz1 = ibuf1(2*(cpt_l-1)+1)
7438 siz2 = ibuf1(2*(cpt_l-1)+2)
7439C
7440 DO m=1,siz
7441 n = intbuf_tab%REMNODE_E2S(l+m-1)
7442 es1=intbuf_tab%LEDGE(1+(n-1)*nledge)
7443 IF(segloc(es1) > 0) THEN
7444C-- Local segment - local id is stored
7445 ibuf2(siz1) = tag_edge2(n)
7446 siz1 = siz1+1
7447 ELSE
7448C-- Remote segment - line is stored as ITAB1 / ITAB2 (2 values)
7449 ibuf2(siz2) = itab(intbuf_tab%LEDGE(5+(n-1)*nledge))
7450 ibuf2(siz2+1) = itab(intbuf_tab%LEDGE(6+(n-1)*nledge))
7451 siz2 = siz2+2
7452 ENDIF
7453 ENDDO
7454C
7455 ENDIF
7456 ENDDO
7457C
7458 CALL write_i_c(ibuf1,2*(nrtm_l + 1))
7459 CALL write_i_c(ibuf2,nremnode_e2s_l)
7460C
7461 DEALLOCATE(ibuf1, ibuf2)
7462C
7463 RETURN
7464 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, rwstif_pen, sln_pen)
Definition ddsplit.F:337
plist_ifront
subroutine plist_ifront(tab, n, cpt)
Definition ddtools.F:153
nlocal
integer function nlocal(n, p)
Definition ddtools.F:350
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:5420
split_nisub_i7
subroutine split_nisub_i7(intbuf_tab, nsn_l, tag_node_2ry, nrtm_l, tag_segm, nisubs, nisubm)
Definition inter_tools.F:2733
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:6952
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:6887
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:4856
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:3420
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:5837
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:5156
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:7209
split_seg_ival_i20
subroutine split_seg_ival_i20(tab, tab_nlg, dim1, dim2, tag, tag_nlg)
Definition inter_tools.F:4298
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:5904
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:3672
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:4256
split_cand_ival_i21
subroutine split_cand_ival_i21(tab, ii_stok_l, tag_ii, dim1, dim2)
Definition inter_tools.F:5002
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:5522
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:4338
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:7355
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:4375
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:5371
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:2557
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:3548
split_seg_edge
subroutine split_seg_edge(nsne_l, is2se, tag_nsne, tag_seg2, ni)
Definition inter_tools.F:5790
split_adskyn_25
subroutine split_adskyn_25(adskyn, iadnor, nadmsr, admsr, nadmsr_l, nrtm_l, tag_segm, tag_sm, intercep)
Definition inter_tools.F:6773
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:2832
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:3221
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:3863
split_lbound_i25
subroutine split_lbound_i25(nadmsr, nadmsr_l, lbound, tag_sm)
Definition inter_tools.F:6835
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:2978
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:3953
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:5089
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:4423
split_segedge_nodloc_i24
subroutine split_segedge_nodloc_i24(tab, dim1, tag_seg, nodlocal, ni)
Definition inter_tools.F:5466
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:6554
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:7096
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:4647
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:6102
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:5046
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
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
front_mod
Definition front_mod.F:84
groupdef_mod
Definition groupdef_mod.F:668
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:1257
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:895
nl
character *2 function nl()
Definition message.F:2360
arret
subroutine arret(nn)
Definition arret.F:86
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:142
write_i_c
void write_i_c(int *w, int *len)
Definition write_routines.c:645