OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_i7tool.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!|| spmd_oldnumcd ../engine/source/mpi/interfaces/spmd_i7tool.F
25!||--- called by ------------------------------------------------------
26!|| i10tri ../engine/source/interfaces/intsort/i10tri.f
27!|| i20tri ../engine/source/interfaces/intsort/i20tri.F
28!|| i23trivox ../engine/source/interfaces/intsort/i23trivox.F
29!|| i24trivox ../engine/source/interfaces/intsort/i24trivox.F
30!|| i7tri ../engine/source/interfaces/intsort/i7tri.F
31!|| i7trivox ../engine/source/interfaces/intsort/i7trivox.F
32!|| inter7_collision_detection ../engine/source/interfaces/intsort/inter7_collision_detection.F90
33!||--- uses -----------------------------------------------------
34!|| tri7box ../engine/share/modules/tri7box.F
35!||====================================================================
36 SUBROUTINE spmd_oldnumcd(RENUM,OLDNUM,NSNR,NSNROLD,
37 . INTHEAT,IDT_THERM,NODADT_THERM)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE tri7box
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER ,INTENT(IN) :: INTHEAT
50 INTEGER ,INTENT(IN) :: IDT_THERM
51 INTEGER ,INTENT(IN) :: NODADT_THERM
52 INTEGER :: NSNR, NSNROLD
53 INTEGER :: OLDNUM(*), RENUM(*)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER I
58C-----------------------------------------------
59C S o u r c e L i n e s
60C-----------------------------------------------
61C
62C old numbering of new candidates
63C
64 DO i = 1, nsnr
65 oldnum(i) = 0
66 END DO
67 DO i = 1, nsnrold
68 IF(renum(i)>0) ! case non-penetrated and non-retained element
69 + oldnum(renum(i)) = i
70 END DO
71C
72 RETURN
73 END
74C
75!||====================================================================
76!|| spmd_rnumcd20 ../engine/source/mpi/interfaces/spmd_i7tool.F
77!||--- called by ------------------------------------------------------
78!|| i20main_tri ../engine/source/interfaces/intsort/i20main_tri.F
79!||--- uses -----------------------------------------------------
80!|| tri7box ../engine/share/modules/tri7box.F
81!||====================================================================
82 SUBROUTINE spmd_rnumcd20(
83 1 CAND_N ,RENUM ,II_STOK,NIN,NSN,
84 2 NSNFIOLD,NSNROLD)
85C-----------------------------------------------
86C M o d u l e s
87C-----------------------------------------------
88 USE tri7box
89C-----------------------------------------------
90C I m p l i c i t T y p e s
91C-----------------------------------------------
92#include "implicit_f.inc"
93C-----------------------------------------------
94C C o m m o n B l o c k s
95C-----------------------------------------------
96#include "com01_c.inc"
97C-----------------------------------------------
98C D u m m y A r g u m e n t s
99C-----------------------------------------------
100 INTEGER CAND_N(*), NSNFIOLD(*), RENUM(*),
101 . NIN, NSN, NSNROLD,II_STOK
102C-----------------------------------------------
103C L o c a l V a r i a b l e s
104C-----------------------------------------------
105 INTEGER I, J, P, I_STOK, IDEB, JDEB, NI
106C-----------------------------------------------
107C S o u r c e L i n e s
108C-----------------------------------------------
109 DO i = 1, nsnrold
110 renum(i) = 0
111 END DO
112 i_stok = ii_stok
113 ideb = 0
114 jdeb = 0
115 DO p = 1, nspmd
116 i = 1
117 j = 1
118 DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
119 IF(nint(xrem(4,j+jdeb))==
120 + nsvfi(nin)%P(i+ideb)) THEN
121 renum(i+ideb) = j+jdeb
122 i = i + 1
123 j = j + 1
124 ELSEIF(nint(xrem(4,j+jdeb))<
125 + nsvfi(nin)%P(i+ideb)) THEN
126 j = j + 1
127 ELSEIF(nint(xrem(4,j+jdeb))>
128 + nsvfi(nin)%P(i+ideb)) THEN
129Case non-penetrated and non-retained candidate
130 i = i + 1
131 END IF
132 END DO
133 jdeb = jdeb + nsnfi(nin)%P(p)
134 ideb = ideb + nsnfiold(p)
135 END DO
136C
137C renumbering of old candidates according to new numbers
138C
139 DO i = 1, i_stok
140 ni = cand_n(i)
141 IF(ni>nsn) THEN
142 ni = ni - nsn
143 cand_n(i) = renum(ni) + nsn
144 END IF
145 END DO
146C
147 RETURN
148 END
149!||====================================================================
150!|| spmd_rnumcd ../engine/source/mpi/interfaces/spmd_i7tool.F
151!||--- called by ------------------------------------------------------
152!|| i23main_tri ../engine/source/interfaces/intsort/i23main_tri.f
153!|| i24main_tri ../engine/source/interfaces/intsort/i24main_tri.F
154!|| i7main_tri ../engine/source/interfaces/intsort/i7main_tri.F
155!|| inter_sort_07 ../engine/source/interfaces/int07/inter_sort_07.F
156!||--- uses -----------------------------------------------------
157!|| tri7box ../engine/share/modules/tri7box.F
158!||====================================================================
159 SUBROUTINE spmd_rnumcd(
160 1 CAND_N ,RENUM ,II_STOK,NIN,NSN,
161 2 NSNFIOLD,NSNROLD)
162C-----------------------------------------------
163C M o d u l e s
164C-----------------------------------------------
165 USE tri7box
166C-----------------------------------------------
167C I m p l i c i t T y p e s
168C-----------------------------------------------
169#include "implicit_f.inc"
170C-----------------------------------------------
171C C o m m o n B l o c k s
172C-----------------------------------------------
173#include "com01_c.inc"
174C-----------------------------------------------
175C D u m m y A r g u m e n t s
176C-----------------------------------------------
177 INTEGER CAND_N(*), NSNFIOLD(*), RENUM(*),
178 . NIN, NSN, NSNROLD,II_STOK
179C-----------------------------------------------
180C L o c a l V a r i a b l e s
181C-----------------------------------------------
182 INTEGER I, J, P, I_STOK, IDEB, JDEB, NI
183C-----------------------------------------------
184C S o u r c e L i n e s
185C-----------------------------------------------
186 DO I = 1, nsnrold
187 renum(i) = 0
188 END DO
189 i_stok = ii_stok
190 ideb = 0
191 jdeb = 0
192 DO p = 1, nspmd
193 i = 1
194 j = 1
195 DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
196 IF(irem(1,j+jdeb)==
197 + nsvfi(nin)%P(i+ideb)) THEN
198 renum(i+ideb) = j+jdeb
199 i = i + 1
200 j = j + 1
201 ELSEIF(irem(1,j+jdeb)<
202 + nsvfi(nin)%P(i+ideb)) THEN
203 j = j + 1
204 ELSEIF(irem(1,j+jdeb)>
205 + nsvfi(nin)%P(i+ideb)) THEN
206Case non-penetrated and non-retained candidate
207 i = i + 1
208 END IF
209 END DO
210 jdeb = jdeb + nsnfi(nin)%P(p)
211 ideb = ideb + nsnfiold(p)
212 END DO
213C
214C renumbering of old candidates according to new numbers
215C
216 DO i = 1, i_stok
217 ni = cand_n(i)
218 IF(ni>nsn) THEN
219 ni = ni - nsn
220 cand_n(i) = renum(ni) + nsn
221 END IF
222
223 END DO
224C
225 RETURN
226 END
227
228C
229!||====================================================================
230!|| spmd_rnumcd10 ../engine/source/mpi/interfaces/spmd_i7tool.F
231!||--- called by ------------------------------------------------------
232!|| i10main_tri ../engine/source/interfaces/intsort/i10main_tri.F
233!||--- uses -----------------------------------------------------
234!|| tri7box ../engine/share/modules/tri7box.F
235!||====================================================================
236 SUBROUTINE spmd_rnumcd10(
237 1 CAND_N ,RENUM ,II_STOK,NIN,NSN,
238 2 NSNFIOLD,NSNROLD)
239C-----------------------------------------------
240C M o d u l e s
241C-----------------------------------------------
242 USE tri7box
243C-----------------------------------------------
244C I m p l i c i t T y p e s
245C-----------------------------------------------
246#include "implicit_f.inc"
247C-----------------------------------------------
248C C o m m o n B l o c k s
249C-----------------------------------------------
250#include "com01_c.inc"
251C-----------------------------------------------
252C D u m m y A r g u m e n t s
253C-----------------------------------------------
254 INTEGER CAND_N(*), NSNFIOLD(*), RENUM(*),
255 . NIN, NSN, NSNROLD,II_STOK
256C-----------------------------------------------
257C L o c a l V a r i a b l e s
258C-----------------------------------------------
259 INTEGER I, J, P, I_STOK, IDEB, JDEB, NI
260C-----------------------------------------------
261C S o u r c e L i n e s
262C-----------------------------------------------
263 LOGICAL ISFOUND
264 DO I = 1, nsnrold
265 renum(i) = 0
266 END DO
267 i_stok = ii_stok
268 ideb = 0
269 jdeb = 0
270 isfound = .false.
271 DO p = 1, nspmd
272 i = 1
273 j = 1
274 DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
275
276 IF(irem(1,j+jdeb)==
277 + nsvfi(nin)%P(i+ideb)) THEN
278 renum(i+ideb) = j+jdeb
279 i = i + 1
280 j = j + 1
281 ELSEIF(irem(1,j+jdeb)<
282 + nsvfi(nin)%P(i+ideb)) THEN
283 j = j + 1
284 ELSEIF(irem(1,j+jdeb)>
285 + nsvfi(nin)%P(i+ideb)) THEN
286Case non-penetrated and non-retained candidate
287 i = i + 1
288 END IF
289 END DO
290
291 jdeb = jdeb + nsnfi(nin)%P(p)
292 ideb = ideb + nsnfiold(p)
293 END DO
294C
295C renumbering of old candidates according to new numbers
296C
297 DO i = 1, i_stok
298 ni = cand_n(i)
299 IF(ni>nsn) THEN
300 ni = ni - nsn
301 IF(renum(ni) > 0) THEN
302 cand_n(i) = renum(ni) + nsn
303 ELSE
304 cand_n(i) = 0 ! NSN + 1
305 WRITE(6,*) "possible p/on issue for",
306 . "/INTER/TYPE10 bouncing node",itafi(nin)%P(ni)
307 ENDIF
308 END IF
309 END DO
310C
311 RETURN
312 END
313!||====================================================================
314!|| spmd_rnum25 ../engine/source/mpi/interfaces/spmd_i7tool.F
315!||--- called by ------------------------------------------------------
316!|| i25main_tri ../engine/source/interfaces/intsort/i25main_tri.F
317!||--- uses -----------------------------------------------------
318!|| tri7box ../engine/share/modules/tri7box.F
319!||====================================================================
320 SUBROUTINE spmd_rnum25(
321 1 RENUM ,NIN,NSN,NSNFIOLD,NSNROLD)
322C-----------------------------------------------
323C M o d u l e s
324C-----------------------------------------------
325 USE tri7box
326C-----------------------------------------------
327C I m p l i c i t T y p e s
328C-----------------------------------------------
329#include "implicit_f.inc"
330C-----------------------------------------------
331C C o m m o n B l o c k s
332C-----------------------------------------------
333#include "com01_c.inc"
334C-----------------------------------------------
335C D u m m y A r g u m e n t s
336C-----------------------------------------------
337 INTEGER NSNFIOLD(*), RENUM(*),
338 . NIN, NSN, NSNROLD
339C-----------------------------------------------
340C L o c a l V a r i a b l e s
341C-----------------------------------------------
342 INTEGER I, J, P, I_STOK, IDEB, JDEB, NI
343C-----------------------------------------------
344C S o u r c e L i n e s
345C-----------------------------------------------
346 DO i = 1, nsnrold
347 renum(i) = 0
348 END DO
349
350 ideb = 0
351 jdeb = 0
352 DO p = 1, nspmd
353 i = 1
354 j = 1
355 DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
356 IF(irem(1,j+jdeb)==
357 + nsvfi(nin)%P(i+ideb)) THEN
358 renum(i+ideb) = j+jdeb
359 i = i + 1
360 j = j + 1
361 ELSEIF(irem(1,j+jdeb)<
362 + nsvfi(nin)%P(i+ideb)) THEN
363 j = j + 1
364 ELSEIF(irem(1,j+jdeb)>
365 + nsvfi(nin)%P(i+ideb)) THEN
366Case non-penetrated and non-retained candidate
367 i = i + 1
368 END IF
369 END DO
370 jdeb = jdeb + nsnfi(nin)%P(p)
371 ideb = ideb + nsnfiold(p)
372 END DO
373C
374 RETURN
375 END
376C
377!||====================================================================
378!|| spmd_rnumcd11 ../engine/source/mpi/interfaces/spmd_i7tool.F
379!||--- called by ------------------------------------------------------
380!|| i11main_tri ../engine/source/interfaces/intsort/i11main_tri.F
381!||--- uses -----------------------------------------------------
382!|| tri7box ../engine/share/modules/tri7box.F
383!||====================================================================
384 SUBROUTINE spmd_rnumcd11(
385 1 CAND_N ,RENUM ,II_STOK,NIN,NRTS,
386 2 NSNFIOLD,NSNROLD,ADDCM,CHAINE,CAND_M,NSN4,NRTM)
387C-----------------------------------------------
388C M o d u l e s
389C-----------------------------------------------
390 USE tri7box
391C-----------------------------------------------
392C I m p l i c i t T y p e s
393C-----------------------------------------------
394#include "implicit_f.inc"
395C-----------------------------------------------
396C C o m m o n B l o c k s
397C-----------------------------------------------
398#include "com01_c.inc"
399C-----------------------------------------------
400C D u m m y A r g u m e n t s
401C-----------------------------------------------
402 INTEGER CAND_N(*), NSNFIOLD(*), RENUM(*),
403 . NIN, NRTS, NSNROLD,ADDCM(*),CHAINE(2,*),
404 . CAND_M(*),NSN4,NRTM,II_STOK
405C-----------------------------------------------
406C L o c a l V a r i a b l e s
407C-----------------------------------------------
408 INTEGER I, J, P, I_STOK, IDEB, JDEB, NI, IAD,IADM1
409C-----------------------------------------------
410C S o u r c e L i n e s
411C-----------------------------------------------
412 DO i = 1, nsnrold
413 renum(i) = 0
414 END DO
415 i_stok = ii_stok
416 ideb = 0
417 jdeb = 0
418 DO p = 1, nspmd
419 i = 1
420 j = 1
421 DO WHILE (j<=nsnfi(nin)%P(p).AND.i<=nsnfiold(p))
422 IF(irem(1,j+jdeb)==
423 + nsvfi(nin)%P(i+ideb)) THEN
424 renum(i+ideb) = j+jdeb
425 i = i + 1
426 j = j + 1
427 ELSEIF(irem(1,j+jdeb)<
428 + nsvfi(nin)%P(i+ideb)) THEN
429 j = j + 1
430 ELSEIF(irem(1,j+jdeb)>
431 + nsvfi(nin)%P(i+ideb)) THEN
432Case non-penetrated and non-retained candidate
433 i = i + 1
434 END IF
435 END DO
436 jdeb = jdeb + nsnfi(nin)%P(p)
437 ideb = ideb + nsnfiold(p)
438 END DO
439C
440C renumbering of old candidates according to new numbers
441C
442 DO i = 1, i_stok
443 ni = cand_n(i)
444 IF(ni>nrts) THEN
445 ni = ni - nrts
446 cand_n(i) = renum(ni) + nrts
447 END IF
448 END DO
449 DO i=1,nrtm
450 j=0
451 iad = addcm(i)
452 DO WHILE(iad>0.AND.j<nsn4)
453 j=j+1
454 IF(chaine(1,iad) > nrts )THEN
455 chaine(1,iad) = renum(chaine(1,iad)-nrts)+nrts
456 ENDIF
457 iad=chaine(2,iad)
458 ENDDO
459 ENDDO
460C
461 RETURN
462 END
463C
464!||====================================================================
465!|| spmd_fiadd_poff ../engine/source/mpi/interfaces/spmd_i7tool.F
466!||--- called by ------------------------------------------------------
467!|| spmd_i7fcom_poff ../engine/source/mpi/forces/spmd_i7fcom_poff.F
468!||--- calls -----------------------------------------------------
469!|| ibcoff ../engine/source/interfaces/interf/ibcoff.F
470!||--- uses -----------------------------------------------------
471!|| h3d_mod ../engine/share/modules/h3d_mod.F
472!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
473!|| output_mod ../common_source/modules/output/output_mod.F90
474!|| parameters_mod ../common_source/modules/interfaces/parameters_mod.F
475!||====================================================================
476 SUBROUTINE spmd_fiadd_poff(OUTPUT,
477 1 NB ,LEN ,BUFR ,NSV ,A ,
478 2 STIFN ,VISCN ,IBC ,ISECIN ,NOINT ,
479 3 IBAG ,ICODT ,SECFCUM,NSTRF ,ICONTACT,
480 4 FCONT ,INACTI ,IADM ,INTTH ,FTHE ,
481 5 CONDN ,H3D_DATA, MULTI_FVM,NIN ,TAGNCONT,
482 6 KLOADPINTER,LOADPINTER,LOADP_HYD_INTER ,
483 . INTCAREA,FSAV ,PARAMETERS,NODADT_THERM)
484C-----------------------------------------------
485C M o d u l e s
486C-----------------------------------------------
487 USE h3d_mod
488 USE multi_fvm_mod
489 USE output_mod
490 USE parameters_mod
491C-----------------------------------------------
492C I m p l i c i t T y p e s
493C-----------------------------------------------
494#include "implicit_f.inc"
495C-----------------------------------------------
496C C o m m o n B l o c k s
497C-----------------------------------------------
498#include "scr07_c.inc"
499#include "scr14_c.inc"
500#include "scr16_c.inc"
501#include "scr18_c.inc"
502#include "com01_c.inc"
503#include "com04_c.inc"
504#include "com06_c.inc"
505#include "com08_c.inc"
506#include "impl1_c.inc"
507C-----------------------------------------------
508C D u m m y A r g u m e n t s
509C-----------------------------------------------
510 TYPE(output_), intent(inout) :: OUTPUT
511 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT, INACTI,
512 . NSV(*), ICODT(*), NSTRF(*),ICONTACT(*),
513 . TAGNCONT(NLOADP_HYD_INTER,*),KLOADPINTER(*),LOADPINTER(*),
514 . LOADP_HYD_INTER(*),
515 . IADM,INTTH
516 INTEGER, INTENT(in) :: NIN, INTCAREA
517 INTEGER, INTENT(IN) :: NODADT_THERM
518 my_real
519 . BUFR(LEN,*), A(3,*), STIFN(*), VISCN(*),
520 . SECFCUM(7,NUMNOD,NSECT),
521 . FCONT(3,*),FTHE(*),CONDN(*)
522 my_real, INTENT(INOUT) :: FSAV(*)
523 TYPE(H3D_DATABASE) :: H3D_DATA
524 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
525 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
526C-----------------------------------------------
527C L o c a l V a r i a b l e s
528C-----------------------------------------------
529 my_real :: mass, fsav29
530 INTEGER :: IBRIC
531 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,PP,PPL,NP
532C-----------------------------------------------
533C S o u r c e L i n e s
534C-----------------------------------------------
535C
536 IF (multi_fvm%INT18_GLOBAL_LIST(nin)) THEN
537 DO i = 1, nb
538 n = nint(bufr(1, i))
539 ibric = nsv(n)
540 multi_fvm%FORCE_INT(1, ibric) = multi_fvm%FORCE_INT(1, ibric) + bufr(2,i)
541 multi_fvm%FORCE_INT(2, ibric) = multi_fvm%FORCE_INT(2, ibric) + bufr(3,i)
542 multi_fvm%FORCE_INT(3, ibric) = multi_fvm%FORCE_INT(3, ibric) + bufr(4,i)
543 ENDDO
544 ELSE
545 IF(intth == 0 ) THEN
546 DO i = 1, nb
547 n = nint(bufr(1,i))
548 nod = nsv(n)
549 a(1,nod) = a(1,nod) + bufr(2,i)
550 a(2,nod) = a(2,nod) + bufr(3,i)
551 a(3,nod) = a(3,nod) + bufr(4,i)
552 stifn(nod) = stifn(nod) + bufr(5,i)
553 IF(kdtint /= 0) viscn(nod) = viscn(nod) + bufr(6,i)
554 ENDDO
555 ELSE
556 IF(kdtint==0)THEN
557 DO i = 1, nb
558 n = nint(bufr(1,i))
559 nod = nsv(n)
560 a(1,nod) = a(1,nod) + bufr(2,i)
561 a(2,nod) = a(2,nod) + bufr(3,i)
562 a(3,nod) = a(3,nod) + bufr(4,i)
563 stifn(nod) = stifn(nod) + bufr(5,i)
564 fthe(nod) = fthe(nod) + bufr(6,i)
565 IF(nodadt_therm == 1) condn(nod) = condn(nod) + bufr(7,i)
566 ENDDO
567 ELSE
568 DO i = 1, nb
569 n = nint(bufr(1,i))
570 nod = nsv(n)
571 a(1,nod) = a(1,nod) + bufr(2,i)
572 a(2,nod) = a(2,nod) + bufr(3,i)
573 a(3,nod) = a(3,nod) + bufr(4,i)
574 stifn(nod) = stifn(nod) + bufr(5,i)
575 viscn(nod) = viscn(nod) + bufr(6,i)
576 fthe(nod) = fthe(nod) + bufr(7,i)
577 IF(nodadt_therm == 1) condn(nod) = condn(nod) + bufr(8,i)
578 ENDDO
579 ENDIF
580 ENDIF
581C
582C following i7for3 & i10for3 process on secondary nodes
583C
584 IF (inconv == 1) THEN
585 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
586 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
587 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
588 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
589C Anim FCONT
590 DO i = 1, nb
591 n = nint(bufr(1,i))
592 nod = nsv(n)
593 fcont(1,nod)=fcont(1,nod)+bufr(2,i)
594 fcont(2,nod)=fcont(2,nod)+bufr(3,i)
595 fcont(3,nod)=fcont(3,nod)+bufr(4,i)
596 END DO
597 END IF
598 END IF
599C------------For /LOAD/PRESSURE tag nodes in contact-------------
600 IF(nintloadp > 0) THEN
601 DO i = 1, nb
602 n = nint(bufr(1,i))
603 nod = nsv(n)
604 DO np = kloadpinter(nin)+1, kloadpinter(nin+1)
605 pp = loadpinter(np)
606 ppl = loadp_hyd_inter(pp)
607 tagncont(ppl,nod) = 1
608 ENDDO
609 ENDDO
610 ENDIF
611C
612 IF(isecin>0)THEN
613C Sections
614 k0=nstrf(25)
615 IF(nstrf(1)+nstrf(2)/=0)THEN
616 DO i=1,nsect
617 nbinter=nstrf(k0+14)
618 k1s=k0+30
619 DO j=1,nbinter
620 IF(nstrf(k1s)==noint)THEN
621 IF(isecut/=0)THEN
622 DO ii = 1, nb
623 n = nint(bufr(1,ii))
624 nod = nsv(n)
625 IF(secfcum(4,nod,i)==1.)THEN
626 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
627 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
628 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
629 ENDIF
630 ENDDO
631 ENDIF
632 ENDIF
633 k1s=k1s+1
634 ENDDO
635 k0=nstrf(k0+24)
636 ENDDO
637 ENDIF
638 ENDIF
639C
640 IF((ibag/=0.AND.inacti/=7).OR.
641 . (iadm/=0).OR.(idamp_rdof/=0)) THEN ! warning conflict inacti=7 and ibag=3
642C Airbags IBAG
643 DO i = 1, nb
644 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
645 + bufr(4,i)/=zero) THEN
646 n = nint(bufr(1,i))
647 nod = nsv(n)
648 icontact(nod)=1
649 END IF
650 END DO
651 END IF
652C
653 IF(ibc/=0) THEN
654 ibcm = ibc / 8
655 ibcs = ibc - 8 * ibcm
656C Boundary cond.
657 IF(ibcs>0) THEN
658 DO i = 1, nb
659 n = nint(bufr(1,i))
660 nod = nsv(n)
661 CALL ibcoff(ibcs,icodt(nod))
662 END DO
663 END IF
664 END IF
665 ENDIF
666C
667 RETURN
668 END
669C
670!||====================================================================
671!|| spmd_fiadd11_poff ../engine/source/mpi/interfaces/spmd_i7tool.F
672!||--- called by ------------------------------------------------------
673!|| spmd_i7fcom_poff ../engine/source/mpi/forces/spmd_i7fcom_poff.F
674!||--- uses -----------------------------------------------------
675!|| h3d_mod ../engine/share/modules/h3d_mod.F
676!|| output_mod ../common_source/modules/output/output_mod.F90
677!||====================================================================
678 SUBROUTINE spmd_fiadd11_poff(OUTPUT,
679 1 NB ,LEN ,BUFR ,IRECTS ,A ,
680 2 STIFN ,VISCN ,IBC ,ISECIN ,NOINT ,
681 3 IBAG ,ICODT ,SECFCUM,NSTRF ,ICONTACT,
682 4 FCONT ,INTTH ,FTHE ,CONDN ,H3D_DATA,
683 5 TAGNCONT,KLOADPINTER,LOADPINTER,LOADP_HYD_INTER,NODADT_THERM)
684C-----------------------------------------------
685C M o d u l e s
686C-----------------------------------------------
687 USE h3d_mod
688 USE output_mod
689C-----------------------------------------------
690C I m p l i c i t T y p e s
691C-----------------------------------------------
692#include "implicit_f.inc"
693C-----------------------------------------------
694C C o m m o n B l o c k s
695C-----------------------------------------------
696#include "scr07_c.inc"
697#include "scr14_c.inc"
698#include "scr16_c.inc"
699#include "scr18_c.inc"
700#include "com01_c.inc"
701#include "com04_c.inc"
702#include "com06_c.inc"
703#include "com08_c.inc"
704#include "impl1_c.inc"
705C-----------------------------------------------
706C D u m m y A r g u m e n t s
707C-----------------------------------------------
708 TYPE(output_), intent(inout) :: OUTPUT
709 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT,INTTH,
710 . irects(2,*), icodt(*), nstrf(*),icontact(*),
711 . tagncont(nloadp_hyd_inter,*),
712 . kloadpinter(*),loadpinter(*),loadp_hyd_inter(*)
713 INTEGER, INTENT(IN) :: NODADT_THERM
714 my_real
715 . BUFR(LEN,*), A(3,*), STIFN(*), VISCN(*),
716 . SECFCUM(7,NUMNOD,NSECT),
717 . FCONT(3,*),FTHE(*),CONDN(*)
718 TYPE(H3D_DATABASE) :: H3D_DATA
719C-----------------------------------------------
720C L o c a l V a r i a b l e s
721C-----------------------------------------------
722 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,PP,PPL,NOD1,NOD2,NP
723C-----------------------------------------------
724C S o u r c e L i n e s
725C-----------------------------------------------
726 IF(INTTH == 0) then
727 IF(kdtint==0)THEN
728 DO i = 1, nb
729 n = nint(bufr(1,i))
730 nod = irects(1,n)
731 a(1,nod) = a(1,nod) + bufr(2,i)
732 a(2,nod) = a(2,nod) + bufr(3,i)
733 a(3,nod) = a(3,nod) + bufr(4,i)
734 stifn(nod) = stifn(nod) + bufr(5,i)
735 nod = irects(2,n)
736 a(1,nod) = a(1,nod) + bufr(6,i)
737 a(2,nod) = a(2,nod) + bufr(7,i)
738 a(3,nod) = a(3,nod) + bufr(8,i)
739 stifn(nod) = stifn(nod) + bufr(9,i)
740 ENDDO
741 ELSE
742 DO i = 1, nb
743 n = nint(bufr(1,i))
744 nod = irects(1,n)
745 a(1,nod) = a(1,nod) + bufr(2,i)
746 a(2,nod) = a(2,nod) + bufr(3,i)
747 a(3,nod) = a(3,nod) + bufr(4,i)
748 stifn(nod) = stifn(nod) + bufr(5,i)
749 viscn(nod) = viscn(nod) + bufr(6,i)
750 nod = irects(2,n)
751 a(1,nod) = a(1,nod) + bufr(7,i)
752 a(2,nod) = a(2,nod) + bufr(8,i)
753 a(3,nod) = a(3,nod) + bufr(9,i)
754 stifn(nod) = stifn(nod) + bufr(10,i)
755 viscn(nod) = viscn(nod) + bufr(11,i)
756 ENDDO
757 ENDIF
758 ELSE
759 IF(nodadt_therm ==1 )THEN
760 IF(kdtint==0)THEN
761 DO i = 1, nb
762 n = nint(bufr(1,i))
763 nod = irects(1,n)
764 a(1,nod) = a(1,nod) + bufr(2,i)
765 a(2,nod) = a(2,nod) + bufr(3,i)
766 a(3,nod) = a(3,nod) + bufr(4,i)
767 stifn(nod) = stifn(nod) + bufr(5,i)
768 fthe(nod) = fthe(nod) + bufr(6,i)
769 condn(nod) = condn(nod) + bufr(7,i)
770 nod = irects(2,n)
771 a(1,nod) = a(1,nod) + bufr(8,i)
772 a(2,nod) = a(2,nod) + bufr(9,i)
773 a(3,nod) = a(3,nod) + bufr(10,i)
774 stifn(nod) = stifn(nod) + bufr(11,i)
775 fthe(nod) = fthe(nod) + bufr(12,i)
776 condn(nod) = condn(nod) + bufr(13,i)
777 ENDDO
778 ELSE
779 DO i = 1, nb
780 n = nint(bufr(1,i))
781 nod = irects(1,n)
782 a(1,nod) = a(1,nod) + bufr(2,i)
783 a(2,nod) = a(2,nod) + bufr(3,i)
784 a(3,nod) = a(3,nod) + bufr(4,i)
785 stifn(nod) = stifn(nod) + bufr(5,i)
786 viscn(nod) = viscn(nod) + bufr(6,i)
787 fthe(nod) = fthe(nod) + bufr(7,i)
788 condn(nod) = condn(nod) + bufr(8,i)
789 nod = irects(2,n)
790 a(1,nod) = a(1,nod) + bufr(9,i)
791 a(2,nod) = a(2,nod) + bufr(10,i)
792 a(3,nod) = a(3,nod) + bufr(11,i)
793 stifn(nod) = stifn(nod) + bufr(12,i)
794 viscn(nod) = viscn(nod) + bufr(13,i)
795 fthe(nod) = fthe(nod) + bufr(14,i)
796 condn(nod) = condn(nod) + bufr(15,i)
797 ENDDO
798 ENDIF
799 ELSE
800 IF(kdtint==0)THEN
801 DO i = 1, nb
802 n = nint(bufr(1,i))
803 nod = irects(1,n)
804 a(1,nod) = a(1,nod) + bufr(2,i)
805 a(2,nod) = a(2,nod) + bufr(3,i)
806 a(3,nod) = a(3,nod) + bufr(4,i)
807 stifn(nod) = stifn(nod) + bufr(5,i)
808 fthe(nod) = fthe(nod) + bufr(6,i)
809 nod = irects(2,n)
810 a(1,nod) = a(1,nod) + bufr(7,i)
811 a(2,nod) = a(2,nod) + bufr(8,i)
812 a(3,nod) = a(3,nod) + bufr(9,i)
813 stifn(nod) = stifn(nod) + bufr(10,i)
814 fthe(nod) = fthe(nod) + bufr(11,i)
815 ENDDO
816 ELSE
817 DO i = 1, nb
818 n = nint(bufr(1,i))
819 nod = irects(1,n)
820 a(1,nod) = a(1,nod) + bufr(2,i)
821 a(2,nod) = a(2,nod) + bufr(3,i)
822 a(3,nod) = a(3,nod) + bufr(4,i)
823 stifn(nod) = stifn(nod) + bufr(5,i)
824 viscn(nod) = viscn(nod) + bufr(6,i)
825 fthe(nod) = fthe(nod) + bufr(7,i)
826 nod = irects(2,n)
827 a(1,nod) = a(1,nod) + bufr(8,i)
828 a(2,nod) = a(2,nod) + bufr(9,i)
829 a(3,nod) = a(3,nod) + bufr(10,i)
830 stifn(nod) = stifn(nod) + bufr(11,i)
831 viscn(nod) = viscn(nod) + bufr(12,i)
832 fthe(nod) = fthe(nod) + bufr(13,i)
833 ENDDO
834 ENDIF
835 ENDIF
836 ENDIF
837C
838C continue i11for3 processing on secondary node
839C
840 IF(inconv == 1) THEN
841 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
842 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
843 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
844 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
845C Anim FCONT
846 IF(kdtint==0)THEN
847 DO i = 1, nb
848 n = nint(bufr(1,i))
849 nod = irects(1,n)
850 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
851 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
852 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
853 nod = irects(2,n)
854 fcont(1,nod)=fcont(1,nod)+ bufr(6,i)
855 fcont(2,nod)=fcont(2,nod)+ bufr(7,i)
856 fcont(3,nod)=fcont(3,nod)+ bufr(8,i)
857 END DO
858 ELSE
859 DO i = 1, nb
860 n = nint(bufr(1,i))
861 nod = irects(1,n)
862 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
863 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
864 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
865 nod = irects(2,n)
866 fcont(1,nod)=fcont(1,nod)+ bufr(7,i)
867 fcont(2,nod)=fcont(2,nod)+ bufr(8,i)
868 fcont(3,nod)=fcont(3,nod)+ bufr(9,i)
869 END DO
870 END IF
871 END IF
872 END IF
873C------------For /LOAD/PRESSURE tag nodes in contact-------------
874 IF(nintloadp > 0) THEN
875 DO i = 1, nb
876 n = nint(bufr(1,i))
877 nod1 = irects(1,n)
878 nod2 = irects(2,n)
879 DO np = kloadpinter(noint)+1, kloadpinter(noint+1)
880 pp = loadpinter(np)
881 ppl = loadp_hyd_inter(pp)
882 tagncont(ppl,nod1) = 1
883 tagncont(ppl,nod2) = 1
884 ENDDO
885 ENDDO
886 ENDIF
887C
888 IF(isecin>0)THEN
889C Sections
890 k0=nstrf(25)
891 IF(nstrf(1)+nstrf(2)/=0)THEN
892 DO i=1,nsect
893 nbinter=nstrf(k0+14)
894 k1s=k0+30
895 DO j=1,nbinter
896 IF(nstrf(k1s)==noint)THEN
897 IF(isecut/=0)THEN
898 IF(kdtint==0)THEN
899 DO ii = 1, nb
900 n = nint(bufr(1,ii))
901 nod = irects(1,n)
902 IF(secfcum(4,nod,i)==1.)THEN
903 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
904 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
905 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
906 ENDIF
907 nod = irects(2,n)
908 IF(secfcum(4,nod,i)==1.)THEN
909 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(6,ii)
910 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(7,ii)
911 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(8,ii)
912 ENDIF
913 ENDDO
914 ELSE
915 DO ii = 1, nb
916 n = nint(bufr(1,ii))
917 nod = irects(1,n)
918 IF(secfcum(4,nod,i)==1.)THEN
919 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
920 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
921 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
922 ENDIF
923 nod = irects(2,n)
924 IF(secfcum(4,nod,i)==1.)THEN
925 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(7,ii)
926 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(8,ii)
927 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(9,ii)
928 ENDIF
929 ENDDO
930 END IF
931 ENDIF
932 ENDIF
933 k1s=k1s+1
934 ENDDO
935 k0=nstrf(k0+24)
936 ENDDO
937 ENDIF
938 ENDIF
939C
940 IF ((ibag/=0).OR.(idamp_rdof/=0)) THEN
941C Airbags IBAG
942 IF(kdtint==0)THEN
943 DO i = 1, nb
944 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
945 + bufr(4,i)/=zero) THEN
946 n = nint(bufr(1,i))
947 nod = irects(1,n)
948 icontact(nod)=1
949 END IF
950 IF(bufr(6,i)/=zero.OR.bufr(7,i)/=zero.OR.
951 + bufr(8,i)/=zero) THEN
952 nod = irects(2,n)
953 icontact(nod)=1
954 END IF
955 END DO
956 ELSE
957 DO i = 1, nb
958 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
959 + bufr(4,i)/=zero) THEN
960 n = nint(bufr(1,i))
961 nod = irects(1,n)
962 icontact(nod)=1
963 END IF
964 IF(bufr(7,i)/=zero.OR.bufr(8,i)/=zero.OR.
965 + bufr(9,i)/=zero) THEN
966 nod = irects(2,n)
967 icontact(nod)=1
968 END IF
969 END DO
970 END IF
971 END IF
972C
973 RETURN
974 END
975C
976!||====================================================================
977!|| spmd_fiadd17_poff ../engine/source/mpi/interfaces/spmd_i7tool.F
978!||--- called by ------------------------------------------------------
979!|| spmd_i7fcom_poff ../engine/source/mpi/forces/spmd_i7fcom_poff.F
980!||--- uses -----------------------------------------------------
981!|| element_mod ../common_source/modules/elements/element_mod.F90
982!|| h3d_mod ../engine/share/modules/h3d_mod.F
983!|| output_mod ../common_source/modules/output/output_mod.f90
984!||====================================================================
985 SUBROUTINE spmd_fiadd17_poff(OUTPUT,
986 1 NB ,LEN ,BUFR ,NELEMS ,A ,
987 2 STIFN ,FCONT ,IXS ,IXS16 ,FROTS ,
988 3 H3D_DATA)
989C-----------------------------------------------
990C M o d u l e s
991C-----------------------------------------------
992 USE h3d_mod
993 USE output_mod
994 use element_mod , only :nixs
995C-----------------------------------------------
996C I m p l i c i t T y p e s
997C-----------------------------------------------
998#include "implicit_f.inc"
999C-----------------------------------------------
1000C C o m m o n B l o c k s
1001C-----------------------------------------------
1002#include "scr07_c.inc"
1003#include "scr14_c.inc"
1004#include "scr16_c.inc"
1005#include "com06_c.inc"
1006#include "com08_c.inc"
1007C-----------------------------------------------
1008C D u m m y A r g u m e n t s
1009C-----------------------------------------------
1010 TYPE(output_), intent(inout) :: output
1011 INTEGER nb, len, nn,
1012 . nelems(*), IXS(NIXS,*) ,IXS16(8,*)
1013 my_real
1014 . BUFR(LEN,*), A(3,*), STIFN(*),
1015 . FCONT(3,*), FROTS(7,*)
1016 TYPE(H3D_DATABASE) :: H3D_DATA
1017C-----------------------------------------------
1018C L o c a l V a r i a b l e s
1019C-----------------------------------------------
1020 INTEGER I, NOD, NE
1021C-----------------------------------------------
1022C S o u r c e L i n e s
1023C-----------------------------------------------
1024 DO I = 1, nb
1025 nn = nint(bufr(1,i))
1026 ne = nelems(nn)
1027C
1028 nod = ixs(2,ne)
1029 a(1,nod) = a(1,nod) + bufr(2,i)
1030 a(2,nod) = a(2,nod) + bufr(3,i)
1031 a(3,nod) = a(3,nod) + bufr(4,i)
1032 stifn(nod) = stifn(nod) + bufr(5,i)
1033 nod = ixs(3,ne)
1034 a(1,nod) = a(1,nod) + bufr(6,i)
1035 a(2,nod) = a(2,nod) + bufr(7,i)
1036 a(3,nod) = a(3,nod) + bufr(8,i)
1037 stifn(nod) = stifn(nod) + bufr(9,i)
1038 nod = ixs(4,ne)
1039 a(1,nod) = a(1,nod) + bufr(10,i)
1040 a(2,nod) = a(2,nod) + bufr(11,i)
1041 a(3,nod) = a(3,nod) + bufr(12,i)
1042 stifn(nod) = stifn(nod) + bufr(13,i)
1043 nod = ixs(5,ne)
1044 a(1,nod) = a(1,nod) + bufr(14,i)
1045 a(2,nod) = a(2,nod) + bufr(15,i)
1046 a(3,nod) = a(3,nod) + bufr(16,i)
1047 stifn(nod) = stifn(nod) + bufr(17,i)
1048 nod = ixs(6,ne)
1049 a(1,nod) = a(1,nod) + bufr(18,i)
1050 a(2,nod) = a(2,nod) + bufr(19,i)
1051 a(3,nod) = a(3,nod) + bufr(20,i)
1052 stifn(nod) = stifn(nod) + bufr(21,i)
1053 nod = ixs(7,ne)
1054 a(1,nod) = a(1,nod) + bufr(22,i)
1055 a(2,nod) = a(2,nod) + bufr(23,i)
1056 a(3,nod) = a(3,nod) + bufr(24,i)
1057 stifn(nod) = stifn(nod) + bufr(25,i)
1058 nod = ixs(8,ne)
1059 a(1,nod) = a(1,nod) + bufr(26,i)
1060 a(2,nod) = a(2,nod) + bufr(27,i)
1061 a(3,nod) = a(3,nod) + bufr(28,i)
1062 stifn(nod) = stifn(nod) + bufr(29,i)
1063 nod = ixs(9,ne)
1064 a(1,nod) = a(1,nod) + bufr(30,i)
1065 a(2,nod) = a(2,nod) + bufr(31,i)
1066 a(3,nod) = a(3,nod) + bufr(32,i)
1067 stifn(nod) = stifn(nod) + bufr(33,i)
1068C
1069 nod = ixs16(1,ne)
1070 a(1,nod) = a(1,nod) + bufr(34,i)
1071 a(2,nod) = a(2,nod) + bufr(35,i)
1072 a(3,nod) = a(3,nod) + bufr(36,i)
1073 stifn(nod) = stifn(nod) + bufr(37,i)
1074 nod = ixs16(2,ne)
1075 a(1,nod) = a(1,nod) + bufr(38,i)
1076 a(2,nod) = a(2,nod) + bufr(39,i)
1077 a(3,nod) = a(3,nod) + bufr(40,i)
1078 stifn(nod) = stifn(nod) + bufr(41,i)
1079 nod = ixs16(3,ne)
1080 a(1,nod) = a(1,nod) + bufr(42,i)
1081 a(2,nod) = a(2,nod) + bufr(43,i)
1082 a(3,nod) = a(3,nod) + bufr(44,i)
1083 stifn(nod) = stifn(nod) + bufr(45,i)
1084 nod = ixs16(4,ne)
1085 a(1,nod) = a(1,nod) + bufr(46,i)
1086 a(2,nod) = a(2,nod) + bufr(47,i)
1087 a(3,nod) = a(3,nod) + bufr(48,i)
1088 stifn(nod) = stifn(nod) + bufr(49,i)
1089 nod = ixs16(5,ne)
1090 a(1,nod) = a(1,nod) + bufr(50,i)
1091 a(2,nod) = a(2,nod) + bufr(51,i)
1092 a(3,nod) = a(3,nod) + bufr(52,i)
1093 stifn(nod) = stifn(nod) + bufr(53,i)
1094 nod = ixs16(6,ne)
1095 a(1,nod) = a(1,nod) + bufr(54,i)
1096 a(2,nod) = a(2,nod) + bufr(55,i)
1097 a(3,nod) = a(3,nod) + bufr(56,i)
1098 stifn(nod) = stifn(nod) + bufr(57,i)
1099 nod = ixs16(7,ne)
1100 a(1,nod) = a(1,nod) + bufr(58,i)
1101 a(2,nod) = a(2,nod) + bufr(59,i)
1102 a(3,nod) = a(3,nod) + bufr(60,i)
1103 stifn(nod) = stifn(nod) + bufr(61,i)
1104 nod = ixs16(8,ne)
1105 a(1,nod) = a(1,nod) + bufr(62,i)
1106 a(2,nod) = a(2,nod) + bufr(63,i)
1107 a(3,nod) = a(3,nod) + bufr(64,i)
1108 stifn(nod) = stifn(nod) + bufr(65,i)
1109C
1110 frots(1,nn) = frots(1,nn) + bufr(66,i)
1111 frots(2,nn) = frots(2,nn) + bufr(67,i)
1112 frots(3,nn) = frots(3,nn) + bufr(68,i)
1113 frots(4,nn) = frots(4,nn) + bufr(69,i)
1114 ENDDO
1115C
1116C continue i11for3 processing on secondary node
1117C
1118 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
1119 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
1120 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
1121 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
1122C Anim FCONT
1123 DO i = 1, nb
1124 ne = nint(bufr(1,i))
1125C
1126 nod = ixs(2,ne)
1127 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
1128 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
1129 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
1130 nod = ixs(3,ne)
1131 fcont(1,nod)=fcont(1,nod)+ bufr(6,i)
1132 fcont(2,nod)=fcont(2,nod)+ bufr(7,i)
1133 fcont(3,nod)=fcont(3,nod)+ bufr(8,i)
1134 nod = ixs(4,ne)
1135 fcont(1,nod)=fcont(1,nod)+ bufr(10,i)
1136 fcont(2,nod)=fcont(2,nod)+ bufr(11,i)
1137 fcont(3,nod)=fcont(3,nod)+ bufr(12,i)
1138 nod = ixs(5,ne)
1139 fcont(1,nod)=fcont(1,nod)+ bufr(14,i)
1140 fcont(2,nod)=fcont(2,nod)+ bufr(15,i)
1141 fcont(3,nod)=fcont(3,nod)+ bufr(16,i)
1142 nod = ixs(6,ne)
1143 fcont(1,nod)=fcont(1,nod)+ bufr(18,i)
1144 fcont(2,nod)=fcont(2,nod)+ bufr(19,i)
1145 fcont(3,nod)=fcont(3,nod)+ bufr(20,i)
1146 nod = ixs(7,ne)
1147 fcont(1,nod)=fcont(1,nod)+ bufr(22,i)
1148 fcont(2,nod)=fcont(2,nod)+ bufr(23,i)
1149 fcont(3,nod)=fcont(3,nod)+ bufr(24,i)
1150 nod = ixs(8,ne)
1151 fcont(1,nod)=fcont(1,nod)+ bufr(26,i)
1152 fcont(2,nod)=fcont(2,nod)+ bufr(27,i)
1153 fcont(3,nod)=fcont(3,nod)+ bufr(28,i)
1154 nod = ixs(9,ne)
1155 fcont(1,nod)=fcont(1,nod)+ bufr(30,i)
1156 fcont(2,nod)=fcont(2,nod)+ bufr(31,i)
1157 fcont(3,nod)=fcont(3,nod)+ bufr(32,i)
1158C
1159 nod = ixs16(1,ne)
1160 fcont(1,nod)=fcont(1,nod)+ bufr(34,i)
1161 fcont(2,nod)=fcont(2,nod)+ bufr(35,i)
1162 fcont(3,nod)=fcont(3,nod)+ bufr(36,i)
1163 nod = ixs16(2,ne)
1164 fcont(1,nod)=fcont(1,nod)+ bufr(38,i)
1165 fcont(2,nod)=fcont(2,nod)+ bufr(39,i)
1166 fcont(3,nod)=fcont(3,nod)+ bufr(40,i)
1167 nod = ixs16(3,ne)
1168 fcont(1,nod)=fcont(1,nod)+ bufr(42,i)
1169 fcont(2,nod)=fcont(2,nod)+ bufr(43,i)
1170 fcont(3,nod)=fcont(3,nod)+ bufr(44,i)
1171 nod = ixs16(4,ne)
1172 fcont(1,nod)=fcont(1,nod)+ bufr(46,i)
1173 fcont(2,nod)=fcont(2,nod)+ bufr(47,i)
1174 fcont(3,nod)=fcont(3,nod)+ bufr(48,i)
1175 nod = ixs16(5,ne)
1176 fcont(1,nod)=fcont(1,nod)+ bufr(50,i)
1177 fcont(2,nod)=fcont(2,nod)+ bufr(51,i)
1178 fcont(3,nod)=fcont(3,nod)+ bufr(52,i)
1179 nod = ixs16(6,ne)
1180 fcont(1,nod)=fcont(1,nod)+ bufr(54,i)
1181 fcont(2,nod)=fcont(2,nod)+ bufr(55,i)
1182 fcont(3,nod)=fcont(3,nod)+ bufr(56,i)
1183 nod = ixs16(7,ne)
1184 fcont(1,nod)=fcont(1,nod)+ bufr(58,i)
1185 fcont(2,nod)=fcont(2,nod)+ bufr(59,i)
1186 fcont(3,nod)=fcont(3,nod)+ bufr(60,i)
1187 nod = ixs16(8,ne)
1188 fcont(1,nod)=fcont(1,nod)+ bufr(62,i)
1189 fcont(2,nod)=fcont(2,nod)+ bufr(63,i)
1190 fcont(3,nod)=fcont(3,nod)+ bufr(64,i)
1191 END DO
1192 END IF
1193C
1194 RETURN
1195 END
1196C
1197!||====================================================================
1198!|| spmd_fiadd20_poff ../engine/source/mpi/interfaces/spmd_i7tool.F
1199!||--- called by ------------------------------------------------------
1200!|| spmd_i7fcom_poff ../engine/source/mpi/forces/spmd_i7fcom_poff.F
1201!||--- calls -----------------------------------------------------
1202!|| getdpdaanc ../engine/source/mpi/interfaces/spmd_i7tool.F
1203!|| ibcoff ../engine/source/interfaces/interf/ibcoff.F
1204!||--- uses -----------------------------------------------------
1205!|| h3d_mod ../engine/share/modules/h3d_mod.F
1206!|| output_mod ../common_source/modules/output/output_mod.F90
1207!||====================================================================
1208 SUBROUTINE spmd_fiadd20_poff(OUTPUT,
1209 1 NB ,LEN ,BUFR ,NSV ,A ,
1210 2 STIFN ,VISCN ,IBC ,ISECIN ,NOINT ,
1211 3 IBAG ,ICODT ,SECFCUM,NSTRF ,ICONTACT,
1212 4 FCONT ,INACTI ,IADM ,INTTH ,DAANC6 ,
1213 5 FTHE ,NLG ,ALPHAK ,H3D_DATA)
1214C-----------------------------------------------
1215C M o d u l e s
1216C-----------------------------------------------
1217 USE h3d_mod
1218 USE output_mod
1219C-----------------------------------------------
1220C I m p l i c i t T y p e s
1221C-----------------------------------------------
1222#include "implicit_f.inc"
1223C-----------------------------------------------
1224C C o m m o n B l o c k s
1225C-----------------------------------------------
1226#include "scr05_c.inc"
1227#include "scr07_c.inc"
1228#include "scr14_c.inc"
1229#include "scr16_c.inc"
1230#include "scr18_c.inc"
1231#include "com01_c.inc"
1232#include "com04_c.inc"
1233#include "com06_c.inc"
1234#include "com08_c.inc"
1235C-----------------------------------------------
1236C D u m m y A r g u m e n t s
1237C-----------------------------------------------
1238 TYPE(output_), intent(inout) :: OUTPUT
1239 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT, INACTI,
1240 . NSV(*), ICODT(*), NSTRF(*), NLG(*),
1241 . ICONTACT(*), IADM,INTTH
1242 my_real
1243 . BUFR(LEN,*), A(3,*), STIFN(*), VISCN(*),
1244 . SECFCUM(7,NUMNOD,NSECT),
1245 . FCONT(3,*),FTHE(*), ALPHAK(3,*)
1246 DOUBLE PRECISION DAANC6(3,6,*)
1247 TYPE(h3d_database) :: H3D_DATA
1248C-----------------------------------------------
1249C L o c a l V a r i a b l e s
1250C-----------------------------------------------
1251 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER, INC,ISIGN
1252 DOUBLE PRECISION DAANC6L(3,6)
1253C-----------------------------------------------
1254C S o u r c e L i n e s
1255C-----------------------------------------------
1256C
1257 IF(INTTH == 0 ) then
1258 IF(kdtint==0)THEN
1259 DO i = 1, nb
1260 n = nsv(nint(bufr(1,i)))
1261 nod = nlg(n)
1262 a(1,nod) = a(1,nod) + bufr(2,i)
1263 a(2,nod) = a(2,nod) + bufr(3,i)
1264 a(3,nod) = a(3,nod) + bufr(4,i)
1265 stifn(nod) = stifn(nod) + bufr(5,i)
1266C type20 interface treatment
1267 isign = 1
1268 IF(alphak(2,n) < zero .or. bufr(6,i) < zero)isign = -1
1269 alphak(2,n) = isign*min(abs(alphak(2,n)),abs(bufr(6,i)))
1270 CALL getdpdaanc(daanc6l,bufr(7,i),iresp,inc)
1271 daanc6(1,1,n) = daanc6(1,1,n)+daanc6l(1,1)
1272 daanc6(1,2,n) = daanc6(1,2,n)+daanc6l(1,2)
1273 daanc6(1,3,n) = daanc6(1,3,n)+daanc6l(1,3)
1274 daanc6(1,4,n) = daanc6(1,4,n)+daanc6l(1,4)
1275 daanc6(1,5,n) = daanc6(1,5,n)+daanc6l(1,5)
1276 daanc6(1,6,n) = daanc6(1,6,n)+daanc6l(1,6)
1277 daanc6(2,1,n) = daanc6(2,1,n)+daanc6l(2,1)
1278 daanc6(2,2,n) = daanc6(2,2,n)+daanc6l(2,2)
1279 daanc6(2,3,n) = daanc6(2,3,n)+daanc6l(2,3)
1280 daanc6(2,4,n) = daanc6(2,4,n)+daanc6l(2,4)
1281 daanc6(2,5,n) = daanc6(2,5,n)+daanc6l(2,5)
1282 daanc6(2,6,n) = daanc6(2,6,n)+daanc6l(2,6)
1283 daanc6(3,1,n) = daanc6(3,1,n)+daanc6l(3,1)
1284 daanc6(3,2,n) = daanc6(3,2,n)+daanc6l(3,2)
1285 daanc6(3,3,n) = daanc6(3,3,n)+daanc6l(3,3)
1286 daanc6(3,4,n) = daanc6(3,4,n)+daanc6l(3,4)
1287 daanc6(3,5,n) = daanc6(3,5,n)+daanc6l(3,5)
1288 daanc6(3,6,n) = daanc6(3,6,n)+daanc6l(3,6)
1289 ENDDO
1290 ELSE
1291 DO i = 1, nb
1292 n = nsv(nint(bufr(1,i)))
1293 nod = nlg(n)
1294 a(1,nod) = a(1,nod) + bufr(2,i)
1295 a(2,nod) = a(2,nod) + bufr(3,i)
1296 a(3,nod) = a(3,nod) + bufr(4,i)
1297 stifn(nod) = stifn(nod) + bufr(5,i)
1298 viscn(nod) = viscn(nod) + bufr(6,i)
1299 isign = 1
1300 IF(alphak(2,n) < zero .or. bufr(7,i) < zero)isign = -1
1301 alphak(2,n) = isign*min(abs(alphak(2,n)),abs(bufr(7,i)))
1302C type20 interface treatment
1303 CALL getdpdaanc(daanc6l,bufr(8,i),iresp,inc)
1304 daanc6(1,1,n) = daanc6(1,1,n)+daanc6l(1,1)
1305 daanc6(1,2,n) = daanc6(1,2,n)+daanc6l(1,2)
1306 daanc6(1,3,n) = daanc6(1,3,n)+daanc6l(1,3)
1307 daanc6(1,4,n) = daanc6(1,4,n)+daanc6l(1,4)
1308 daanc6(1,5,n) = daanc6(1,5,n)+daanc6l(1,5)
1309 daanc6(1,6,n) = daanc6(1,6,n)+daanc6l(1,6)
1310 daanc6(2,1,n) = daanc6(2,1,n)+daanc6l(2,1)
1311 daanc6(2,2,n) = daanc6(2,2,n)+daanc6l(2,2)
1312 daanc6(2,3,n) = daanc6(2,3,n)+daanc6l(2,3)
1313 daanc6(2,4,n) = daanc6(2,4,n)+daanc6l(2,4)
1314 daanc6(2,5,n) = daanc6(2,5,n)+daanc6l(2,5)
1315 daanc6(2,6,n) = daanc6(2,6,n)+daanc6l(2,6)
1316 daanc6(3,1,n) = daanc6(3,1,n)+daanc6l(3,1)
1317 daanc6(3,2,n) = daanc6(3,2,n)+daanc6l(3,2)
1318 daanc6(3,3,n) = daanc6(3,3,n)+daanc6l(3,3)
1319 daanc6(3,4,n) = daanc6(3,4,n)+daanc6l(3,4)
1320 daanc6(3,5,n) = daanc6(3,5,n)+daanc6l(3,5)
1321 daanc6(3,6,n) = daanc6(3,6,n)+daanc6l(3,6)
1322 ENDDO
1323 ENDIF
1324C
1325 ELSE
1326 IF(kdtint==0)THEN
1327 DO i = 1, nb
1328 n = nsv(nint(bufr(1,i)))
1329 nod = nlg(n)
1330 a(1,nod) = a(1,nod) + bufr(2,i)
1331 a(2,nod) = a(2,nod) + bufr(3,i)
1332 a(3,nod) = a(3,nod) + bufr(4,i)
1333 stifn(nod) = stifn(nod) + bufr(5,i)
1334 fthe(nod) = fthe(nod) + bufr(6,i)
1335C type20 interface treatment
1336 isign = 1
1337 IF(alphak(2,n) < zero .or. bufr(7,i) < zero)isign = -1
1338 alphak(2,n) = isign*min(abs(alphak(2,n)),abs(bufr(7,i)))
1339 CALL getdpdaanc(daanc6l,bufr(8,i),iresp,inc)
1340 daanc6(1,1,n) = daanc6(1,1,n)+daanc6l(1,1)
1341 daanc6(1,2,n) = daanc6(1,2,n)+daanc6l(1,2)
1342 daanc6(1,3,n) = daanc6(1,3,n)+daanc6l(1,3)
1343 daanc6(1,4,n) = daanc6(1,4,n)+daanc6l(1,4)
1344 daanc6(1,5,n) = daanc6(1,5,n)+daanc6l(1,5)
1345 daanc6(1,6,n) = daanc6(1,6,n)+daanc6l(1,6)
1346 daanc6(2,1,n) = daanc6(2,1,n)+daanc6l(2,1)
1347 daanc6(2,2,n) = daanc6(2,2,n)+daanc6l(2,2)
1348 daanc6(2,3,n) = daanc6(2,3,n)+daanc6l(2,3)
1349 daanc6(2,4,n) = daanc6(2,4,n)+daanc6l(2,4)
1350 daanc6(2,5,n) = daanc6(2,5,n)+daanc6l(2,5)
1351 daanc6(2,6,n) = daanc6(2,6,n)+daanc6l(2,6)
1352 daanc6(3,1,n) = daanc6(3,1,n)+daanc6l(3,1)
1353 daanc6(3,2,n) = daanc6(3,2,n)+daanc6l(3,2)
1354 daanc6(3,3,n) = daanc6(3,3,n)+daanc6l(3,3)
1355 daanc6(3,4,n) = daanc6(3,4,n)+daanc6l(3,4)
1356 daanc6(3,5,n) = daanc6(3,5,n)+daanc6l(3,5)
1357 daanc6(3,6,n) = daanc6(3,6,n)+daanc6l(3,6)
1358 ENDDO
1359 ELSE
1360 DO i = 1, nb
1361 n = nsv(nint(bufr(1,i)))
1362 nod = nlg(n)
1363 a(1,nod) = a(1,nod) + bufr(2,i)
1364 a(2,nod) = a(2,nod) + bufr(3,i)
1365 a(3,nod) = a(3,nod) + bufr(4,i)
1366 stifn(nod) = stifn(nod) + bufr(5,i)
1367 viscn(nod) = viscn(nod) + bufr(6,i)
1368 fthe(nod) = fthe(nod) + bufr(7,i)
1369C type20 interface treatment
1370 isign = 1
1371 IF(alphak(2,n) < zero .or. bufr(8,i) < zero)isign = -1
1372 alphak(2,n) = isign*min(abs(alphak(2,n)),abs(bufr(8,i)))
1373 CALL getdpdaanc(daanc6l,bufr(9,i),iresp,inc)
1374 daanc6(1,1,n) = daanc6(1,1,n)+daanc6l(1,1)
1375 daanc6(1,2,n) = daanc6(1,2,n)+daanc6l(1,2)
1376 daanc6(1,3,n) = daanc6(1,3,n)+daanc6l(1,3)
1377 daanc6(1,4,n) = daanc6(1,4,n)+daanc6l(1,4)
1378 daanc6(1,5,n) = daanc6(1,5,n)+daanc6l(1,5)
1379 daanc6(1,6,n) = daanc6(1,6,n)+daanc6l(1,6)
1380 daanc6(2,1,n) = daanc6(2,1,n)+daanc6l(2,1)
1381 daanc6(2,2,n) = daanc6(2,2,n)+daanc6l(2,2)
1382 daanc6(2,3,n) = daanc6(2,3,n)+daanc6l(2,3)
1383 daanc6(2,4,n) = daanc6(2,4,n)+daanc6l(2,4)
1384 daanc6(2,5,n) = daanc6(2,5,n)+daanc6l(2,5)
1385 daanc6(2,6,n) = daanc6(2,6,n)+daanc6l(2,6)
1386 daanc6(3,1,n) = daanc6(3,1,n)+daanc6l(3,1)
1387 daanc6(3,2,n) = daanc6(3,2,n)+daanc6l(3,2)
1388 daanc6(3,3,n) = daanc6(3,3,n)+daanc6l(3,3)
1389 daanc6(3,4,n) = daanc6(3,4,n)+daanc6l(3,4)
1390 daanc6(3,5,n) = daanc6(3,5,n)+daanc6l(3,5)
1391 daanc6(3,6,n) = daanc6(3,6,n)+daanc6l(3,6)
1392 ENDDO
1393 ENDIF
1394 ENDIF
1395C
1396C following i7for3 & i10for3 process on secondary nodes
1397C
1398 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
1399 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
1400 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
1401 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
1402C Anim FCONT
1403 DO i = 1, nb
1404 n = nint(bufr(1,i))
1405 nod = nlg(nsv(n))
1406 fcont(1,nod)=fcont(1,nod)+bufr(2,i)
1407 fcont(2,nod)=fcont(2,nod)+bufr(3,i)
1408 fcont(3,nod)=fcont(3,nod)+bufr(4,i)
1409 END DO
1410 END IF
1411C
1412 IF(isecin>0)THEN
1413C Sections
1414 k0=nstrf(25)
1415 IF(nstrf(1)+nstrf(2)/=0)THEN
1416 DO i=1,nsect
1417 nbinter=nstrf(k0+14)
1418 k1s=k0+30
1419 DO j=1,nbinter
1420 IF(nstrf(k1s)==noint)THEN
1421 IF(isecut/=0)THEN
1422 DO ii = 1, nb
1423 n = nint(bufr(1,ii))
1424 nod = nsv(n)
1425 IF(secfcum(4,nod,i)==1.)THEN
1426 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
1427 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
1428 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
1429 ENDIF
1430 ENDDO
1431 ENDIF
1432 ENDIF
1433 k1s=k1s+1
1434 ENDDO
1435 k0=nstrf(k0+24)
1436 ENDDO
1437 ENDIF
1438 ENDIF
1439C
1440 IF((ibag/=0.AND.inacti/=7).OR.
1441 . iadm/=0)THEN ! warning conflict inacti=7 and ibag=3
1442C Airbags IBAG
1443 DO i = 1, nb
1444 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
1445 + bufr(4,i)/=zero) THEN
1446 n = nint(bufr(1,i))
1447 nod = nlg(nsv(n))
1448 icontact(nod)=1
1449 END IF
1450 END DO
1451 END IF
1452C
1453 IF(ibc/=0) THEN
1454 ibcm = ibc / 8
1455 ibcs = ibc - 8 * ibcm
1456C Boundary cond.
1457 IF(ibcs>0) THEN
1458 DO i = 1, nb
1459 n = nint(bufr(1,i))
1460 nod = nlg(nsv(n))
1461 CALL ibcoff(ibcs,icodt(nod))
1462 END DO
1463 END IF
1464 END IF
1465C
1466 RETURN
1467 END
1468C
1469!||====================================================================
1470!|| spmd_fiadd20e_poff ../engine/source/mpi/interfaces/spmd_i7tool.f
1471!||--- called by ------------------------------------------------------
1472!|| spmd_i7fcom_poff ../engine/source/mpi/forces/spmd_i7fcom_poff.F
1473!||--- calls -----------------------------------------------------
1474!|| getdpdaanc ../engine/source/mpi/interfaces/spmd_i7tool.F
1475!||--- uses -----------------------------------------------------
1476!|| h3d_mod ../engine/share/modules/h3d_mod.F
1477!|| output_mod ../common_source/modules/output/output_mod.F90
1478!||====================================================================
1479 SUBROUTINE spmd_fiadd20e_poff(OUTPUT,
1480 1 NB ,LEN ,BUFR ,IXLINS ,A ,
1481 2 STIFN ,VISCN ,IBC ,ISECIN ,NOINT ,
1482 3 IBAG ,ICODT ,SECFCUM,NSTRF ,ICONTACT,
1483 4 FCONT ,DAANC6 ,NLG ,ALPHAK ,H3D_DATA)
1484C-----------------------------------------------
1485C M o d u l e s
1486C-----------------------------------------------
1487 USE h3d_mod
1488 USE output_mod
1489C-----------------------------------------------
1490C I m p l i c i t T y p e s
1491C-----------------------------------------------
1492#include "implicit_f.inc"
1493C-----------------------------------------------
1494C C o m m o n B l o c k s
1495C-----------------------------------------------
1496#include "scr05_c.inc"
1497#include "scr07_c.inc"
1498#include "scr14_c.inc"
1499#include "scr16_c.inc"
1500#include "scr18_c.inc"
1501#include "com01_c.inc"
1502#include "com04_c.inc"
1503#include "com06_c.inc"
1504#include "com08_c.inc"
1505C-----------------------------------------------
1506C D u m m y A r g u m e n t s
1507C-----------------------------------------------
1508 TYPE(output_), intent(inout) :: output
1509 INTEGER nb, len, ibc ,isecin ,ibag , noint,
1510 . ixlins(2,*), ICODT(*), NSTRF(*),
1511 . ICONTACT(*), NLG(*)
1512 my_real
1513 . bufr(len,*), a(3,*), stifn(*), viscn(*),
1514 . secfcum(7,numnod,nsect),
1515 . fcont(3,*), alphak(3,*)
1516 DOUBLE PRECISION DAANC6(3,6,*)
1517 TYPE(H3D_DATABASE) :: H3D_DATA
1518C-----------------------------------------------
1519C L o c a l V a r i a b l e s
1520C-----------------------------------------------
1521 INTEGER I, J, II, N, N1, N2, N1G, N2G, K0, K1S, NBINTER, INC,ISIGN
1522 DOUBLE PRECISION DAANC6L(3,6)
1523C-----------------------------------------------
1524C S o u r c e L i n e s
1525C-----------------------------------------------
1526C
1527 IF(KDTINT==0)then
1528 DO i = 1, nb
1529 n = nint(bufr(1,i))
1530 n1 = ixlins(1,n)
1531 n2 = ixlins(2,n)
1532 n1g = nlg(n1)
1533 n2g = nlg(n2)
1534 a(1,n1g) = a(1,n1g) + bufr(2,i)
1535 a(2,n1g) = a(2,n1g) + bufr(3,i)
1536 a(3,n1g) = a(3,n1g) + bufr(4,i)
1537 stifn(n1g) = stifn(n1g) + bufr(5,i)
1538C
1539 a(1,n2g) = a(1,n2g) + bufr(6,i)
1540 a(2,n2g) = a(2,n2g) + bufr(7,i)
1541 a(3,n2g) = a(3,n2g) + bufr(8,i)
1542 stifn(n2g) = stifn(n2g) + bufr(9,i)
1543C Traitement interface type20
1544 isign = 1
1545 IF(alphak(2,n1) < zero .or. bufr(10,i) < zero)isign = -1
1546 alphak(2,n1) = isign*min(abs(alphak(2,n1)),abs(bufr(10,i)))
1547 isign = 1
1548 IF(alphak(2,n2) < zero .or. bufr(11,i) < zero)isign = -1
1549 alphak(2,n2) = isign*min(abs(alphak(2,n2)),abs(bufr(11,i)))
1550 CALL getdpdaanc(daanc6l,bufr(12,i),iresp,inc)
1551 daanc6(1,1,n1) = daanc6(1,1,n1)+daanc6l(1,1)
1552 daanc6(1,2,n1) = daanc6(1,2,n1)+daanc6l(1,2)
1553 daanc6(1,3,n1) = daanc6(1,3,n1)+daanc6l(1,3)
1554 daanc6(1,4,n1) = daanc6(1,4,n1)+daanc6l(1,4)
1555 daanc6(1,5,n1) = daanc6(1,5,n1)+daanc6l(1,5)
1556 daanc6(1,6,n1) = daanc6(1,6,n1)+daanc6l(1,6)
1557 daanc6(2,1,n1) = daanc6(2,1,n1)+daanc6l(2,1)
1558 daanc6(2,2,n1) = daanc6(2,2,n1)+daanc6l(2,2)
1559 daanc6(2,3,n1) = daanc6(2,3,n1)+daanc6l(2,3)
1560 daanc6(2,4,n1) = daanc6(2,4,n1)+daanc6l(2,4)
1561 daanc6(2,5,n1) = daanc6(2,5,n1)+daanc6l(2,5)
1562 daanc6(2,6,n1) = daanc6(2,6,n1)+daanc6l(2,6)
1563 daanc6(3,1,n1) = daanc6(3,1,n1)+daanc6l(3,1)
1564 daanc6(3,2,n1) = daanc6(3,2,n1)+daanc6l(3,2)
1565 daanc6(3,3,n1) = daanc6(3,3,n1)+daanc6l(3,3)
1566 daanc6(3,4,n1) = daanc6(3,4,n1)+daanc6l(3,4)
1567 daanc6(3,5,n1) = daanc6(3,5,n1)+daanc6l(3,5)
1568 daanc6(3,6,n1) = daanc6(3,6,n1)+daanc6l(3,6)
1569 CALL getdpdaanc(daanc6l,bufr(12+inc,i),iresp,inc)
1570 daanc6(1,1,n2) = daanc6(1,1,n2)+daanc6l(1,1)
1571 daanc6(1,2,n2) = daanc6(1,2,n2)+daanc6l(1,2)
1572 daanc6(1,3,n2) = daanc6(1,3,n2)+daanc6l(1,3)
1573 daanc6(1,4,n2) = daanc6(1,4,n2)+daanc6l(1,4)
1574 daanc6(1,5,n2) = daanc6(1,5,n2)+daanc6l(1,5)
1575 daanc6(1,6,n2) = daanc6(1,6,n2)+daanc6l(1,6)
1576 daanc6(2,1,n2) = daanc6(2,1,n2)+daanc6l(2,1)
1577 daanc6(2,2,n2) = daanc6(2,2,n2)+daanc6l(2,2)
1578 daanc6(2,3,n2) = daanc6(2,3,n2)+daanc6l(2,3)
1579 daanc6(2,4,n2) = daanc6(2,4,n2)+daanc6l(2,4)
1580 daanc6(2,5,n2) = daanc6(2,5,n2)+daanc6l(2,5)
1581 daanc6(2,6,n2) = daanc6(2,6,n2)+daanc6l(2,6)
1582 daanc6(3,1,n2) = daanc6(3,1,n2)+daanc6l(3,1)
1583 daanc6(3,2,n2) = daanc6(3,2,n2)+daanc6l(3,2)
1584 daanc6(3,3,n2) = daanc6(3,3,n2)+daanc6l(3,3)
1585 daanc6(3,4,n2) = daanc6(3,4,n2)+daanc6l(3,4)
1586 daanc6(3,5,n2) = daanc6(3,5,n2)+daanc6l(3,5)
1587 daanc6(3,6,n2) = daanc6(3,6,n2)+daanc6l(3,6)
1588 ENDDO
1589 ELSE
1590 DO i = 1, nb
1591 n = nint(bufr(1,i))
1592 n1 = ixlins(1,n)
1593 n2 = ixlins(2,n)
1594 n1g = nlg(n1)
1595 n2g = nlg(n2)
1596 a(1,n1g) = a(1,n1g) + bufr(2,i)
1597 a(2,n1g) = a(2,n1g) + bufr(3,i)
1598 a(3,n1g) = a(3,n1g) + bufr(4,i)
1599 stifn(n1g) = stifn(n1g) + bufr(5,i)
1600 viscn(n1g) = viscn(n1g) + bufr(6,i)
1601C
1602 a(1,n2g) = a(1,n2g) + bufr(7,i)
1603 a(2,n2g) = a(2,n2g) + bufr(8,i)
1604 a(3,n2g) = a(3,n2g) + bufr(9,i)
1605 stifn(n2g) = stifn(n2g) + bufr(10,i)
1606 viscn(n2g) = viscn(n2g) + bufr(11,i)
1607C Traitement interface type20
1608 isign = 1
1609 IF(alphak(2,n1) < zero .or. bufr(12,i) < zero)isign = -1
1610 alphak(2,n1) = isign*min(abs(alphak(2,n1)),abs(bufr(12,i)))
1611 isign = 1
1612 IF(alphak(2,n2) < zero .or. bufr(13,i) < zero)isign = -1
1613 alphak(2,n2) = isign*min(abs(alphak(2,n2)),abs(bufr(13,i)))
1614 CALL getdpdaanc(daanc6l,bufr(14,i),iresp,inc)
1615 daanc6(1,1,n1) = daanc6(1,1,n1)+daanc6l(1,1)
1616 daanc6(1,2,n1) = daanc6(1,2,n1)+daanc6l(1,2)
1617 daanc6(1,3,n1) = daanc6(1,3,n1)+daanc6l(1,3)
1618 daanc6(1,4,n1) = daanc6(1,4,n1)+daanc6l(1,4)
1619 daanc6(1,5,n1) = daanc6(1,5,n1)+daanc6l(1,5)
1620 daanc6(1,6,n1) = daanc6(1,6,n1)+daanc6l(1,6)
1621 daanc6(2,1,n1) = daanc6(2,1,n1)+daanc6l(2,1)
1622 daanc6(2,2,n1) = daanc6(2,2,n1)+daanc6l(2,2)
1623 daanc6(2,3,n1) = daanc6(2,3,n1)+daanc6l(2,3)
1624 daanc6(2,4,n1) = daanc6(2,4,n1)+daanc6l(2,4)
1625 daanc6(2,5,n1) = daanc6(2,5,n1)+daanc6l(2,5)
1626 daanc6(2,6,n1) = daanc6(2,6,n1)+daanc6l(2,6)
1627 daanc6(3,1,n1) = daanc6(3,1,n1)+daanc6l(3,1)
1628 daanc6(3,2,n1) = daanc6(3,2,n1)+daanc6l(3,2)
1629 daanc6(3,3,n1) = daanc6(3,3,n1)+daanc6l(3,3)
1630 daanc6(3,4,n1) = daanc6(3,4,n1)+daanc6l(3,4)
1631 daanc6(3,5,n1) = daanc6(3,5,n1)+daanc6l(3,5)
1632 daanc6(3,6,n1) = daanc6(3,6,n1)+daanc6l(3,6)
1633 CALL getdpdaanc(daanc6l,bufr(14+inc,i),iresp,inc)
1634 daanc6(1,1,n2) = daanc6(1,1,n2)+daanc6l(1,1)
1635 daanc6(1,2,n2) = daanc6(1,2,n2)+daanc6l(1,2)
1636 daanc6(1,3,n2) = daanc6(1,3,n2)+daanc6l(1,3)
1637 daanc6(1,4,n2) = daanc6(1,4,n2)+daanc6l(1,4)
1638 daanc6(1,5,n2) = daanc6(1,5,n2)+daanc6l(1,5)
1639 daanc6(1,6,n2) = daanc6(1,6,n2)+daanc6l(1,6)
1640 daanc6(2,1,n2) = daanc6(2,1,n2)+daanc6l(2,1)
1641 daanc6(2,2,n2) = daanc6(2,2,n2)+daanc6l(2,2)
1642 daanc6(2,3,n2) = daanc6(2,3,n2)+daanc6l(2,3)
1643 daanc6(2,4,n2) = daanc6(2,4,n2)+daanc6l(2,4)
1644 daanc6(2,5,n2) = daanc6(2,5,n2)+daanc6l(2,5)
1645 daanc6(2,6,n2) = daanc6(2,6,n2)+daanc6l(2,6)
1646 daanc6(3,1,n2) = daanc6(3,1,n2)+daanc6l(3,1)
1647 daanc6(3,2,n2) = daanc6(3,2,n2)+daanc6l(3,2)
1648 daanc6(3,3,n2) = daanc6(3,3,n2)+daanc6l(3,3)
1649 daanc6(3,4,n2) = daanc6(3,4,n2)+daanc6l(3,4)
1650 daanc6(3,5,n2) = daanc6(3,5,n2)+daanc6l(3,5)
1651 daanc6(3,6,n2) = daanc6(3,6,n2)+daanc6l(3,6)
1652 ENDDO
1653 ENDIF
1654C
1655C
1656C continue i7for3 and i10for3 processing on secondary node
1657C
1658 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
1659 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
1660 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
1661 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
1662C Anim FCONT
1663 DO i = 1, nb
1664 n = nint(bufr(1,i))
1665 n1 = ixlins(1,n)
1666 n2 = ixlins(2,n)
1667 n1g = nlg(n1)
1668 n2g = nlg(n2)
1669C
1670 fcont(1,n1g)=fcont(1,n1g)+bufr(2,i)
1671 fcont(2,n1g)=fcont(2,n1g)+bufr(3,i)
1672 fcont(3,n1g)=fcont(3,n1g)+bufr(4,i)
1673C
1674 fcont(1,n2g)=fcont(1,n2g)+bufr(5,i)
1675 fcont(2,n2g)=fcont(2,n2g)+bufr(6,i)
1676 fcont(3,n2g)=fcont(3,n2g)+bufr(7,i)
1677 END DO
1678 END IF
1679C
1680 IF(isecin>0)THEN
1681C Sections
1682 k0=nstrf(25)
1683 IF(nstrf(1)+nstrf(2)/=0)THEN
1684 DO i=1,nsect
1685 nbinter=nstrf(k0+14)
1686 k1s=k0+30
1687 DO j=1,nbinter
1688 IF(nstrf(k1s)==noint)THEN
1689 IF(isecut/=0)THEN
1690 IF(kdtint==0)THEN
1691 DO ii = 1, nb
1692 n = nint(bufr(1,ii))
1693 n1 = ixlins(1,n)
1694 n2 = ixlins(2,n)
1695 n1g = nlg(n1)
1696 n2g = nlg(n2)
1697 IF(secfcum(4,n1g,i)==1.)THEN
1698 secfcum(1,n1g,i)=secfcum(1,n1g,i)+bufr(2,ii)
1699 secfcum(2,n1g,i)=secfcum(2,n1g,i)+bufr(3,ii)
1700 secfcum(3,n1g,i)=secfcum(3,n1g,i)+bufr(4,ii)
1701 ENDIF
1702 IF(secfcum(4,n2g,i)==1.)THEN
1703 secfcum(1,n2g,i)=secfcum(1,n2g,i)+bufr(6,ii)
1704 secfcum(2,n2g,i)=secfcum(2,n2g,i)+bufr(7,ii)
1705 secfcum(3,n2g,i)=secfcum(3,n2g,i)+bufr(8,ii)
1706 ENDIF
1707 ENDDO
1708 ELSE
1709 DO ii = 1, nb
1710 n = nint(bufr(1,ii))
1711 n1 = ixlins(1,n)
1712 n2 = ixlins(2,n)
1713 n1g = nlg(n1)
1714 n2g = nlg(n2)
1715 IF(secfcum(4,n1g,i)==1.)THEN
1716 secfcum(1,n1g,i)=secfcum(1,n1g,i)+bufr(2,ii)
1717 secfcum(2,n1g,i)=secfcum(2,n1g,i)+bufr(3,ii)
1718 secfcum(3,n1g,i)=secfcum(3,n1g,i)+bufr(4,ii)
1719 ENDIF
1720 IF(secfcum(4,n2g,i)==1.)THEN
1721 secfcum(1,n2g,i)=secfcum(1,n2g,i)+bufr(7,ii)
1722 secfcum(2,n2g,i)=secfcum(2,n2g,i)+bufr(8,ii)
1723 secfcum(3,n2g,i)=secfcum(3,n2g,i)+bufr(9,ii)
1724 ENDIF
1725 ENDDO
1726 END IF
1727 ENDIF
1728 ENDIF
1729 k1s=k1s+1
1730 ENDDO
1731 k0=nstrf(k0+24)
1732 ENDDO
1733 ENDIF
1734 ENDIF
1735C
1736 IF(ibag/=0)THEN
1737C Airbags IBAG
1738 IF(kdtint==0)THEN
1739 DO i = 1, nb
1740 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
1741 + bufr(4,i)/=zero) THEN
1742 n = nint(bufr(1,i))
1743 n1 = ixlins(1,n)
1744 n1g = nlg(n1)
1745 icontact(n1g)=1
1746 END IF
1747 IF(bufr(6,i)/=zero.OR.bufr(7,i)/=zero.OR.
1748 + bufr(8,i)/=zero) THEN
1749 n = nint(bufr(1,i))
1750 n2 = ixlins(2,n)
1751 n2g = nlg(n2)
1752 icontact(n2g)=1
1753 END IF
1754 END DO
1755 ELSE
1756 DO i = 1, nb
1757 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
1758 + bufr(4,i)/=zero) THEN
1759 n = nint(bufr(1,i))
1760 n1 = ixlins(1,n)
1761 n1g = nlg(n1)
1762 icontact(n1g)=1
1763 END IF
1764 IF(bufr(7,i)/=zero.OR.bufr(8,i)/=zero.OR.
1765 + bufr(9,i)/=zero) THEN
1766 n = nint(bufr(1,i))
1767 n2 = ixlins(2,n)
1768 n2g = nlg(n2)
1769 icontact(n2g)=1
1770 END IF
1771 END DO
1772 END IF
1773 END IF
1774C
1775 RETURN
1776 END
1777C
1778C
1779!||====================================================================
1780!|| spmd_fiadd_pon ../engine/source/mpi/interfaces/spmd_i7tool.F
1781!||--- called by ------------------------------------------------------
1782!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
1783!||--- calls -----------------------------------------------------
1784!|| ancmsg ../engine/source/output/message/message.F
1785!|| arret ../engine/source/system/arret.F
1786!|| ibcoff ../engine/source/interfaces/interf/ibcoff.F
1787!||--- uses -----------------------------------------------------
1788!|| h3d_mod ../engine/share/modules/h3d_mod.F
1789!|| message_mod ../engine/share/message_module/message_mod.F
1790!|| output_mod ../common_source/modules/output/output_mod.F90
1791!|| parameters_mod ../common_source/modules/interfaces/parameters_mod.F
1792!||====================================================================
1793 SUBROUTINE spmd_fiadd_pon(OUTPUT,
1794 1 NB ,LEN ,BUFR ,NSV ,FSKYI,
1795 2 ISKY ,IBC ,ISECIN ,NOINT ,IBAG ,
1796 3 ICODT ,SECFCUM,NSTRF ,ICONTACT,FCONT,
1797 4 INACTI ,IADM ,INTTH ,FTHESKYI,CONDNSKYI,
1798 5 H3D_DATA,NIN ,TAGNCONT,KLOADPINTER,LOADPINTER ,
1799 6 LOADP_HYD_INTER,INTCAREA,FSAV ,PARAMETERS,NODADT_THERM)
1800C-----------------------------------------------
1801C M o d u l e s
1802C-----------------------------------------------
1803 USE message_mod
1804 USE h3d_mod
1805 USE output_mod
1806 USE parameters_mod
1807C-----------------------------------------------
1808C I m p l i c i t T y p e s
1809C-----------------------------------------------
1810#include "implicit_f.inc"
1811C-----------------------------------------------
1812C C o m m o n B l o c k s
1813C-----------------------------------------------
1814#include "parit_c.inc"
1815#include "scr07_c.inc"
1816#include "scr14_c.inc"
1817#include "scr16_c.inc"
1818#include "scr18_c.inc"
1819#include "com01_c.inc"
1820#include "com04_c.inc"
1821#include "com06_c.inc"
1822#include "com08_c.inc"
1823C-----------------------------------------------
1824C D u m m y A r g u m e n t s
1825C-----------------------------------------------
1826 TYPE(output_), intent(inout) :: output
1827 INTEGER nb, len, IBC ,isecin ,ibag , noint, INACTI,nin,
1828 . nsv(*), ISKY(*), ICODT(*), NSTRF(*),ICONTACT(*),
1829 . TAGNCONT(NLOADP_HYD_INTER,*),KLOADPINTER(*),LOADPINTER(*),
1830 . LOADP_HYD_INTER(*),
1831 . IADM,INTTH
1832 INTEGER ,INTENT(IN):: INTCAREA
1833 INTEGER, INTENT(IN) :: NODADT_THERM
1834 my_real
1835 . BUFR(LEN,*),
1836 . FSKYI(LSKYI,NFSKYI), SECFCUM(7,NUMNOD,NSECT),
1837 . FCONT(3,*),FTHESKYI(LSKYI),CONDNSKYI(LSKYI)
1838 my_real, INTENT(INOUT) :: FSAV(*)
1839 TYPE(H3D_DATABASE) :: H3D_DATA
1840 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
1841C-----------------------------------------------
1842C L o c a l V a r i a b l e s
1843C-----------------------------------------------
1844 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,
1845 . nisky_sav,temp_siz,ierror,pp,ppl,np
1846 my_real fsav29
1847C-----------------------------------------------
1848C S o u r c e L i n e s
1849C-----------------------------------------------
1850 IF ((nisky+nb)> lskyi)THEN
1851 CALL ancmsg(msgid=26,anmode=aninfo)
1852 CALL arret(2)
1853 ENDIF
1854C
1855 nisky_sav = nisky
1856 DO i = 1, nb
1857 n = nint(bufr(1,i))
1858 nod = nsv(n)
1859 nisky = nisky + 1
1860 fskyi(nisky,1)=bufr(2,i)
1861 fskyi(nisky,2)=bufr(3,i)
1862 fskyi(nisky,3)=bufr(4,i)
1863 fskyi(nisky,4)=bufr(5,i)
1864 isky(nisky) = nod
1865 ENDDO
1866 temp_siz=6
1867
1868 IF(kdtint /= 0 ) THEN
1869 nisky = nisky_sav
1870 DO i = 1, nb
1871 nisky = nisky + 1
1872 fskyi(nisky,5)=bufr(temp_siz,i)
1873 ENDDO
1874 temp_siz=temp_siz+1
1875 ENDIF
1876
1877 IF(intth /= 0 ) THEN
1878 nisky = nisky_sav
1879 DO i = 1, nb
1880 nisky = nisky + 1
1881 ftheskyi(nisky)=bufr(temp_siz,i)
1882 ENDDO
1883 temp_siz=temp_siz+1
1884
1885 IF(nodadt_therm ==1) THEN
1886 nisky = nisky_sav
1887 DO i = 1, nb
1888 nisky = nisky + 1
1889 condnskyi(nisky)=bufr(temp_siz,i)
1890 ENDDO
1891 temp_siz=temp_siz+1
1892 ENDIF
1893 ENDIF
1894
1895
1896C
1897C continue i7for3 and i10for3 processing on secondary node
1898C
1899 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
1900 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
1901 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
1902 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
1903C Anim FCONT
1904 DO i = 1, nb
1905 n = nint(bufr(1,i))
1906 nod = nsv(n)
1907 fcont(1,nod)=fcont(1,nod)+bufr(2,i)
1908 fcont(2,nod)=fcont(2,nod)+bufr(3,i)
1909 fcont(3,nod)=fcont(3,nod)+bufr(4,i)
1910 END DO
1911 END IF
1912C
1913C------------For /LOAD/PRESSURE tag nodes in contact-------------
1914 IF(nintloadp > 0) THEN
1915 DO i = 1, nb
1916 n = nint(bufr(1,i))
1917 nod = nsv(n)
1918 DO np = kloadpinter(nin)+1, kloadpinter(nin+1)
1919 pp = loadpinter(np)
1920 ppl = loadp_hyd_inter(pp)
1921 tagncont(ppl,nod) = 1
1922 ENDDO
1923 ENDDO
1924 ENDIF
1925C------------For outputting total contact area------------
1926c IF(INTCAREA > 0) THEN
1927c FSAV29 = ZERO
1928c DO I = 1, NB
1929c N = NINT(BUFR(1,I))
1930c NOD = NSV(N)
1931c FSAV29 = FSAV29 + PARAMETERS%INTAREAN(NOD)
1932c ENDDO
1933c FSAV(29) = FSAV(29) + FSAV29
1934c ENDIF
1935C
1936C
1937 IF(isecin>0)THEN
1938C Sections
1939 k0=nstrf(25)
1940 IF(nstrf(1)+nstrf(2)/=0)THEN
1941 DO i=1,nsect
1942 nbinter=nstrf(k0+14)
1943 k1s=k0+30
1944 DO j=1,nbinter
1945 IF(nstrf(k1s)==noint)THEN
1946 IF(isecut/=0)THEN
1947 DO ii = 1, nb
1948 n = nint(bufr(1,ii))
1949 nod = nsv(n)
1950 IF(secfcum(4,nod,i)==1.)THEN
1951 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
1952 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
1953 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
1954 ENDIF
1955 ENDDO
1956 ENDIF
1957 ENDIF
1958 k1s=k1s+1
1959 ENDDO
1960 k0=nstrf(k0+24)
1961 ENDDO
1962 ENDIF
1963 ENDIF
1964C
1965 IF((ibag/=0.AND.inacti/=7).OR.
1966 . (iadm/=0).OR.(idamp_rdof/=0))THEN ! warning conflict inacti=7 and ibag=3
1967C Airbags IBAG
1968 DO i = 1, nb
1969 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
1970 + bufr(4,i)/=zero) THEN
1971 n = nint(bufr(1,i))
1972 nod = nsv(n)
1973 icontact(nod)=1
1974 END IF
1975 END DO
1976 END IF
1977C
1978 IF(ibc/=0) THEN
1979 ibcm = ibc / 8
1980 ibcs = ibc - 8 * ibcm
1981C Boundary cond.
1982 IF(ibcs>0) THEN
1983 DO i = 1, nb
1984 n = nint(bufr(1,i))
1985 nod = nsv(n)
1986 CALL ibcoff(ibcs,icodt(nod))
1987 END DO
1988 END IF
1989 END IF
1990C
1991 RETURN
1992 END
1993!||====================================================================
1994!|| spmd_fiadd20f_pon ../engine/source/mpi/interfaces/spmd_i7tool.F
1995!||--- called by ------------------------------------------------------
1996!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
1997!||--- calls -----------------------------------------------------
1998!|| ancmsg ../engine/source/output/message/message.F
1999!|| arret ../engine/source/system/arret.F
2000!|| ibcoff ../engine/source/interfaces/interf/ibcoff.F
2001!||--- uses -----------------------------------------------------
2002!|| h3d_mod ../engine/share/modules/h3d_mod.F
2003!|| message_mod ../engine/share/message_module/message_mod.F
2004!|| output_mod ../common_source/modules/output/output_mod.F90
2005!||====================================================================
2006 SUBROUTINE spmd_fiadd20f_pon(OUTPUT,
2007 1 NB ,LEN ,BUFR ,NSV ,FSKYI,
2008 2 ISKY ,IBC ,ISECIN ,NOINT ,IBAG ,
2009 3 ICODT ,SECFCUM,NSTRF ,ICONTACT,FCONT,
2010 4 INACTI ,IADM ,INTTH ,FTHESKYI,NLG ,
2011 5 H3D_DATA )
2012C-----------------------------------------------
2013C M o d u l e s
2014C-----------------------------------------------
2015 USE message_mod
2016 USE h3d_mod
2017 USE output_mod
2018C-----------------------------------------------
2019C I m p l i c i t T y p e s
2020C-----------------------------------------------
2021#include "implicit_f.inc"
2022C-----------------------------------------------
2023C C o m m o n B l o c k s
2024C-----------------------------------------------
2025#include "parit_c.inc"
2026#include "scr07_c.inc"
2027#include "scr14_c.inc"
2028#include "scr16_c.inc"
2029#include "scr18_c.inc"
2030#include "com01_c.inc"
2031#include "com04_c.inc"
2032#include "com06_c.inc"
2033#include "com08_c.inc"
2034C-----------------------------------------------
2035C D u m m y A r g u m e n t s
2036C-----------------------------------------------
2037 TYPE(output_), intent(inout) :: OUTPUT
2038 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT, INACTI,
2039 . NSV(*), ISKY(*), ICODT(*), NSTRF(*), NLG(*),
2040 . ICONTACT(*), IADM,INTTH
2041 my_real
2042 . BUFR(LEN,*),
2043 . FSKYI(LSKYI,NFSKYI), SECFCUM(7,NUMNOD,NSECT),
2044 . FCONT(3,*),FTHESKYI(LSKYI)
2045 TYPE(H3D_DATABASE) :: H3D_DATA
2046C-----------------------------------------------
2047C L o c a l V a r i a b l e s
2048C-----------------------------------------------
2049 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER
2050C-----------------------------------------------
2051C S o u r c e L i n e s
2052C-----------------------------------------------
2053 IF ((nisky+nb)> lskyi)THEN
2054 CALL ancmsg(msgid=26,anmode=aninfo)
2055 CALL arret(2)
2056 ENDIF
2057C
2058 IF(intth == 0 ) THEN
2059 IF(kdtint==0)THEN
2060 DO i = 1, nb
2061 n = nint(bufr(1,i))
2062 nod = nlg(nsv(n))
2063 nisky = nisky + 1
2064 fskyi(nisky,1)=bufr(2,i)
2065 fskyi(nisky,2)=bufr(3,i)
2066 fskyi(nisky,3)=bufr(4,i)
2067 fskyi(nisky,4)=bufr(5,i)
2068 isky(nisky) = nod
2069 ENDDO
2070 ELSE
2071 DO i = 1, nb
2072 n = nint(bufr(1,i))
2073 nod = nlg(nsv(n))
2074 nisky = nisky + 1
2075 fskyi(nisky,1)=bufr(2,i)
2076 fskyi(nisky,2)=bufr(3,i)
2077 fskyi(nisky,3)=bufr(4,i)
2078 fskyi(nisky,4)=bufr(5,i)
2079 fskyi(nisky,5)=bufr(6,i)
2080 isky(nisky) = nod
2081 ENDDO
2082 ENDIF
2083C
2084C --- interface type 7 + thermal
2085C
2086 ELSE
2087 IF(kdtint==0)THEN
2088 DO i = 1, nb
2089 n = nint(bufr(1,i))
2090 nod = nlg(nsv(n))
2091 nisky = nisky + 1
2092 fskyi(nisky,1)=bufr(2,i)
2093 fskyi(nisky,2)=bufr(3,i)
2094 fskyi(nisky,3)=bufr(4,i)
2095 fskyi(nisky,4)=bufr(5,i)
2096 ftheskyi(nisky) =bufr(6,i)
2097 isky(nisky) = nod
2098 ENDDO
2099 ELSE
2100 DO i = 1, nb
2101 n = nint(bufr(1,i))
2102 nod = nlg(nsv(n))
2103 nisky = nisky + 1
2104 fskyi(nisky,1)=bufr(2,i)
2105 fskyi(nisky,2)=bufr(3,i)
2106 fskyi(nisky,3)=bufr(4,i)
2107 fskyi(nisky,4)=bufr(5,i)
2108 fskyi(nisky,5)=bufr(6,i)
2109 ftheskyi(nisky) =bufr(7,i)
2110 isky(nisky) = nod
2111 ENDDO
2112 ENDIF
2113 ENDIF
2114C
2115C continue i7for3 and i10for3 processing on secondary node
2116C
2117 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
2118 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
2119 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
2120 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
2121C Anim FCONT
2122 DO i = 1, nb
2123 n = nint(bufr(1,i))
2124 nod = nlg(nsv(n))
2125 fcont(1,nod)=fcont(1,nod)+bufr(2,i)
2126 fcont(2,nod)=fcont(2,nod)+bufr(3,i)
2127 fcont(3,nod)=fcont(3,nod)+bufr(4,i)
2128 END DO
2129 END IF
2130C
2131 IF(isecin>0)THEN
2132C Sections
2133 k0=nstrf(25)
2134 IF(nstrf(1)+nstrf(2)/=0)THEN
2135 DO i=1,nsect
2136 nbinter=nstrf(k0+14)
2137 k1s=k0+30
2138 DO j=1,nbinter
2139 IF(nstrf(k1s)==noint)THEN
2140 IF(isecut/=0)THEN
2141 DO ii = 1, nb
2142 n = nint(bufr(1,ii))
2143 nod = nlg(nsv(n))
2144 IF(secfcum(4,nod,i)==1.)THEN
2145 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
2146 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
2147 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
2148 ENDIF
2149 ENDDO
2150 ENDIF
2151 ENDIF
2152 k1s=k1s+1
2153 ENDDO
2154 k0=nstrf(k0+24)
2155 ENDDO
2156 ENDIF
2157 ENDIF
2158C
2159 IF((ibag/=0.AND.inacti/=7).OR.
2160 . iadm/=0)THEN ! warning conflict inacti=7 and ibag=3
2161C Airbags IBAG
2162 DO i = 1, nb
2163 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
2164 + bufr(4,i)/=zero) THEN
2165 n = nint(bufr(1,i))
2166 nod = nlg(nsv(n))
2167 icontact(nod)=1
2168 END IF
2169 END DO
2170 END IF
2171C
2172 IF(ibc/=0) THEN
2173 ibcm = ibc / 8
2174 ibcs = ibc - 8 * ibcm
2175C Boundary cond.
2176 IF(ibcs>0) THEN
2177 DO i = 1, nb
2178 n = nint(bufr(1,i))
2179 nod = nlg(nsv(n))
2180 CALL ibcoff(ibcs,icodt(nod))
2181 END DO
2182 END IF
2183 END IF
2184C
2185 RETURN
2186 END
2187
2188!||====================================================================
2189!|| spmd_fiadd11_pon ../engine/source/mpi/interfaces/spmd_i7tool.F
2190!||--- called by ------------------------------------------------------
2191!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
2192!||--- calls -----------------------------------------------------
2193!|| ancmsg ../engine/source/output/message/message.F
2194!|| arret ../engine/source/system/arret.F
2195!||--- uses -----------------------------------------------------
2196!|| h3d_mod ../engine/share/modules/h3d_mod.F
2197!|| message_mod ../engine/share/message_module/message_mod.F
2198!|| output_mod ../common_source/modules/output/output_mod.F90
2199!||====================================================================
2200 SUBROUTINE spmd_fiadd11_pon(OUTPUT,
2201 1 NB ,LEN ,BUFR ,IRECTS ,FSKYI,
2202 2 ISKY ,IBC ,ISECIN,NOINT ,IBAG ,
2203 3 ICODT ,SECFCUM,NSTRF ,ICONTACT,FCONT,
2204 4 INTTH ,FTHESKYI,CONDNSKYI,H3D_DATA,
2205 5 NIN ,TAGNCONT,KLOADPINTER,LOADPINTER,
2206 7 LOADP_HYD_INTER,NODADT_THERM)
2207C-----------------------------------------------
2208C M o d u l e s
2209C-----------------------------------------------
2210 USE message_mod
2211 USE h3d_mod
2212 USE output_mod
2213C-----------------------------------------------
2214C I m p l i c i t T y p e s
2215C-----------------------------------------------
2216#include "implicit_f.inc"
2217C-----------------------------------------------
2218C C o m m o n B l o c k s
2219C-----------------------------------------------
2220#include "parit_c.inc"
2221#include "scr07_c.inc"
2222#include "scr14_c.inc"
2223#include "scr16_c.inc"
2224#include "scr18_c.inc"
2225#include "com01_c.inc"
2226#include "com04_c.inc"
2227#include "com06_c.inc"
2228#include "com08_c.inc"
2229C-----------------------------------------------
2230C D u m m y A r g u m e n t s
2231C-----------------------------------------------
2232 TYPE(output_), intent(inout) :: OUTPUT
2233 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT,INTTH,NIN,
2234 . irects(2,*), isky(*), icodt(*), nstrf(*),
2235 . icontact(*),
2236 . tagncont(nloadp_hyd_inter,*),kloadpinter(*),loadpinter(*),
2237 . loadp_hyd_inter(*)
2238 INTEGER, INTENT(IN) :: NODADT_THERM
2239 my_real
2240 . BUFR(LEN,*),
2241 . FSKYI(LSKYI,NFSKYI), SECFCUM(7,NUMNOD,NSECT),
2242 . FCONT(3,*),FTHESKYI(*),CONDNSKYI(*)
2243 TYPE(H3D_DATABASE) :: H3D_DATA
2244C-----------------------------------------------
2245C L o c a l V a r i a b l e s
2246C-----------------------------------------------
2247 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER,PP,PPL,NOD1,NOD2,NP
2248C-----------------------------------------------
2249C S o u r c e L i n e s
2250C-----------------------------------------------
2251 IF ((nisky+nb)> lskyi)THEN
2252 CALL ancmsg(msgid=26,anmode=aninfo)
2253 CALL arret(2)
2254 ENDIF
2255
2256 IF(intth == 0 ) THEN
2257 IF(kdtint==0)THEN
2258 DO i = 1, nb
2259 n = nint(bufr(1,i))
2260 nod = irects(1,n)
2261 nisky = nisky + 1
2262 fskyi(nisky,1)=bufr(2,i)
2263 fskyi(nisky,2)=bufr(3,i)
2264 fskyi(nisky,3)=bufr(4,i)
2265 fskyi(nisky,4)=bufr(5,i)
2266 isky(nisky) = nod
2267 nod = irects(2,n)
2268 nisky = nisky + 1
2269 fskyi(nisky,1)=bufr(6,i)
2270 fskyi(nisky,2)=bufr(7,i)
2271 fskyi(nisky,3)=bufr(8,i)
2272 fskyi(nisky,4)=bufr(9,i)
2273 isky(nisky) = nod
2274 ENDDO
2275 ELSE
2276 DO i = 1, nb
2277 n = nint(bufr(1,i))
2278 nod = irects(1,n)
2279 nisky = nisky + 1
2280 fskyi(nisky,1)=bufr(2,i)
2281 fskyi(nisky,2)=bufr(3,i)
2282 fskyi(nisky,3)=bufr(4,i)
2283 fskyi(nisky,4)=bufr(5,i)
2284 fskyi(nisky,5)=bufr(6,i)
2285 isky(nisky) = nod
2286 nod = irects(2,n)
2287 nisky = nisky + 1
2288 fskyi(nisky,1)=bufr(7,i)
2289 fskyi(nisky,2)=bufr(8,i)
2290 fskyi(nisky,3)=bufr(9,i)
2291 fskyi(nisky,4)=bufr(10,i)
2292 fskyi(nisky,5)=bufr(11,i)
2293 isky(nisky) = nod
2294 ENDDO
2295 ENDIF
2296 ELSE
2297 IF(nodadt_therm == 1) THEN ! Thermal Time Step
2298 IF(kdtint==0)THEN
2299 DO i = 1, nb
2300 n = nint(bufr(1,i))
2301 nod = irects(1,n)
2302 nisky = nisky + 1
2303 fskyi(nisky,1)=bufr(2,i)
2304 fskyi(nisky,2)=bufr(3,i)
2305 fskyi(nisky,3)=bufr(4,i)
2306 fskyi(nisky,4)=bufr(5,i)
2307 ftheskyi(nisky) =bufr(10,i)
2308 condnskyi(nisky)=bufr(12,i)
2309 isky(nisky) = nod
2310 nod = irects(2,n)
2311 nisky = nisky + 1
2312 fskyi(nisky,1)=bufr(6,i)
2313 fskyi(nisky,2)=bufr(7,i)
2314 fskyi(nisky,3)=bufr(8,i)
2315 fskyi(nisky,4)=bufr(9,i)
2316 ftheskyi(nisky) =bufr(11,i)
2317 condnskyi(nisky)=bufr(13,i)
2318 isky(nisky) = nod
2319 ENDDO
2320 ELSE
2321 DO i = 1, nb
2322 n = nint(bufr(1,i))
2323 nod = irects(1,n)
2324 nisky = nisky + 1
2325 fskyi(nisky,1)=bufr(2,i)
2326 fskyi(nisky,2)=bufr(3,i)
2327 fskyi(nisky,3)=bufr(4,i)
2328 fskyi(nisky,4)=bufr(5,i)
2329 fskyi(nisky,5)=bufr(6,i)
2330 ftheskyi(nisky) =bufr(12,i)
2331 condnskyi(nisky)=bufr(13,i)
2332 isky(nisky) = nod
2333 nod = irects(2,n)
2334 nisky = nisky + 1
2335 fskyi(nisky,1)=bufr(7,i)
2336 fskyi(nisky,2)=bufr(8,i)
2337 fskyi(nisky,3)=bufr(9,i)
2338 fskyi(nisky,4)=bufr(10,i)
2339 fskyi(nisky,5)=bufr(11,i)
2340 ftheskyi(nisky) =bufr(13,i)
2341 condnskyi(nisky)=bufr(14,i)
2342 isky(nisky) = nod
2343 ENDDO
2344 ENDIF
2345 ELSE
2346 IF(kdtint==0)THEN
2347 DO i = 1, nb
2348 n = nint(bufr(1,i))
2349 nod = irects(1,n)
2350 nisky = nisky + 1
2351 fskyi(nisky,1)=bufr(2,i)
2352 fskyi(nisky,2)=bufr(3,i)
2353 fskyi(nisky,3)=bufr(4,i)
2354 fskyi(nisky,4)=bufr(5,i)
2355 ftheskyi(nisky) =bufr(10,i)
2356 isky(nisky) = nod
2357 nod = irects(2,n)
2358 nisky = nisky + 1
2359 fskyi(nisky,1)=bufr(6,i)
2360 fskyi(nisky,2)=bufr(7,i)
2361 fskyi(nisky,3)=bufr(8,i)
2362 fskyi(nisky,4)=bufr(9,i)
2363 ftheskyi(nisky) =bufr(11,i)
2364 isky(nisky) = nod
2365 ENDDO
2366 ELSE
2367 DO i = 1, nb
2368 n = nint(bufr(1,i))
2369 nod = irects(1,n)
2370 nisky = nisky + 1
2371 fskyi(nisky,1)=bufr(2,i)
2372 fskyi(nisky,2)=bufr(3,i)
2373 fskyi(nisky,3)=bufr(4,i)
2374 fskyi(nisky,4)=bufr(5,i)
2375 fskyi(nisky,5)=bufr(6,i)
2376 ftheskyi(nisky) =bufr(12,i)
2377 isky(nisky) = nod
2378 nod = irects(2,n)
2379 nisky = nisky + 1
2380 fskyi(nisky,1)=bufr(7,i)
2381 fskyi(nisky,2)=bufr(8,i)
2382 fskyi(nisky,3)=bufr(9,i)
2383 fskyi(nisky,4)=bufr(10,i)
2384 fskyi(nisky,5)=bufr(11,i)
2385 ftheskyi(nisky) =bufr(13,i)
2386 isky(nisky) = nod
2387 ENDDO
2388 ENDIF
2389 ENDIF
2390 ENDIF
2391C
2392C continue i11for3 processing on secondary node
2393C
2394 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
2395 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
2396 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
2397 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
2398C Anim FCONT
2399 IF(kdtint==0)THEN
2400 DO i = 1, nb
2401 n = nint(bufr(1,i))
2402 nod = irects(1,n)
2403 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
2404 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
2405 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
2406 nod = irects(2,n)
2407 fcont(1,nod)=fcont(1,nod)+ bufr(6,i)
2408 fcont(2,nod)=fcont(2,nod)+ bufr(7,i)
2409 fcont(3,nod)=fcont(3,nod)+ bufr(8,i)
2410 END DO
2411 ELSE
2412 DO i = 1, nb
2413 n = nint(bufr(1,i))
2414 nod = irects(1,n)
2415 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
2416 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
2417 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
2418 nod = irects(2,n)
2419 fcont(1,nod)=fcont(1,nod)+ bufr(7,i)
2420 fcont(2,nod)=fcont(2,nod)+ bufr(8,i)
2421 fcont(3,nod)=fcont(3,nod)+ bufr(9,i)
2422 END DO
2423 END IF
2424 END IF
2425C
2426C------------For /LOAD/PRESSURE tag nodes in contact-------------
2427 IF(nintloadp > 0) THEN
2428 DO i = 1, nb
2429 n = nint(bufr(1,i))
2430 nod1 = irects(1,n)
2431 nod2 = irects(2,n)
2432 DO np = kloadpinter(nin)+1, kloadpinter(nin+1)
2433 pp = loadpinter(np)
2434 ppl = loadp_hyd_inter(pp)
2435 tagncont(ppl,nod1) = 1
2436 tagncont(ppl,nod2) = 1
2437 ENDDO
2438 ENDDO
2439 ENDIF
2440C
2441 IF(isecin>0)THEN
2442C Sections
2443 k0=nstrf(25)
2444 IF(nstrf(1)+nstrf(2)/=0)THEN
2445 DO i=1,nsect
2446 nbinter=nstrf(k0+14)
2447 k1s=k0+30
2448 DO j=1,nbinter
2449 IF(nstrf(k1s)==noint)THEN
2450 IF(isecut/=0)THEN
2451 IF(kdtint==0)THEN
2452 DO ii = 1, nb
2453 n = nint(bufr(1,ii))
2454 nod = irects(1,n)
2455 IF(secfcum(4,nod,i)==1.)THEN
2456 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
2457 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
2458 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
2459 ENDIF
2460 nod = irects(2,n)
2461 IF(secfcum(4,nod,i)==1.)THEN
2462 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(6,ii)
2463 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(7,ii)
2464 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(8,ii)
2465 ENDIF
2466 ENDDO
2467 ELSE
2468 DO ii = 1, nb
2469 n = nint(bufr(1,ii))
2470 nod = irects(1,n)
2471 IF(secfcum(4,nod,i)==1.)THEN
2472 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
2473 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
2474 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
2475 ENDIF
2476 nod = irects(2,n)
2477 IF(secfcum(4,nod,i)==1.)THEN
2478 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(7,ii)
2479 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(8,ii)
2480 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(9,ii)
2481 ENDIF
2482 ENDDO
2483 END IF
2484 ENDIF
2485 ENDIF
2486 k1s=k1s+1
2487 ENDDO
2488 k0=nstrf(k0+24)
2489 ENDDO
2490 ENDIF
2491 ENDIF
2492C
2493 IF((ibag/=0).OR.(idamp_rdof/=0))THEN
2494C Airbags IBAG
2495 IF(kdtint==0)THEN
2496 DO i = 1, nb
2497 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
2498 + bufr(4,i)/=zero) THEN
2499 n = nint(bufr(1,i))
2500 nod = irects(1,n)
2501 icontact(nod)=1
2502 END IF
2503 IF(bufr(6,i)/=zero.OR.bufr(7,i)/=zero.OR.
2504 + bufr(8,i)/=zero) THEN
2505 nod = irects(2,n)
2506 icontact(nod)=1
2507 END IF
2508 END DO
2509 ELSE
2510 DO i = 1, nb
2511 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
2512 + bufr(4,i)/=zero) THEN
2513 n = nint(bufr(1,i))
2514 nod = irects(1,n)
2515 icontact(nod)=1
2516 END IF
2517 IF(bufr(7,i)/=zero.OR.bufr(8,i)/=zero.OR.
2518 + bufr(9,i)/=zero) THEN
2519 nod = irects(2,n)
2520 icontact(nod)=1
2521 END IF
2522 END DO
2523 END IF
2524 END IF
2525C
2526 RETURN
2527 END
2528C
2529!||====================================================================
2530!|| spmd_fiadd20fe_pon ../engine/source/mpi/interfaces/spmd_i7tool.f
2531!||--- called by ------------------------------------------------------
2532!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
2533!||--- calls -----------------------------------------------------
2534!|| ancmsg ../engine/source/output/message/message.F
2535!|| arret ../engine/source/system/arret.F
2536!||--- uses -----------------------------------------------------
2537!|| h3d_mod ../engine/share/modules/h3d_mod.F
2538!|| message_mod ../engine/share/message_module/message_mod.F
2539!|| output_mod ../common_source/modules/output/output_mod.F90
2540!||====================================================================
2541 SUBROUTINE spmd_fiadd20fe_pon(OUTPUT,
2542 1 NB ,LEN ,BUFR ,IRECTS ,FSKYI,
2543 2 ISKY ,IBC ,ISECIN,NOINT ,IBAG ,
2544 3 ICODT ,SECFCUM,NSTRF ,ICONTACT,FCONT,
2545 4 NLG ,H3D_DATA)
2546C-----------------------------------------------
2547C M o d u l e s
2548C-----------------------------------------------
2549 USE message_mod
2550 USE h3d_mod
2551 USE output_mod
2552C-----------------------------------------------
2553C I m p l i c i t T y p e s
2554C-----------------------------------------------
2555#include "implicit_f.inc"
2556C-----------------------------------------------
2557C C o m m o n B l o c k s
2558C-----------------------------------------------
2559#include "parit_c.inc"
2560#include "scr07_c.inc"
2561#include "scr14_c.inc"
2562#include "scr16_c.inc"
2563#include "scr18_c.inc"
2564#include "com01_c.inc"
2565#include "com04_c.inc"
2566#include "com06_c.inc"
2567#include "com08_c.inc"
2568C-----------------------------------------------
2569C D u m m y A r g u m e n t s
2570C-----------------------------------------------
2571 TYPE(output_), INTENT(INOUT) :: OUTPUT
2572 INTEGER NB, LEN, IBC ,ISECIN ,IBAG , NOINT,
2573 . IRECTS(2,*), ISKY(*), ICODT(*), NSTRF(*),
2574 . icontact(*),nlg(*)
2575 my_real
2576 . bufr(len,*),
2577 . fskyi(lskyi,nfskyi), secfcum(7,numnod,nsect),
2578 . fcont(3,*)
2579 TYPE(h3d_database) :: H3D_DATA
2580C-----------------------------------------------
2581C L o c a l V a r i a b l e s
2582C-----------------------------------------------
2583 INTEGER I, J, II, N, NOD, K0, K1S, IBCS, IBCM, NBINTER
2584C-----------------------------------------------
2585C S o u r c e L i n e s
2586C-----------------------------------------------
2587 IF ((NISKY+NB)> LSKYI)THEN
2588 CALL ANCMSG(MSGID=26,anmode=aninfo)
2589 CALL arret(2)
2590 ENDIF
2591
2592 IF(kdtint==0)THEN
2593 DO i = 1, nb
2594 n = nint(bufr(1,i))
2595 nod = nlg(irects(1,n))
2596 nisky = nisky + 1
2597 fskyi(nisky,1)=bufr(2,i)
2598 fskyi(nisky,2)=bufr(3,i)
2599 fskyi(nisky,3)=bufr(4,i)
2600 fskyi(nisky,4)=bufr(5,i)
2601 isky(nisky) = nod
2602 nod = nlg(irects(2,n))
2603 nisky = nisky + 1
2604 fskyi(nisky,1)=bufr(6,i)
2605 fskyi(nisky,2)=bufr(7,i)
2606 fskyi(nisky,3)=bufr(8,i)
2607 fskyi(nisky,4)=bufr(9,i)
2608 isky(nisky) = nod
2609 ENDDO
2610 ELSE
2611 DO i = 1, nb
2612 n = nint(bufr(1,i))
2613 nod = nlg(irects(1,n))
2614 nisky = nisky + 1
2615 fskyi(nisky,1)=bufr(2,i)
2616 fskyi(nisky,2)=bufr(3,i)
2617 fskyi(nisky,3)=bufr(4,i)
2618 fskyi(nisky,4)=bufr(5,i)
2619 fskyi(nisky,5)=bufr(6,i)
2620 isky(nisky) = nod
2621 nod = nlg(irects(2,n))
2622 nisky = nisky + 1
2623 fskyi(nisky,1)=bufr(7,i)
2624 fskyi(nisky,2)=bufr(8,i)
2625 fskyi(nisky,3)=bufr(9,i)
2626 fskyi(nisky,4)=bufr(10,i)
2627 fskyi(nisky,5)=bufr(11,i)
2628 isky(nisky) = nod
2629 ENDDO
2630 ENDIF
2631C
2632C continue i11for3 processing on secondary node
2633C
2634 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
2635 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
2636 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
2637 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
2638C Anim FCONT
2639 IF(kdtint==0)THEN
2640 DO i = 1, nb
2641 n = nint(bufr(1,i))
2642 nod = nlg(irects(1,n))
2643 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
2644 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
2645 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
2646 nod = nlg(irects(2,n))
2647 fcont(1,nod)=fcont(1,nod)+ bufr(6,i)
2648 fcont(2,nod)=fcont(2,nod)+ bufr(7,i)
2649 fcont(3,nod)=fcont(3,nod)+ bufr(8,i)
2650 END DO
2651 ELSE
2652 DO i = 1, nb
2653 n = nint(bufr(1,i))
2654 nod = nlg(irects(1,n))
2655 fcont(1,nod)=fcont(1,nod)+ bufr(2,i)
2656 fcont(2,nod)=fcont(2,nod)+ bufr(3,i)
2657 fcont(3,nod)=fcont(3,nod)+ bufr(4,i)
2658 nod = nlg(irects(2,n))
2659 fcont(1,nod)=fcont(1,nod)+ bufr(7,i)
2660 fcont(2,nod)=fcont(2,nod)+ bufr(8,i)
2661 fcont(3,nod)=fcont(3,nod)+ bufr(9,i)
2662 END DO
2663 END IF
2664 END IF
2665C
2666 IF(isecin>0)THEN
2667C Sections
2668 k0=nstrf(25)
2669 IF(nstrf(1)+nstrf(2)/=0)THEN
2670 DO i=1,nsect
2671 nbinter=nstrf(k0+14)
2672 k1s=k0+30
2673 DO j=1,nbinter
2674 IF(nstrf(k1s)==noint)THEN
2675 IF(isecut/=0)THEN
2676 IF(kdtint==0)THEN
2677 DO ii = 1, nb
2678 n = nint(bufr(1,ii))
2679 nod = nlg(irects(1,n))
2680 IF(secfcum(4,nod,i)==1.)THEN
2681 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
2682 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
2683 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
2684 ENDIF
2685 nod = nlg(irects(2,n))
2686 IF(secfcum(4,nod,i)==1.)THEN
2687 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(6,ii)
2688 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(7,ii)
2689 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(8,ii)
2690 ENDIF
2691 ENDDO
2692 ELSE
2693 DO ii = 1, nb
2694 n = nint(bufr(1,ii))
2695 nod = nlg(irects(1,n))
2696 IF(secfcum(4,nod,i)==1.)THEN
2697 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(2,ii)
2698 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(3,ii)
2699 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(4,ii)
2700 ENDIF
2701 nod = nlg(irects(2,n))
2702 IF(secfcum(4,nod,i)==1.)THEN
2703 secfcum(1,nod,i)=secfcum(1,nod,i)+bufr(7,ii)
2704 secfcum(2,nod,i)=secfcum(2,nod,i)+bufr(8,ii)
2705 secfcum(3,nod,i)=secfcum(3,nod,i)+bufr(9,ii)
2706 ENDIF
2707 ENDDO
2708 END IF
2709 ENDIF
2710 ENDIF
2711 k1s=k1s+1
2712 ENDDO
2713 k0=nstrf(k0+24)
2714 ENDDO
2715 ENDIF
2716 ENDIF
2717C
2718 IF(ibag/=0)THEN
2719C Airbags IBAG
2720 IF(kdtint==0)THEN
2721 DO i = 1, nb
2722 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
2723 + bufr(4,i)/=zero) THEN
2724 n = nint(bufr(1,i))
2725 nod = nlg(irects(1,n))
2726 icontact(nod)=1
2727 END IF
2728 IF(bufr(6,i)/=zero.OR.bufr(7,i)/=zero.OR.
2729 + bufr(8,i)/=zero) THEN
2730 nod = nlg(irects(2,n))
2731 icontact(nod)=1
2732 END IF
2733 END DO
2734 ELSE
2735 DO i = 1, nb
2736 IF(bufr(2,i)/=zero.OR.bufr(3,i)/=zero.OR.
2737 + bufr(4,i)/=zero) THEN
2738 n = nint(bufr(1,i))
2739 nod = nlg(irects(1,n))
2740 icontact(nod)=1
2741 END IF
2742 IF(bufr(7,i)/=zero.OR.bufr(8,i)/=zero.OR.
2743 + bufr(9,i)/=zero) THEN
2744 nod = nlg(irects(2,n))
2745 icontact(nod)=1
2746 END IF
2747 END DO
2748 END IF
2749 END IF
2750C
2751 RETURN
2752 END
2753C
2754!||====================================================================
2755!|| spmd_fiadd17_pon ../engine/source/mpi/interfaces/spmd_i7tool.F
2756!||--- called by ------------------------------------------------------
2757!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
2758!||--- uses -----------------------------------------------------
2759!|| element_mod ../common_source/modules/elements/element_mod.F90
2760!|| h3d_mod ../engine/share/modules/h3d_mod.F
2761!|| output_mod ../common_source/modules/output/output_mod.F90
2762!||====================================================================
2763 SUBROUTINE spmd_fiadd17_pon(OUTPUT,
2764 1 NB ,LEN ,BUFR ,NELEMS ,FSKYI ,
2765 2 ISKY ,FCONT ,IXS ,IXS16 ,H3D_DATA )
2766C-----------------------------------------------
2767C M o d u l e s
2768C-----------------------------------------------
2769 USE h3d_mod
2770 USE output_mod
2771 use element_mod , only : nixs
2772C-----------------------------------------------
2773C I m p l i c i t T y p e s
2774C-----------------------------------------------
2775#include "implicit_f.inc"
2776C-----------------------------------------------
2777C C o m m o n B l o c k s
2778C-----------------------------------------------
2779#include "parit_c.inc"
2780#include "scr07_c.inc"
2781#include "scr14_c.inc"
2782#include "scr16_c.inc"
2783#include "com04_c.inc"
2784#include "com06_c.inc"
2785#include "com08_c.inc"
2786C-----------------------------------------------
2787C D u m m y A r g u m e n t s
2788C-----------------------------------------------
2789 TYPE(output_), INTENT(INOUT) :: output
2790 INTEGER nb, len,
2791 . nelems(*), isky(*), ixs(nixs,*), ixs16(8,*)
2792 my_real bufr(len,*),
2793 . fskyi(lskyi,nfskyi),
2794 . fcont(3,*)
2795 TYPE(h3d_database) :: H3D_DATA
2796C-----------------------------------------------
2797C L o c a l V a r i a b l e s
2798C-----------------------------------------------
2799 INTEGER I, J, II, IIIS, NOD, IES, NN
2800C-----------------------------------------------
2801C S o u r c e L i n e s
2802C-----------------------------------------------
2803 DO i = 1, nb
2804 nn = nint(bufr(1,i))
2805 ies = nelems(nn)
2806 DO ii =1,8
2807 iiis = nint(bufr(6+(ii-1)*5,i))
2808 IF(iiis<=8)THEN
2809 nod = ixs(iiis+1,ies)
2810 ELSE
2811 nod = ixs16(iiis-8,ies-numels8-numels10-numels20)
2812 END IF
2813 nisky = nisky + 1
2814 fskyi(nisky,1)=bufr(2+(ii-1)*5,i)
2815 fskyi(nisky,2)=bufr(3+(ii-1)*5,i)
2816 fskyi(nisky,3)=bufr(4+(ii-1)*5,i)
2817 fskyi(nisky,4)=bufr(5+(ii-1)*5,i)
2818 isky(nisky) = nod
2819 END DO
2820 END DO
2821C
2822C following i11for3 process on secondary nodes
2823C
2824 IF((anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0.AND.
2825 . ((tt>=output%TANIM .AND. tt<=output%TANIM_STOP).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
2826 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
2827 . .OR.anim_v(26)+h3d_data%N_VECT_CONT_MAX>0)THEN
2828C Anim FCONT
2829 DO i = 1, nb
2830 ies = nelems(nint(bufr(1,i)))
2831 DO ii =1,8
2832 iiis = nint(bufr(6+(ii-1)*5,i))
2833c IIIS = NINT(BUFR(10+(II-1)*5,I))
2834 IF(iiis<=8)THEN
2835 nod = ixs(iiis+1,ies)
2836 ELSE
2837 nod = ixs16(iiis-8,ies-numels8-numels10-numels20)
2838 END IF
2839 fcont(1,nod)=fcont(1,nod)+ bufr(2+(ii-1)*5,i)
2840 fcont(2,nod)=fcont(2,nod)+ bufr(3+(ii-1)*5,i)
2841 fcont(3,nod)=fcont(3,nod)+ bufr(4+(ii-1)*5,i)
2842 END DO
2843 END DO
2844 END IF
2845C
2846 RETURN
2847 END
2848C
2849!||====================================================================
2850!|| mpp_init ../engine/source/mpi/interfaces/spmd_i7tool.F
2851!||--- called by ------------------------------------------------------
2852!|| resol_init ../engine/source/engine/resol_init.F
2853!||--- calls -----------------------------------------------------
2854!|| ancmsg ../engine/source/output/message/message.F
2855!|| my_orders ../common_source/tools/sort/my_orders.c
2856!|| spmd_ibcast ../engine/source/mpi/generic/spmd_ibcast.F
2857!|| spmd_split_comm ../engine/source/mpi/init/spmd_split_comm.F
2858!|| spmd_split_comm_inter ../engine/source/mpi/interfaces/spmd_split_comm_inter.F
2859!|| spmd_split_comm_joint ../engine/source/mpi/init/spmd_split_comm_joint.f
2860!||--- uses -----------------------------------------------------
2861!|| groupdef_mod ../common_source/modules/groupdef_mod.F
2862!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
2863!|| inter_sorting_mod ../engine/share/modules/inter_sorting_mod.F
2864!|| interface_modification_mod ../engine/share/modules/interface_modification_mod.F
2865!|| message_mod ../engine/share/message_module/message_mod.F
2866!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
2867!|| sensor_mod ../common_source/modules/sensor_mod.F90
2868!|| tri25ebox ../engine/share/modules/tri25ebox.F
2869!|| tri7box ../engine/share/modules/tri7box.F
2870!||====================================================================
2871 SUBROUTINE mpp_init(
2872 1 IPARI ,ISENDTO ,IRCVFROM,INTLIST ,NBINTC ,
2873 2 ISIZXV ,ILENXV ,IAD_ELEM,I2SIZE ,ITASK ,
2874 3 ISLEN7 ,IRLEN7 ,ISLEN11 ,IRLEN11 ,IGRBRIC ,
2875 4 NME17 ,ISLEN17 ,IRLEN17 ,IRLEN7T ,ISLEN7T ,
2876 5 LINDIDEL,LBUFIDEL,IRLEN20 ,ISLEN20 ,IRLEN20T,
2877 6 ISLEN20T,NBINT20 ,IRLEN20E,ISLEN20E,FR_RBY ,
2878 7 FR_RBY6 ,NPBY ,IRBKIN_L,NRBYKIN_L,KINDRBY,
2879 8 NSENSOR ,SENSOR_TAB,LBUFIDEL24,INTBUF_TAB,
2880 9 SORT_COMM,NEED_COMM_INT25_SOLID_EROSION,COMM_INT25_SOLID_EROSION )
2881C-----------------------------------------------
2882C M o d u l e s
2883C-----------------------------------------------
2884 USE tri7box
2885 USE tri25ebox
2886 USE message_mod
2887 USE intbufdef_mod
2888 USE groupdef_mod
2889 USE interface_modification_mod
2890 USE inter_sorting_mod
2891 USE sensor_mod
2892 USE my_alloc_mod
2893C-----------------------------------------------
2894C I m p l i c i t T y p e s
2895C-----------------------------------------------
2896#include "implicit_f.inc"
2897C-----------------------------------------------
2898C C o m m o n B l o c k s
2899C-----------------------------------------------
2900#include "com01_c.inc"
2901#include "com04_c.inc"
2902#include "com08_c.inc"
2903#include "scr17_c.inc"
2904#include "scr18_c.inc"
2905#include "task_c.inc"
2906#include "param_c.inc"
2907#include "units_c.inc"
2908#include "warn_c.inc"
2909#include "tabsiz_c.inc"
2910C common local to spmd_init and spmd_ring_mmx
2911 COMMON /ring/irecvf,isendt,iring
2912 INTEGER IRECVF,ISENDT,IRING
2913C-----------------------------------------------
2914C D u m m y A r g u m e n t s
2915C-----------------------------------------------
2916 INTEGER ,INTENT(IN) :: NSENSOR
2917 INTEGER ISENDTO(NINTER+1,NSPMD+1),
2918 . IRCVFROM(NINTER+1,NSPMD+1), IPARI(NPARI,*),
2919 . INTLIST(NINTER), IAD_ELEM(2,*),
2920 . NBINTC, ISIZXV, ILENXV, I2SIZE,ITASK,
2921 . ISLEN7, IRLEN7, ISLEN11, IRLEN11, NME17, ISLEN17, IRLEN17,
2922 . IRLEN7T, ISLEN7T, LINDIDEL, LBUFIDEL,
2923 . IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,NBINT20,
2924 . IRLEN20E, ISLEN20E, NRBYKIN_L, IRBKIN_L(*),KINDRBY(*),
2925 . FR_RBY(*), FR_RBY6(*), NPBY(NNPBY,*),LBUFIDEL24
2926 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
2927 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM ! structure for interface sorting comm
2928 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
2929 LOGICAL, DIMENSION(NSPMD), INTENT(inout) :: NEED_COMM_INT25_SOLID_EROSION !< boolean, true if the proc needs to comm some values related to interface type 25 with solid erosion
2930 INTEGER, INTENT(inout) :: COMM_INT25_SOLID_EROSION !< integer, sub-communicator related to interface type 25 with solid erosion
2931C-----------------------------------------------
2932 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
2933C-----------------------------------------------
2934C L o c a l V a r i a b l e s
2935C-----------------------------------------------
2936 INTEGER I, J, K, NSN, NMN, ITYP, IERROR, IERROR1, KK, NIN, P,
2937 . scpmax1,isd,irc,my_rank,last, ige, ign, nme, nmes,intth,
2938 . nrtm, nrts, nlinm, nlins,nsne, nmne,n,m,
2939 . work(70000),ity,noint,inacti,isens,interact
2940 INTEGER,DIMENSION(:), ALLOCATABLE:: INDX
2941 INTEGER,DIMENSION(:), ALLOCATABLE:: PPAR
2942 INTEGER,DIMENSION(:), ALLOCATABLE:: INDP
2943 INTEGER,DIMENSION(:), ALLOCATABLE:: NNP
2944 INTEGER,DIMENSION(:), ALLOCATABLE:: RANK
2945 INTEGER,DIMENSION(:), ALLOCATABLE:: IRBODY
2946 INTEGER,DIMENSION(:), ALLOCATABLE:: INDB
2947 INTEGER,DIMENSION(:), ALLOCATABLE:: NNSN
2948 my_real STARTT, STOPT,TS
2949C-----------------------------------------------
2950C S o u r c e L i n e s
2951C-----------------------------------------------
2952 CALL my_alloc(indx,2*ninter)
2953 CALL my_alloc(ppar,ninter)
2954 CALL my_alloc(indp,2*nspmd)
2955 CALL my_alloc(nnp,nspmd)
2956 CALL my_alloc(rank,nspmd)
2957 CALL my_alloc(irbody,numnod)
2958 CALL my_alloc(indb,2*nrbykin)
2959 CALL my_alloc(nnsn,nrbykin)
2960C-----------------------------------------------
2961C
2962C iexicodt : flag for sending icodt during run
2963 iexicodt = 0
2964C
2965 lindidel = 0
2966 lbufidel = 0
2967 lbufidel24 = 0
2968C
2969 !init ISENDTO/IRCVFROM
2970 DO i=1,ninter+1
2971 DO j=1,nspmd+1
2972 isendto(i,j)=0
2973 ircvfrom(i,j)=0
2974 ENDDO
2975 ENDDO
2976C
2977 !-----------------------------------------------
2978 IF(ninter/=0) THEN
2979C Case INACTI = 5, 6 or 7 + TSTART
2980 ALLOCATE(nsnfi_flag(ninter))
2981 nsnfi_flag(1:ninter)=0
2982
2983 DO i=1,ninter
2984 ity = ipari(7,i)
2985 IF(ity==7.OR.ity==10.OR.ity==11.OR.
2986 . ity==17.OR.ity==20.OR.
2987 . ity==22.OR.ity==23.OR.ity==24.OR.ity==25) THEN
2988 inacti=ipari(22,i)
2989 IF (inacti==5.OR.inacti==6.OR.inacti==7.OR.ity==23.OR.inacti==-1)THEN
2990C
2991 interact = 1
2992 isens = 0
2993 IF(ity == 7.OR.ity == 11.OR.ity == 24.OR.ity == 25)
2994 . isens = ipari(64,i)
2995 IF (isens > 0) THEN
2996 ts = sensor_tab(isens)%TSTART
2997 IF (ts>tt) interact = 0
2998 ELSE
2999 startt = intbuf_tab(i)%VARIABLES(3)
3000 stopt = intbuf_tab(i)%VARIABLES(11)
3001 IF (startt>tt) interact = 0
3002 ENDIF
3003C
3004 IF (interact==0)THEN
3005 noint =ipari(15,i)
3006C Printout Warning
3007 IF(ispmd==0)THEN
3008 CALL ancmsg(msgid=220,anmode=aninfo,
3009 * i1=noint,i2=inacti,r1=startt,r2=startt)
3010 ENDIF
3011 ENDIF
3012 IF (interact==0 .AND. ity /=25)THEN ! All but ITY == 25
3013 ALLOCATE(nsnfi_sav(i)%P(nspmd))
3014 ALLOCATE(nsnsi_sav(i)%P(nspmd))
3015 nsnfi_sav(i)%P(1:nspmd)=nsnfi(i)%P(1:nspmd)
3016 nsnfi(i)%P(1:nspmd)=0
3017 nsnsi_sav(i)%P(1:nspmd)=nsnsi(i)%P(1:nspmd)
3018 nsnsi(i)%P(1:nspmd)=0
3019
3020 nsnfi_flag(i)=1
3021 ENDIF
3022 ENDIF
3023 ENDIF
3024 ENDDO
3025
3026C
3027C Alloc Idel
3028C
3029 IF(idel7ng>0)THEN
3030 DO i = 1, ninter
3031 IF(ipari(17,i)>0)THEN
3032 ityp = ipari(7,i)
3033 nrts = ipari(3,i)
3034 nrtm = ipari(4,i)
3035 nsn = ipari(5,i)
3036 IF(ityp==7.OR.ityp==22.OR.
3037 . ityp==10.OR.ityp==5.OR.
3038 . ityp==23.OR.ityp==24.OR.
3039 . ityp==25)THEN
3040 lindidel = lindidel+nrtm
3041 lbufidel = lbufidel+4*nrtm+4
3042 IF(ityp==24.OR.ityp==25) lbufidel24 = lbufidel24 + nrtm
3043 ELSEIF(ityp==11)THEN
3044 lindidel = lindidel+nrtm+nrts
3045 lbufidel = lbufidel+2*(nrtm+nrts)+4
3046 ELSEIF(ityp==3)THEN
3047 lindidel = lindidel+nrtm+nrts
3048 lbufidel = lbufidel+4*(nrtm+nrts)+4
3049 ELSEIF(ityp==2)THEN
3050 lindidel = lindidel+nsn
3051 lbufidel = lbufidel+4*nsn+4
3052 ELSEIF(ityp==20)THEN
3053 lindidel = lindidel+nrtm
3054 lbufidel = lbufidel+4*nrtm+4
3055C Edge part
3056 nlins = ipari(51,i)
3057 nlinm = ipari(52,i)
3058 lindidel = lindidel+nlinm+nlins
3059 lbufidel = lbufidel+2*(nlinm+nlins)+4
3060 END IF
3061 END IF
3062 END DO
3063 END IF
3064C
3065 nme17=0
3066C
3067 DO i=1,ninter
3068 ityp = ipari(7,i)
3069 IF (ityp==7.OR.ityp==10.OR.ityp==22.OR.
3070 . ityp==11.OR.ityp==23.OR.ityp==24.OR.
3071 . ityp==25) THEN
3072 nsn = ipari(5,i)
3073 nmn = ipari(6,i)
3074 IF(nsn/=0) THEN
3075 isendto(i,ispmd+1)=nsn
3076 isendto(i,nspmd+1)=isendto(i,nspmd+1)+1
3077 isendto(ninter+1,ispmd+1)=isendto(ninter+1,ispmd+1)+nsn
3078 ENDIF
3079 IF(nmn/=0) THEN
3080 ircvfrom(i,ispmd+1) = nmn
3081 ircvfrom(i,nspmd+1)=ircvfrom(i,nspmd+1)+1
3082 ircvfrom(ninter+1,ispmd+1)=ircvfrom(ninter+1,ispmd+1)
3083 + +nmn
3084 ENDIF
3085
3086
3087 ELSEIF(ityp==17)THEN
3088 IF(ipari(33,i)==0)THEN
3089 ign = ipari(36,i)
3090 ige = ipari(34,i)
3091 nmes= igrbric(ign)%NENTITY
3092 nme = igrbric(ige)%NENTITY
3093 nme17 = nme17+nme+nmes
3094 IF(nmes/=0) THEN
3095 isendto(i,ispmd+1)=nmes
3096 isendto(i,nspmd+1)=isendto(i,nspmd+1)+1
3097 isendto(ninter+1,ispmd+1)=isendto(ninter+1,ispmd+1)
3098 + +nmes
3099 ENDIF
3100 IF(nme/=0) THEN
3101 ircvfrom(i,ispmd+1) = nme
3102 ircvfrom(i,nspmd+1)=ircvfrom(i,nspmd+1)+1
3103 ircvfrom(ninter+1,ispmd+1)=ircvfrom(ninter+1,ispmd+1)
3104 + +nme
3105 ENDIF
3106 END IF
3107 ELSEIF(ityp==20)THEN
3108 nsn = ipari(5,i)
3109 nmn = ipari(6,i)
3110C Edge part added
3111 nsne = ipari(55,i)
3112 nmne = ipari(56,i)
3113 IF(nsn+nsne/=0) THEN
3114 isendto(i,ispmd+1)=nsn+nsne
3115 isendto(i,nspmd+1)=isendto(i,nspmd+1)+1
3116 isendto(ninter+1,ispmd+1)=isendto(ninter+1,ispmd+1)
3117 + +nsn+nsne
3118 ENDIF
3119 IF(nmn+nmne/=0) THEN
3120 ircvfrom(i,ispmd+1) = nmn+nmne
3121 ircvfrom(i,nspmd+1)=ircvfrom(i,nspmd+1)+1
3122 ircvfrom(ninter+1,ispmd+1)=ircvfrom(ninter+1,ispmd+1)
3123 + +nmn+nmne
3124 ENDIF
3125 ENDIF
3126 ENDDO
3127C
3128 IF(nspmd > 1) THEN
3129 DO k = 1, nspmd
3130 CALL spmd_ibcast(isendto(1,k),isendto(1,k),ninter+1,1,
3131 . it_spmd(k),0)
3132 CALL spmd_ibcast(ircvfrom(1,k),ircvfrom(1,k),ninter+1,1,
3133 . it_spmd(k),0)
3134 ENDDO
3135 END IF
3136 DO i=1,ninter
3137 isendto(i,nspmd+1)=0
3138 ircvfrom(i,nspmd+1)=0
3139 DO k=1,nspmd
3140 IF(ircvfrom(i,k)/=0) THEN
3141 ircvfrom(i,nspmd+1)=ircvfrom(i,nspmd+1)+1
3142 ENDIF
3143 IF(isendto(i,k)/=0) THEN
3144 isendto(i,nspmd+1)=isendto(i,nspmd+1)+1
3145 ENDIF
3146 END DO
3147 END DO
3148 END IF !(NINTER/=0)
3149 !-----------------------------------------------
3150
3151 nbintc = 0
3152 DO i=1,ninter
3153 ityp = ipari(7,i)
3154 IF (ityp==7.OR.ityp==10.OR.ityp==11.OR.
3155 . (ityp==17.AND.ipari(33,i) == 0).OR.ityp==20.OR.
3156 . ityp==22.OR.ityp==23.OR.ityp==24.OR.ityp==25) THEN
3157 nbintc = nbintc + 1
3158 intlist(nbintc) = i
3159 scpmax1=0
3160 DO j=1,nspmd
3161 scpmax1=max(scpmax1,ircvfrom(i,j))
3162 ENDDO
3163 ppar(nbintc)=scpmax1
3164 ENDIF
3165 ENDDO
3166C
3167 CALL my_orders(0,work,ppar,indx,nbintc,1)
3168 DO i=1,nbintc
3169 indx(i+nbintc)=intlist(i)
3170 ENDDO
3171 DO i=1,nbintc
3172 intlist(i)=indx(indx(i)+nbintc)
3173 ENDDO
3174C
3175 IF(debug(3)>=1.AND.ispmd==0.AND.nspmd>1) THEN
3176 WRITE(istdo,*)'** interfaces nodal decomposition '
3177 WRITE(ISTDO,*)'#PROC NSN TOT NMN TOT TOTAL'
3178 WRITE(iout,*)'** INTERFACES NODAL DECOMPOSITION '
3179 WRITE(iout,*)'#PROC NSN TOT NMN TOT TOTAL'
3180 DO j = 1, nspmd
3181 isd = 0
3182 irc = 0
3183 DO i=1,ninter
3184 isd = isd + isendto(i,j)
3185 irc = irc + ircvfrom(i,j)
3186 ENDDO
3187 WRITE(istdo,'(I4,3X,I8,2X,I8,2X,I8)')j,isd,irc,isd+irc
3188 WRITE(iout,'(I4,3X,I8,2X,I8,2X,I8)')j,isd,irc,isd+irc
3189 ENDDO
3190 ENDIF
3191C
3192C preparation for communication in spmd_icrit
3193C
3194 DO k=1,nspmd
3195 nnp(k) = ircvfrom(ninter+1,k) + isendto(ninter+1,k)
3196 indp(k)=k
3197 END DO
3198 IF(nspmd > 1) CALL my_orders(0,work,nnp,indp,nspmd,1)
3199 DO k=1,nspmd
3200 rank(indp(k)) = k
3201 ENDDO
3202 irecvf = 0
3203 isendt = 0
3204 iring = 0
3205 IF(nnp(ispmd+1)>0)THEN
3206 my_rank = rank(ispmd+1)
3207 IF(my_rank>1)THEN
3208 last = indp(my_rank-1)
3209 IF(nnp(last)>0)THEN
3210 irecvf = last
3211 END IF
3212 END IF
3213 IF(my_rank==nspmd)THEN ! LAST PROC OF THE RING
3214 IF(irecvf/=0) isendt = -1 ! -1 : ENVOI A TS LE MONDE (SI COMM NECESSAIRE)
3215 ELSE ! PROCESSOR IN THE RING
3216 isendt = indp(my_rank+1)
3217 END IF
3218 IF(nspmd>1) THEN
3219 IF(nnp(indp(nspmd-1))>0)iring= indp(nspmd) ! IRING = NO OF THE LAST PROCESSOR IN THE RING (OR 0 IF NO RING NECESSARY)
3220 END IF
3221 END IF
3222C
3223C length com routine SPMD_SD_XV
3224C
3225 isizxv = 0
3226 DO i = 1, nspmd
3227 isizxv = isizxv + iad_elem(1,i+1)-iad_elem(2,i)
3228 ENDDO
3229
3230 ilenxv = 10 + 3*iroddl
3231C comm w
3232 IF(iale/=0.AND.ninter>0) ilenxv = ilenxv + 6
3233
3234 IF(idtmin(11)==3.OR.idtmin(10)==3) ilenxv = ilenxv + 2
3235C
3236C length com routine exch_a_int2_pon
3237C
3238 IF(iroddl==0) THEN
3239 i2size = 5
3240 ELSE
3241 i2size = 10
3242 ENDIF
3243C
3244C Comm routine length i7 xcom and i7 xcom
3245C
3246 islen7 = 0
3247 irlen7 = 0
3248 islen7t = 0
3249 irlen7t = 0
3250 islen11 = 0
3251 irlen11 = 0
3252 islen17 = 0
3253 irlen17 = 0
3254 irlen20 = 0
3255 islen20 = 0
3256 irlen20t = 0
3257 islen20t = 0
3258 irlen20e = 0
3259 islen20e = 0
3260 nbint20 = 0
3261
3262 irlen25e = 0
3263 islen25e = 0
3264
3265
3266 DO i = 1, nbintc
3267 nin = intlist(i)
3268 ityp = ipari(7,nin)
3269 intth = ipari(47,nin)
3270C type 7 or 10
3271 IF(ityp==7 .OR.ityp==10.OR.
3272 . ityp==23.OR.ityp==22.OR.ityp==24.OR.
3273 . ityp==25)THEN
3274 IF(intth == 0) THEN
3275 DO p = 1, nspmd
3276 islen7 = islen7 + nsnsi(nin)%P(p)
3277 irlen7 = irlen7 + nsnfi(nin)%P(p)
3278 END DO
3279 ELSE
3280 DO p = 1, nspmd
3281 islen7t = islen7t + nsnsi(nin)%P(p)
3282 irlen7t = irlen7t + nsnfi(nin)%P(p)
3283 END DO
3284 ENDIF
3285
3286 IF(ityp == 25 .AND. ipari(58,nin) >0) THEN
3287 islen25e= sum(nsnsie(nin)%P(1:nspmd))
3288 irlen25e= sum(nsnfie(nin)%P(1:nspmd))
3289 ENDIF
3290
3291 ELSEIF(ityp==11) THEN
3292C type 11
3293 DO p = 1, nspmd
3294 islen11 = islen11 + nsnsi(nin)%P(p)
3295 irlen11 = irlen11 + nsnfi(nin)%P(p)
3296 END DO
3297 ELSEIF(ityp==17.AND.ipari(33,nin)==0)THEN
3298C type 17 curvature
3299 DO p = 1, nspmd
3300 islen17 = islen17 + nsnsi(nin)%P(p)
3301 irlen17 = irlen17 + nsnfi(nin)%P(p)
3302 END DO
3303 ELSEIF(ityp==20)THEN
3304C type 20
3305 nbint20 = nbint20 + 1
3306 IF(intth == 0) THEN
3307 DO p = 1, nspmd
3308 islen20 = islen20 + nsnsi(nin)%P(p)
3309 irlen20 = irlen20 + nsnfi(nin)%P(p)
3310 islen20e= islen20e+ nsnsie(nin)%P(p)
3311 irlen20e= irlen20e+ nsnfie(nin)%P(p)
3312 END DO
3313 ELSE
3314 DO p = 1, nspmd
3315 islen20t = islen20t + nsnsi(nin)%P(p)
3316 irlen20t = irlen20t + nsnfi(nin)%P(p)
3317 islen20e = islen20e + nsnsie(nin)%P(p)
3318 irlen20e = irlen20e + nsnfie(nin)%P(p)
3319 END DO
3320 ENDIF
3321 END IF
3322 ENDDO
3323
3324 IF(nrbykin > 0) THEN
3325C
3326C Tempo RBY a remonter dans starter conversion no noeud vers no rigid body
3327C
3328 DO n=1,numnod
3329 irbody(n)=0
3330 END DO
3331C
3332 nrbykin_l=0
3333 k=1
3334 DO n=1,nrbykin
3335 m = npby(1,n)
3336 IF(m > 0) THEN
3337 irbody(m) = n
3338 nrbykin_l=nrbykin_l+1
3339 nnsn(nrbykin_l)=-npby(2,n)
3340 irbkin_l(nrbykin_l)=n
3341c ELSE
3342c if(NPBY(2,N) /= 0) print*,'error!!!'
3343 END IF
3344 kindrby(n)=k
3345 k=k+npby(2,n)
3346 END DO
3347C
3348 DO n = 1, sfr_rby
3349 fr_rby6(n)=irbody(fr_rby(n))
3350 END DO
3351C optimisation RBY
3352 CALL my_orders(0,work,nnsn,indb,nrbykin_l,1)
3353c if(ispmd==0)print*,'opt RBD:',NRBYKIN,NRBYKIN_L
3354 DO n = 1, nrbykin_l
3355 indb(nrbykin_l+n)=irbkin_l(n)
3356 END DO
3357 DO n = 1, nrbykin_l
3358 irbkin_l(n)=indb(nrbykin_l+indb(n))
3359c if(ispmd==0)print*,'>>>',N,NPBY(2,IRBKIN_L(N))
3360 END DO
3361 END IF
3362
3363 DO i=1,nbintc
3364 indx(i+nbintc)=intlist(i)
3365 ENDDO
3366 DO i=1,nbintc
3367 intlist(i)=indx(indx(i)+nbintc)
3368 ENDDO
3369C
3370C Create Contact Communicator
3371C
3372 CALL spmd_split_comm(
3373 . ircvfrom(ninter+1,ispmd+1)+isendto(ninter+1,ispmd+1),comm_cont)
3374
3375 IF(ninter/=0) CALL spmd_split_comm_inter( intbuf_tab, nbintc,intlist,ipari,isendto,ircvfrom,sort_comm,
3376 . need_comm_int25_solid_erosion,comm_int25_solid_erosion )
3377
3378! Create CJOINT communicator
3379 CALL spmd_split_comm_joint()
3380
3381 DEALLOCATE(indx)
3382 DEALLOCATE(ppar)
3383 DEALLOCATE(indp)
3384 DEALLOCATE(nnp)
3385 DEALLOCATE(rank)
3386 DEALLOCATE(irbody)
3387 DEALLOCATE(indb)
3388 DEALLOCATE(nnsn)
3389
3390 RETURN
3391 END
3392!||====================================================================
3393!|| spmd_initfi ../engine/source/mpi/interfaces/spmd_i7tool.F
3394!||--- called by ------------------------------------------------------
3395!|| rdresb ../engine/source/output/restart/rdresb.F
3396!||--- calls -----------------------------------------------------
3397!|| ancmsg ../engine/source/output/message/message.F
3398!|| arret ../engine/source/system/arret.F
3399!|| read_db ../common_source/tools/input_output/read_db.F
3400!|| read_i_c ../common_source/tools/input_output/write_routines.c
3401!|| read_r_c ../common_source/tools/input_output/write_routines.c
3402!||--- uses -----------------------------------------------------
3403!|| h3d_mod ../engine/share/modules/h3d_mod.F
3404!|| interface_modification_mod ../engine/share/modules/interface_modification_mod.F
3405!|| intstamp_glob_mod ../engine/share/modules/intstamp_glob_mod.F
3406!|| message_mod ../engine/share/message_module/message_mod.F
3407!|| parameters_mod ../common_source/modules/interfaces/parameters_mod.F
3408!|| tri25ebox ../engine/share/modules/tri25ebox.F
3409!|| tri7box ../engine/share/modules/tri7box.F
3410!||====================================================================
3411 SUBROUTINE spmd_initfi(IPARI,IFLAG,H3D_DATA,PARAMETERS,IDT_THERM,INTHEAT)
3412C-----------------------------------------------
3413C M o d u l e s
3414C-----------------------------------------------
3415 USE tri7box
3416 USE tri25ebox
3417 USE message_mod
3418 USE intstamp_glob_mod
3419 USE h3d_mod
3420 USE interface_modification_mod
3421 USE parameters_mod
3422C-----------------------------------------------
3423C I m p l i c i t T y p e s
3424C-----------------------------------------------
3425#include "implicit_f.inc"
3426#include "i25edge_c.inc"
3427C-----------------------------------------------
3428C C o m m o n B l o c k s
3429C-----------------------------------------------
3430#include "com01_c.inc"
3431#include "com04_c.inc"
3432#include "scr14_c.inc"
3433#include "scr16_c.inc"
3434#include "scr18_c.inc"
3435#include "task_c.inc"
3436#include "param_c.inc"
3437#include "parit_c.inc"
3438#include "spmd_c.inc"
3439#include "sms_c.inc"
3440C-----------------------------------------------
3441C D u m m y A r g u m e n t s
3442C-----------------------------------------------
3443 INTEGER IPARI(NPARI,*), IFLAG
3444 INTEGER, INTENT(IN) :: IDT_THERM
3445 INTEGER, INTENT(IN) :: INTHEAT
3446 TYPE(H3D_DATABASE) :: H3D_DATA
3447 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
3448C-----------------------------------------------
3449C L o c a l V a r i a b l e s
3450C-----------------------------------------------
3451 INTEGER I, P, NSN, NMN, ITYP, IGAP, IERROR, IERROR1, LENS, LENR,
3452 . lskyfi, inacti, nbintc, leni, j,intth, k, l,iedge4 ,intfric ,
3453 . flagremn ,sizremnorfi, ivis2 ,intnitsche,itied,ipstif
3454 INTEGER :: LENR_EDGE,LENS_EDGE
3455C-----------------------------------------------
3456C S o u r c e L i n e s
3457C-----------------------------------------------
3458 IF(iflag==1) THEN
3459C Init Pointer + Reading Wait
3460 IF(ninter/=0) THEN
3461 ierror = 0
3462 ALLOCATE(nsvfi(ninter),stat=ierror1)
3463 ierror = ierror + ierror1
3464 ALLOCATE(nsnfi(ninter),stat=ierror1)
3465 ierror = ierror + ierror1
3466 ALLOCATE(edge_fi(ninter),stat=ierror1)
3467 ierror = ierror + ierror1
3468 ALLOCATE(nsnfi_sav(ninter),stat=ierror1)
3469 ierror = ierror + ierror1
3470 ALLOCATE(nsnsi_sav(ninter),stat=ierror1)
3471 ierror = ierror + ierror1
3472 ALLOCATE(itafi(ninter),stat=ierror1)
3473 ierror = ierror + ierror1
3474 ALLOCATE(pmainfi(ninter),stat=ierror1)
3475 ierror = ierror + ierror1
3476 ALLOCATE(kinfi(ninter),stat=ierror1)
3477 ierror = ierror + ierror1
3478 ALLOCATE(msfi(ninter),stat=ierror1)
3479 ierror = ierror + ierror1
3480 ALLOCATE(stifi(ninter),stat=ierror1)
3481 ierror = ierror + ierror1
3482 ALLOCATE(gapfi(ninter),stat=ierror1)
3483 ierror = ierror + ierror1
3484 ALLOCATE(gap_lfi(ninter),stat=ierror1)
3485 ierror = ierror + ierror1
3486 ALLOCATE(xfi(ninter),stat=ierror1)
3487 ierror = ierror + ierror1
3488 ALLOCATE(vfi(ninter),stat=ierror1)
3489 ierror = ierror + ierror1
3490 ALLOCATE(nsvsi(ninter),stat=ierror1)
3491 ierror = ierror + ierror1
3492 ALLOCATE(nsnsi(ninter),stat=ierror1)
3493 ierror = ierror + ierror1
3494 ALLOCATE(afi(ninter),stat=ierror1)
3495 ierror = ierror + ierror1
3496 ALLOCATE(stnfi(ninter),stat=ierror1)
3497 ierror = ierror + ierror1
3498 ALLOCATE(vscfi(ninter),stat=ierror1)
3499 ierror = ierror + ierror1
3500 ALLOCATE(penfi(ninter),stat=ierror1)
3501 ierror = ierror + ierror1
3502 ALLOCATE(fskyfi(ninter),stat=ierror1)
3503 ierror = ierror + ierror1
3504 ALLOCATE(iskyfi(ninter),stat=ierror1)
3505 ierror = ierror + ierror1
3506C
3507 ALLOCATE(nisubsfi(ninter),stat=ierror1)
3508 ierror = ierror + ierror1
3509 ALLOCATE(lisubsfi(ninter),stat=ierror1)
3510 ierror = ierror + ierror1
3511 ALLOCATE(inflg_subsfi(ninter),stat=ierror1)
3512 ierror = ierror + ierror1
3513 ALLOCATE(addsubsfi(ninter),stat=ierror1)
3514 ierror = ierror + ierror1
3515 IF(parameters%INTCAREA > 0 ) THEN
3516 ALLOCATE(intareanfi(ninter),stat=ierror1)
3517 ierror = ierror + ierror1
3518 ENDIF
3519
3520 ALLOCATE(nisubsfie(ninter),stat=ierror1)
3521 ierror = ierror + ierror1
3522 ALLOCATE(lisubsfie(ninter),stat=ierror1)
3523 ierror = ierror + ierror1
3524 ALLOCATE(inflg_subsfie(ninter),stat=ierror1)
3525 ierror = ierror + ierror1
3526 ALLOCATE(addsubsfie(ninter),stat=ierror1)
3527 ierror = ierror + ierror1
3528
3529C
3530 ALLOCATE(fnconti(ninter),stat=ierror1)
3531 ierror = ierror + ierror1
3532 ALLOCATE(ftconti(ninter),stat=ierror1)
3533 ierror = ierror + ierror1
3534C
3535 ALLOCATE (nlskyfi(ninter),stat=ierror1)
3536 ierror = ierror + ierror1
3537 nlskyfi(1:ninter)=0
3538C Int17
3539 ALLOCATE (eminxfi(ninter),stat=ierror1)
3540 ierror = ierror + ierror1
3541 ALLOCATE (ksfi(ninter),stat=ierror1)
3542 ierror = ierror + ierror1
3543 ALLOCATE (frotsfi(ninter),stat=ierror1)
3544 ierror = ierror + ierror1
3545 ALLOCATE (stnfi17(ninter),stat=ierror1)
3546 ierror = ierror + ierror1
3547 ALLOCATE(xfi17(ninter),stat=ierror1)
3548 ierror = ierror + ierror1
3549 ALLOCATE(vfi17(ninter),stat=ierror1)
3550 ierror = ierror + ierror1
3551 ALLOCATE(afi17(ninter),stat=ierror1)
3552 ierror = ierror + ierror1
3553C Int20
3554 ALLOCATE(nbinflfi(ninter),stat=ierror1)
3555 ierror = ierror + ierror1
3556 ALLOCATE(daanc6fi(ninter),stat=ierror1)
3557 ierror = ierror + ierror1
3558 ALLOCATE(dxancfi(ninter),stat=ierror1)
3559 ierror = ierror + ierror1
3560 ALLOCATE(dvancfi(ninter),stat=ierror1)
3561 ierror = ierror + ierror1
3562 ALLOCATE(penfia(ninter),stat=ierror1)
3563 ierror = ierror + ierror1
3564 ALLOCATE(alphakfi(ninter),stat=ierror1)
3565 ierror = ierror + ierror1
3566 ALLOCATE(daancfi(ninter),stat=ierror1)
3567 ierror = ierror + ierror1
3568 ALLOCATE(diag_smsfi(ninter),stat=ierror1)
3569 ierror = ierror + ierror1
3570C Int20 edge
3571 ALLOCATE(nsvfie(ninter),stat=ierror1)
3572 ierror = ierror + ierror1
3573 ALLOCATE(nsnfie(ninter),stat=ierror1)
3574 ierror = ierror + ierror1
3575 ALLOCATE(itafie(ninter),stat=ierror1)
3576 ierror = ierror + ierror1
3577 ALLOCATE(msfie(ninter),stat=ierror1)
3578 ierror = ierror + ierror1
3579 ALLOCATE(stifie(ninter),stat=ierror1)
3580 ierror = ierror + ierror1
3581 ALLOCATE(gapfie(ninter),stat=ierror1)
3582 ierror = ierror + ierror1
3583 ALLOCATE(xfie(ninter),stat=ierror1)
3584 ierror = ierror + ierror1
3585 ALLOCATE(vfie(ninter),stat=ierror1)
3586 ierror = ierror + ierror1
3587 ALLOCATE(nsvsie(ninter),stat=ierror1)
3588 ierror = ierror + ierror1
3589 ALLOCATE(nsnsie(ninter),stat=ierror1)
3590 ierror = ierror + ierror1
3591 ALLOCATE(afie(ninter),stat=ierror1)
3592 ierror = ierror + ierror1
3593 ALLOCATE(stnfie(ninter),stat=ierror1)
3594 ierror = ierror + ierror1
3595 ALLOCATE(vscfie(ninter),stat=ierror1)
3596 ierror = ierror + ierror1
3597 ALLOCATE(penfie(ninter),stat=ierror1)
3598 ierror = ierror + ierror1
3599 ALLOCATE(fskyfie(ninter),stat=ierror1)
3600 ierror = ierror + ierror1
3601 ALLOCATE(iskyfie(ninter),stat=ierror1)
3602 ierror = ierror + ierror1
3603C
3604 ALLOCATE (nlskyfie(ninter),stat=ierror1)
3605 ierror = ierror + ierror1
3606 nlskyfie(1:ninter)=0
3607C
3608 ALLOCATE(daanc6fie(ninter),stat=ierror1)
3609 ierror = ierror + ierror1
3610 ALLOCATE(dxancfie(ninter),stat=ierror1)
3611 ierror = ierror + ierror1
3612 ALLOCATE(dvancfie(ninter),stat=ierror1)
3613 ierror = ierror + ierror1
3614 ALLOCATE(penfiae(ninter),stat=ierror1)
3615 ierror = ierror + ierror1
3616 ALLOCATE(alphakfie(ninter),stat=ierror1)
3617 ierror = ierror + ierror1
3618 ALLOCATE(daancfie(ninter),stat=ierror1)
3619 ierror = ierror + ierror1
3620 ALLOCATE(diag_smsfie(ninter),stat=ierror1)
3621 ierror = ierror + ierror1
3622C
3623 ALLOCATE (nodnxfie(ninter),stat=ierror1)
3624 ierror = ierror + ierror1
3625 ALLOCATE (nodamsfie(ninter),stat=ierror1)
3626 ierror = ierror + ierror1
3627 ALLOCATE (procamsfie(ninter),stat=ierror1)
3628 ierror = ierror + ierror1
3629C Fin Int20 edge
3630
3631C I18KINE
3632 ALLOCATE (mtfi_pene(ninter),stat=ierror1)
3633 ierror = ierror + ierror1
3634 ALLOCATE (mtfi_penemin(ninter),stat=ierror1)
3635 ierror = ierror + ierror1
3636 ALLOCATE (mtfi_v(ninter),stat=ierror1)
3637 ierror = ierror + ierror1
3638 ALLOCATE (mtfi_a(ninter),stat=ierror1)
3639 ierror = ierror + ierror1
3640 ALLOCATE (i18kafi(ninter),stat=ierror1)
3641 ierror = ierror + ierror1
3642 ALLOCATE (mtfi_n(ninter),stat=ierror1)
3643 ierror = ierror + ierror1
3644C INT 24 & 25
3645 ALLOCATE (time_sfi(ninter),stat=ierror1)
3646 ierror = ierror + ierror1
3647 ALLOCATE (irtlm_fi(ninter),stat=ierror1)
3648 ierror = ierror + ierror1
3649 ALLOCATE (secnd_frfi(ninter),stat=ierror1)
3650 ierror = ierror + ierror1
3651 ALLOCATE (pene_oldfi(ninter),stat=ierror1)
3652 ierror = ierror + ierror1
3653 ALLOCATE (stif_oldfi(ninter),stat=ierror1)
3654 ierror = ierror + ierror1
3655 ALLOCATE (icont_i_fi(ninter),stat=ierror1)
3656 ierror = ierror + ierror1
3657 ALLOCATE (isedge_fi(ninter),stat=ierror1)
3658 ierror = ierror + ierror1
3659 ALLOCATE (irtse_fi(ninter),stat=ierror1)
3660 ierror = ierror + ierror1
3661 ALLOCATE (is2pt_fi(ninter),stat=ierror1)
3662 ierror = ierror + ierror1
3663 ALLOCATE (isegpt_fi(ninter),stat=ierror1)
3664 ierror = ierror + ierror1
3665 ALLOCATE (is2se_fi(ninter),stat=ierror1)
3666 ierror = ierror + ierror1
3667 ALLOCATE (ispt2_fi(ninter),stat=ierror1)
3668 ierror = ierror + ierror1
3669 ALLOCATE (remnor_fi(ninter),stat=ierror1)
3670 ierror = ierror + ierror1
3671 ALLOCATE (kremnor_fi(ninter),stat=ierror1)
3672 ierror = ierror + ierror1
3673C INT 25
3674 ALLOCATE (islide_fi(ninter),stat=ierror1)
3675 ierror = ierror + ierror1
3676 ALLOCATE (icodt_fi(ninter),stat=ierror1)
3677 ierror = ierror + ierror1
3678 ALLOCATE (iskew_fi(ninter),stat=ierror1)
3679 ierror = ierror + ierror1
3680 ipstif = 0
3681 DO i = 1,ninter
3682 IF(ipari(97,i) > 0) ipstif = ipstif + ipari(97,i)
3683 END DO
3684 IF(parameters%ISTIF_DT > 0 .OR. ipstif>0 ) THEN
3685 ALLOCATE(stif_msdt_fi(ninter))
3686 ALLOCATE(stife_msdt_fi(ninter))
3687 ENDIF
3688C
3689 IF(intheat > 0 ) THEN
3690 ALLOCATE (ftheskyfi(ninter),stat=ierror1)
3691 ierror = ierror + ierror1
3692 ALLOCATE(fthefi(ninter),stat=ierror1)
3693 ierror = ierror + ierror1
3694 ALLOCATE(tempfi(ninter),stat=ierror1)
3695 ierror = ierror + ierror1
3696 ALLOCATE(matsfi(ninter),stat=ierror1)
3697 ierror = ierror + ierror1
3698 ALLOCATE(nmtemp(ninter),stat=ierror1)
3699 ierror = ierror + ierror1
3700 IF(idt_therm == 1) THEN
3701 ALLOCATE(condnfi(ninter),stat=ierror1)
3702 ierror = ierror + ierror1
3703 ALLOCATE(condnskyfi(ninter),stat=ierror1)
3704 ierror = ierror + ierror1
3705 ENDIF
3706 ENDIF
3707 IF(intheat > 0 .OR.nintloadp21 > 0) THEN
3708 ALLOCATE(nmnfi(ninter),stat=ierror1)
3709 ierror = ierror + ierror1
3710 ALLOCATE(nmvfi(ninter),stat=ierror1)
3711 ierror = ierror + ierror1
3712 ALLOCATE(nmnsi(ninter),stat=ierror1)
3713 ierror = ierror + ierror1
3714 ALLOCATE(nmvsi(ninter),stat=ierror1)
3715 ierror = ierror + ierror1
3716 ALLOCATE(tempnod(ninter),stat=ierror1)
3717 ierror = ierror + ierror1
3718 ENDIF
3719 IF(nintloadp21 > 0) THEN
3720 ALLOCATE(tagncontfi(ninter),stat=ierror1)
3721 ierror = ierror + ierror1
3722 ENDIF
3723 IF(ninterfric > 0 ) THEN
3724 ALLOCATE(ipartfricsfi(ninter),stat=ierror1)
3725 ierror = ierror + ierror1
3726 ALLOCATE(ipartfric_fie(ninter),stat=ierror1)
3727 ierror = ierror + ierror1
3728 ENDIF
3729C
3730 ALLOCATE (nodnxfi(ninter),stat=ierror1)
3731 ierror = ierror + ierror1
3732 ALLOCATE (nodamsfi(ninter),stat=ierror1)
3733 ierror = ierror + ierror1
3734 ALLOCATE (procamsfi(ninter),stat=ierror1)
3735 ierror = ierror + ierror1
3736C
3737 ALLOCATE (t2main_sms_fi(ninter),stat=ierror1)
3738 ierror = ierror + ierror1
3739 ALLOCATE (t2fac_sms_fi(ninter),stat=ierror1)
3740 ierror = ierror + ierror1
3741C
3742 IF(intheat > 0.OR.interadhesion > 0 ) THEN
3743 ALLOCATE(areasfi(ninter),stat=ierror1)
3744 DO i = 1, ninter
3745 NULLIFY(areasfi(i)%p)
3746 ENDDO
3747 ierror = ierror + ierror1
3748 ENDIF
3749C
3750 IF(interadhesion > 0) THEN
3751 ALLOCATE(if_adhfi(ninter),stat=ierror1)
3752 DO i = 1, ninter
3753 NULLIFY(if_adhfi(i)%p)
3754 ENDDO
3755 ierror = ierror + ierror1
3756 ENDIF
3757
3758 ALLOCATE(candf_si(ninter),stat=ierror1)
3759 ierror = ierror + ierror1
3760C
3761 IF(nitsche > 0 ) THEN
3762 ALLOCATE(forneqsfi(ninter),stat=ierror1)
3763 ierror = ierror + ierror1
3764 ENDIF
3765
3766C
3767 ALLOCATE(efricfi(ninter),stat=ierror1)
3768 ierror = ierror + ierror1
3769 ALLOCATE(efricgfi(ninter),stat=ierror1)
3770 ierror = ierror + ierror1
3771
3772C ALLOCATE(MAIN_FIE(NINTER))
3773 ALLOCATE(gape_l_fie(ninter))
3774 ALLOCATE(edg_bisector_fie(ninter))
3775 ALLOCATE(vtx_bisector_fie(ninter))
3776 ALLOCATE(x_seg_fie(ninter))
3777 ALLOCATE(ledge_fie(ninter))
3778
3779
3780C
3781 DO i=1,ninter
3782 NULLIFY(nsvfi(i)%p)
3783 NULLIFY(nsnfi(i)%p)
3784 NULLIFY(edge_fi(i)%p)
3785 NULLIFY(pmainfi(i)%p)
3786 NULLIFY(nsnfi_sav(i)%p)
3787 NULLIFY(nsnsi_sav(i)%p)
3788 NULLIFY(itafi(i)%p)
3789 NULLIFY(kinfi(i)%p)
3790 NULLIFY(msfi(i)%p)
3791 NULLIFY(stifi(i)%p)
3792 NULLIFY(gapfi(i)%p)
3793 NULLIFY(gap_lfi(i)%p)
3794 NULLIFY(xfi(i)%p)
3795 NULLIFY(vfi(i)%p)
3796 NULLIFY(nsvsi(i)%p)
3797 NULLIFY(nsnsi(i)%p)
3798 NULLIFY(afi(i)%p)
3799 NULLIFY(stnfi(i)%p)
3800 NULLIFY(vscfi(i)%p)
3801 NULLIFY(penfi(i)%p)
3802 NULLIFY(fskyfi(i)%p)
3803 NULLIFY(iskyfi(i)%p)
3804
3805 NULLIFY(nisubsfi(i)%p)
3806 NULLIFY(lisubsfi(i)%p)
3807 NULLIFY(inflg_subsfi(i)%p)
3808 NULLIFY(addsubsfi(i)%p)
3809 IF(parameters%INTCAREA > 0) NULLIFY(intareanfi(i)%p)
3810
3811 NULLIFY(nisubsfie(i)%p)
3812 NULLIFY(lisubsfie(i)%p)
3813 NULLIFY(inflg_subsfie(i)%p)
3814 NULLIFY(addsubsfie(i)%p)
3815
3816
3817C
3818 NULLIFY(fnconti(i)%p)
3819 NULLIFY(ftconti(i)%p)
3820C
3821 NULLIFY(eminxfi(i)%p)
3822 NULLIFY(ksfi(i)%p)
3823 NULLIFY(frotsfi(i)%p)
3824 NULLIFY(stnfi17(i)%p)
3825 NULLIFY(xfi17(i)%p)
3826 NULLIFY(vfi17(i)%p)
3827 NULLIFY(afi17(i)%p)
3828C
3829 NULLIFY(nbinflfi(i)%p)
3830 NULLIFY(daanc6fi(i)%p)
3831 NULLIFY(dxancfi(i)%p)
3832 NULLIFY(dvancfi(i)%p)
3833 NULLIFY(penfia(i)%p)
3834 NULLIFY(alphakfi(i)%p)
3835 NULLIFY(daancfi(i)%p)
3836 NULLIFY(diag_smsfi(i)%p)
3837C
3838 NULLIFY(nodnxfi(i)%p)
3839 NULLIFY(nodamsfi(i)%p)
3840 NULLIFY(procamsfi(i)%p)
3841C
3842C Int20 edge
3843 NULLIFY(nsvfie(i)%p)
3844 NULLIFY(nsnfie(i)%p)
3845 NULLIFY(itafie(i)%p)
3846 NULLIFY(msfie(i)%p)
3847 NULLIFY(stifie(i)%p)
3848 NULLIFY(gapfie(i)%p)
3849 NULLIFY(xfie(i)%p)
3850 NULLIFY(vfie(i)%p)
3851 NULLIFY(nsvsie(i)%p)
3852 NULLIFY(nsnsie(i)%p)
3853 NULLIFY(afie(i)%p)
3854 NULLIFY(stnfie(i)%p)
3855 NULLIFY(vscfie(i)%p)
3856 NULLIFY(penfie(i)%p)
3857 NULLIFY(fskyfie(i)%p)
3858 NULLIFY(iskyfie(i)%p)
3859 NULLIFY(daanc6fie(i)%p)
3860 NULLIFY(dxancfie(i)%p)
3861 NULLIFY(dvancfie(i)%p)
3862 NULLIFY(penfiae(i)%p)
3863 NULLIFY(alphakfie(i)%p)
3864 NULLIFY(daancfie(i)%p)
3865C
3866 NULLIFY(nodnxfie(i)%p)
3867 NULLIFY(nodamsfie(i)%p)
3868 NULLIFY(diag_smsfie(i)%p)
3869 NULLIFY(procamsfie(i)%p)
3870C I18KINE
3871 NULLIFY(mtfi_pene(i)%p)
3872 NULLIFY(mtfi_penemin(i)%p)
3873 NULLIFY(mtfi_v(i)%p)
3874 NULLIFY(mtfi_a(i)%p)
3875C INT24 & 25
3876 NULLIFY(time_sfi(i)%P)
3877 NULLIFY(irtlm_fi(i)%P)
3878 NULLIFY(secnd_frfi(i)%P)
3879 NULLIFY(stif_oldfi(i)%P)
3880 NULLIFY(pene_oldfi(i)%P)
3881 NULLIFY(icont_i_fi(i)%P)
3882 NULLIFY(isedge_fi(i)%P)
3883 NULLIFY(irtse_fi(i)%P)
3884 NULLIFY(is2pt_fi(i)%P)
3885 NULLIFY(ispt2_fi(i)%P)
3886 NULLIFY(isegpt_fi(i)%P)
3887 NULLIFY(is2se_fi(i)%P)
3888 NULLIFY(remnor_fi(i)%P)
3889 NULLIFY(kremnor_fi(i)%P)
3890C INT25
3891 NULLIFY(islide_fi(i)%P)
3892 NULLIFY(t2main_sms_fi(i)%p)
3893 NULLIFY(t2fac_sms_fi(i)%p)
3894 NULLIFY(candf_si(i)%P)
3895 NULLIFY(iskew_fi(i)%P)
3896 NULLIFY(icodt_fi(i)%P)
3897 IF(parameters%ISTIF_DT > 0 .OR. ipari(97,i)>0 ) THEN
3898 NULLIFY(stif_msdt_fi(i)%P)
3899 NULLIFY(stife_msdt_fi(i)%P)
3900 ENDIF
3901C INT25 E2E
3902C NULLIFY(MAIN_FIE(I)%P)
3903 NULLIFY(gape_l_fie(i)%P)
3904 NULLIFY(edg_bisector_fie(i)%P)
3905 NULLIFY(vtx_bisector_fie(i)%P)
3906 NULLIFY(ledge_fie(i)%P)
3907 NULLIFY(x_seg_fie(i)%P)
3908C
3909 NULLIFY(efricfi(i)%P)
3910 NULLIFY(efricgfi(i)%P)
3911 END DO
3912C
3913 IF(intheat /= 0) THEN
3914 DO i=1,ninter
3915 NULLIFY(fthefi(i)%p)
3916 NULLIFY(ftheskyfi(i)%p)
3917 NULLIFY(tempfi(i)%p)
3918 NULLIFY(matsfi(i)%p)
3919 NULLIFY(areasfi(i)%p)
3920 NULLIFY(nmtemp(i)%p)
3921 END DO
3922 IF(interadhesion /= 0) THEN
3923 DO i=1,ninter
3924 NULLIFY(if_adhfi(i)%P)
3925 ENDDO
3926 ENDIF
3927 IF(idt_therm == 1) THEN
3928 DO i=1,ninter
3929 NULLIFY(condnfi(i)%p)
3930 NULLIFY(condnskyfi(i)%p)
3931 ENDDO
3932 ENDIF
3933 ENDIF
3934 IF(intheat /= 0.OR.nintloadp21 > 0) THEN
3935 DO i=1,ninter
3936 NULLIFY(nmnfi(i)%p)
3937 NULLIFY(nmvfi(i)%p)
3938 NULLIFY(nmnsi(i)%p)
3939 NULLIFY(nmvsi(i)%p)
3940 NULLIFY(tempnod(i)%p)
3941 END DO
3942 ENDIF
3943 IF(nintloadp21 > 0) THEN
3944 DO i=1,ninter
3945 NULLIFY(tagncontfi(i)%p)
3946 END DO
3947 ENDIF
3948C
3949 IF(ninterfric > 0 ) THEN
3950 DO i=1,ninter
3951 NULLIFY(ipartfricsfi(i)%p)
3952 NULLIFY(ipartfric_fie(i)%p)
3953 ENDDO
3954 ENDIF
3955C
3956 IF(nitsche > 0 ) THEN
3957 DO i=1,ninter
3958 NULLIFY(forneqsfi(i)%p)
3959 ENDDO
3960 ENDIF
3961C
3962 IF(ierror/=0) THEN
3963 CALL ancmsg(msgid=20,anmode=aninfo)
3964 CALL arret(2)
3965 ENDIF
3966C
3967C Allocation and reading Strings Interfaces on Restart file (integer part)
3968C
3969 nbintc = 0
3970 DO i =1, ninter
3971 ityp = ipari(7,i)
3972 ivis2 = ipari(14,i) ! ivis2==-1 : Flag for interface adhesion
3973 igap = ipari(21,i)
3974 inacti = ipari(22,i)
3975 intth = ipari(47,i)
3976 intfric = ipari(72,i)
3977 flagremn = ipari(63,i)
3978 intnitsche = ipari(86,i)
3979 itied = ipari(85,i)
3980 nsn =ipari(5,i)
3981
3982 IF(ityp==24) THEN
3983 iedge4 = ipari(59,i)
3984 ELSE
3985 iedge4 = 0
3986 ENDIF
3987 IF(ityp==7.OR.ityp==10.OR.ityp==11.OR.
3988 + (ityp==17.AND.ipari(33,i)==0).OR.ityp==20.OR.
3989 + ityp==22.OR.ityp==23.OR.ityp==24.OR.
3990 + ityp==25)THEN
3991C
3992 nbintc = nbintc + 1
3993 ALLOCATE(nsnsi(i)%P(nspmd),stat=ierror)
3994 ALLOCATE(nsnfi(i)%P(nspmd),stat=ierror1)
3995
3996
3997 IF(ierror+ierror1/=0) THEN
3998 CALL ancmsg(msgid=20,anmode=aninfo)
3999 CALL arret(2)
4000 ENDIF
4001 CALL read_i_c(nsnsi(i)%P(1),nspmd)
4002 CALL read_i_c(nsnfi(i)%P(1),nspmd)
4003 lens = 0
4004 lenr = 0
4005 DO p = 1, nspmd
4006 lens = lens + nsnsi(i)%P(p)
4007 lenr = lenr + nsnfi(i)%P(p)
4008 END DO
4009C
4010 ierror = 0
4011C
4012 ierror1 = 0
4013 IF(lens>0) THEN
4014 ALLOCATE(nsvsi(i)%P(lens),stat=ierror1)
4015 CALL read_i_c(nsvsi(i)%P(1),lens)
4016 ierror = ierror + ierror1
4017 ENDIF
4018 ALLOCATE(candf_si(i)%P(nsn),stat=ierror1)
4019 candf_si(i)%P(1:nsn)=0
4020C
4021 IF(lenr>0) THEN
4022 ALLOCATE(nsvfi(i)%P(lenr),stat=ierror1)
4023 ierror = ierror + ierror1
4024 CALL read_i_c(nsvfi(i)%P(1),lenr)
4025 IF(ityp==7.OR.ityp==10.OR.
4026 + ityp==20.OR.ityp==22.OR.
4027 + ityp==23.OR.ityp==24.OR.
4028 + ityp==25)THEN
4029 ALLOCATE(itafi(i)%P(lenr),stat=ierror1)
4030 ierror = ierror + ierror1
4031 CALL read_i_c(itafi(i)%P(1),lenr)
4032 IF(ityp==7.OR.ityp==20.OR.ityp==22.OR.
4033 + ityp==23.OR.ityp==24.OR.ityp==25)THEN
4034 ALLOCATE(kinfi(i)%P(lenr),stat=ierror1)
4035 ierror = ierror + ierror1
4036 CALL read_i_c(kinfi(i)%P(1),lenr)
4037C
4038 IF(ityp==20)THEN
4039 ALLOCATE(nbinflfi(i)%P(lenr),stat=ierror1)
4040 ierror = ierror + ierror1
4041 CALL read_i_c(nbinflfi(i)%P(1),lenr)
4042 END IF
4043C
4044 IF(intth > 0 ) THEN
4045 ALLOCATE(matsfi(i)%P(lenr),stat=ierror1)
4046 ierror = ierror + ierror
4047 CALL read_i_c(matsfi(i)%P(1),lenr)
4048 ENDIF
4049 IF((ityp==7.OR.ityp==24.OR.ityp==25).AND.intfric > 0) THEN
4050 ALLOCATE(ipartfricsfi(i)%P(lenr),stat=ierror1)
4051 ierror = ierror + ierror
4052 CALL read_i_c(ipartfricsfi(i)%P(1),lenr)
4053 ENDIF
4054C
4055 IF (ityp==24)THEN
4056 IF(.NOT.ASSOCIATED(irtlm_fi(i)%P))
4057 * ALLOCATE(irtlm_fi(i)%P(2,lenr),stat=ierror1)
4058
4059 CALL read_i_c(irtlm_fi(i)%P(1,1),2*lenr)
4060 IF(.NOT.ASSOCIATED(icont_i_fi(i)%P))
4061 * ALLOCATE(icont_i_fi(i)%P(lenr),stat=ierror1)
4062 CALL read_i_c(icont_i_fi(i)%P(1),lenr)
4063
4064 IF(.NOT.ASSOCIATED(isedge_fi(i)%P))
4065 * ALLOCATE(isedge_fi(i)%P(lenr),stat=ierror1)
4066 CALL read_i_c(isedge_fi(i)%P(1),lenr)
4067
4068 IF(iedge4 >0)THEN
4069 IF(.NOT.ASSOCIATED(irtse_fi(i)%P))
4070 * ALLOCATE(irtse_fi(i)%P(5,lenr),stat=ierror1)
4071 CALL read_i_c(irtse_fi(i)%P(1,1),5*lenr)
4072
4073 IF(.NOT.ASSOCIATED(is2pt_fi(i)%P))
4074 * ALLOCATE(is2pt_fi(i)%P(lenr),stat=ierror1)
4075 CALL read_i_c(is2pt_fi(i)%P(1),lenr)
4076
4077 IF(.NOT.ASSOCIATED(ispt2_fi(i)%P))
4078 * ALLOCATE(ispt2_fi(i)%P(lenr),stat=ierror1)
4079 CALL read_i_c(ispt2_fi(i)%P(1),lenr)
4080
4081 IF(.NOT.ASSOCIATED(isegpt_fi(i)%P))
4082 * ALLOCATE(isegpt_fi(i)%P(lenr),stat=ierror1)
4083 CALL read_i_c(isegpt_fi(i)%P(1),lenr)
4084
4085 IF(.NOT.ASSOCIATED(is2se_fi(i)%P))
4086 * ALLOCATE(is2se_fi(i)%P(2,lenr),stat=ierror1)
4087 CALL read_i_c(is2se_fi(i)%P(1,1),2*lenr)
4088
4089 ENDIF
4090 IF(intnitsche >0)THEN
4091 IF(.NOT.ASSOCIATED(forneqsfi(i)%P))
4092 * ALLOCATE(forneqsfi(i)%P(3,lenr),stat=ierror1)
4093 CALL read_i_c(forneqsfi(i)%P(1,1),3*lenr)
4094 ENDIF
4095
4096 ENDIF
4097C
4098 IF (ityp==25)THEN
4099 IF(.NOT.ASSOCIATED(pmainfi(i)%P))
4100 * ALLOCATE(pmainfi(i)%P(lenr),stat=ierror1)
4101 CALL read_i_c(pmainfi(i)%P(1),lenr)
4102 IF(.NOT.ASSOCIATED(irtlm_fi(i)%P))
4103 * ALLOCATE(irtlm_fi(i)%P(4,lenr),stat=ierror1)
4104 CALL read_i_c(irtlm_fi(i)%P(1,1),4*lenr)
4105 IF(.NOT.ASSOCIATED(icont_i_fi(i)%P))
4106 * ALLOCATE(icont_i_fi(i)%P(lenr),stat=ierror1)
4107 CALL read_i_c(icont_i_fi(i)%P(1),lenr)
4108
4109 IF(.NOT.ASSOCIATED(icodt_fi(i)%P))
4110 * ALLOCATE(icodt_fi(i)%P(lenr),stat=ierror1)
4111C CALL READ_I_C(ICODT_FI(I)%P(1),LENR)
4112 icodt_fi(i)%P(1:lenr) = 0
4113
4114 IF(.NOT.ASSOCIATED(iskew_fi(i)%P))
4115 * ALLOCATE(iskew_fi(i)%P(lenr),stat=ierror1)
4116 iskew_fi(i)%P(1:lenr) = 0
4117
4118C CALL READ_I_C(ISKEW_FI(I)%P(1),LENR)
4119
4120 IF(.NOT.ASSOCIATED(islide_fi(i)%P))
4121 * ALLOCATE(islide_fi(i)%P(4,lenr),stat=ierror1)
4122C no need in restart file
4123 islide_fi(i)%P(1:4,1:lenr)=0
4124C Remove banned main segment
4125 IF(flagremn==2) THEN
4126 IF(.NOT.ASSOCIATED(kremnor_fi(i)%P))
4127 * ALLOCATE(kremnor_fi(i)%P(lenr+1),stat=ierror1)
4128 CALL read_i_c(kremnor_fi(i)%P(1),lenr+1)
4129 sizremnorfi = kremnor_fi(i)%P(lenr+1)
4130 IF(sizremnorfi /= 0) THEN
4131 IF(.NOT.ASSOCIATED(remnor_fi(i)%P))
4132 * ALLOCATE(remnor_fi(i)%P(sizremnorfi),stat=ierror1)
4133 CALL read_i_c(remnor_fi(i)%P(1),sizremnorfi)
4134 ELSE IF(sizremnorfi == 0) THEN
4135 IF(.NOT.ASSOCIATED(remnor_fi(i)%P))
4136 * ALLOCATE(remnor_fi(i)%P(sizremnorfi),stat=ierror1)
4137 ENDIF
4138 ENDIF
4139 ENDIF
4140 END IF
4141C
4142 IF(idtmins_old == 2) THEN
4143 ALLOCATE (nodnxfi(i)%P(lenr),stat=ierror1)
4144 ierror = ierror + ierror1
4145 CALL read_i_c(nodnxfi(i)%P(1),lenr)
4146 ALLOCATE (nodamsfi(i)%P(lenr),stat=ierror1)
4147 ierror = ierror + ierror1
4148 CALL read_i_c(nodamsfi(i)%P(1),lenr)
4149 ALLOCATE (procamsfi(i)%P(lenr),stat=ierror1)
4150 ierror = ierror + ierror1
4151 CALL read_i_c(procamsfi(i)%P(1),lenr)
4152 IF (ityp==24) THEN
4153 ALLOCATE (t2main_sms_fi(i)%P(6,lenr),stat=ierror1)
4154 ierror = ierror + ierror1
4155 CALL read_i_c(t2main_sms_fi(i)%P(1,1),6*lenr)
4156 ENDIF
4157 ELSEIF(idtmins_int_old /= 0) THEN
4158 ALLOCATE (nodamsfi(i)%P(lenr),stat=ierror1)
4159 ierror = ierror + ierror1
4160 CALL read_i_c(nodamsfi(i)%P(1),lenr)
4161 ALLOCATE (procamsfi(i)%P(lenr),stat=ierror1)
4162 ierror = ierror + ierror1
4163 CALL read_i_c(procamsfi(i)%P(1),lenr)
4164 IF (ityp==24) THEN
4165 ALLOCATE (t2main_sms_fi(i)%P(6,lenr),stat=ierror1)
4166 ierror = ierror + ierror1
4167 CALL read_i_c(t2main_sms_fi(i)%P(1,1),6*lenr)
4168 ENDIF
4169 ENDIF
4170C
4171 IF(idtmins==2) THEN
4172 IF(.NOT.ASSOCIATED(nodnxfi(i)%P)) THEN
4173 ALLOCATE (nodnxfi(i)%P(lenr),stat=ierror1)
4174 ierror = ierror + ierror1
4175 nodnxfi(i)%P(1:lenr)=0
4176 ENDIF
4177 IF(.NOT.ASSOCIATED(nodamsfi(i)%P)) THEN
4178 ALLOCATE (nodamsfi(i)%P(lenr),stat=ierror1)
4179 ierror = ierror + ierror1
4180 nodamsfi(i)%P(1:lenr)=0
4181 ENDIF
4182 IF(.NOT.ASSOCIATED(procamsfi(i)%P)) THEN
4183 ALLOCATE (procamsfi(i)%P(lenr),stat=ierror1)
4184 ierror = ierror + ierror1
4185 procamsfi(i)%P(1:lenr)=0
4186 ENDIF
4187 IF (ityp==24) THEN
4188 IF(.NOT.ASSOCIATED(t2main_sms_fi(i)%P)) THEN
4189 ALLOCATE (t2main_sms_fi(i)%P(6,lenr),stat=ierror1)
4190 ierror = ierror + ierror1
4191 t2main_sms_fi(i)%P(1:6,1:lenr)=0
4192 ENDIF
4193 ENDIF
4194 ELSEIF(idtmins_int /= 0) THEN
4195 IF(.NOT.ASSOCIATED(nodamsfi(i)%P)) THEN
4196 ALLOCATE (nodamsfi(i)%P(lenr),stat=ierror1)
4197 ierror = ierror + ierror1
4198 nodamsfi(i)%P(1:lenr)=0
4199 ENDIF
4200 IF(.NOT.ASSOCIATED(procamsfi(i)%P)) THEN
4201 ALLOCATE (procamsfi(i)%P(lenr),stat=ierror1)
4202 ierror = ierror + ierror1
4203 procamsfi(i)%P(1:lenr)=0
4204 ENDIF
4205 IF (ityp==24) THEN
4206 IF(.NOT.ASSOCIATED(t2main_sms_fi(i)%P)) THEN
4207 ALLOCATE (t2main_sms_fi(i)%P(6,lenr),stat=ierror1)
4208 ierror = ierror + ierror1
4209 t2main_sms_fi(i)%P(1:6,1:lenr)=0
4210 ENDIF
4211 ENDIF
4212 END IF
4213C
4214 ALLOCATE(msfi(i)%P(lenr),stat=ierror1)
4215 ierror = ierror + ierror1
4216 ALLOCATE(stifi(i)%P(lenr),stat=ierror1)
4217 ierror = ierror + ierror1
4218 IF(igap/=0)THEN
4219 ALLOCATE(gapfi(i)%P(lenr),stat=ierror1)
4220 ierror = ierror + ierror1
4221 IF(igap==3)THEN
4222 ALLOCATE(gap_lfi(i)%P(lenr),stat=ierror1)
4223 ierror = ierror + ierror1
4224 END IF
4225 END IF
4226 ALLOCATE(xfi(i)%P(3,lenr),stat=ierror1)
4227 ierror = ierror + ierror1
4228 ALLOCATE(vfi(i)%P(3,lenr),stat=ierror1)
4229 ierror = ierror + ierror1
4230
4231 IF(iparit==0) THEN
4232 ALLOCATE(afi(i)%P(3,lenr*nthread),stat=ierror1)
4233 ierror = ierror + ierror1
4234 ALLOCATE(stnfi(i)%P(lenr*nthread),stat=ierror1)
4235 ierror = ierror + ierror1
4236 IF(kdtint/=0)THEN
4237 ALLOCATE(vscfi(i)%P(lenr*nthread),stat=ierror1)
4238 ierror = ierror + ierror1
4239 ENDIF
4240
4241 DO k=1,lenr*nthread
4242 afi(i)%P(1,k)=zero
4243 afi(i)%P(2,k)=zero
4244 afi(i)%P(3,k)=zero
4245 stnfi(i)%P(k)=zero
4246 ENDDO
4247
4248 IF(kdtint/=0)THEN
4249 vscfi(i)%P(1:lenr*nthread)=zero
4250 ENDIF
4251
4252
4253 nlskyfi(i) = lenr
4254C
4255 IF(intth > 0 )THEN
4256 ALLOCATE(fthefi(i)%P(lenr*nthread),stat=ierror1)
4257 ierror = ierror + ierror1
4258
4259 fthefi(i)%P(1:lenr*nthread)=zero
4260
4261 ALLOCATE(tempfi(i)%P(lenr),stat=ierror1)
4262 ierror = ierror + ierror1
4263c ALLOCATE(MATSFI(I)%P(LENR),STAT=IERROR1)
4264c IERROR = IERROR + IERROR
4265 ENDIF
4266 IF(intth>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
4267 ALLOCATE(areasfi(i)%P(lenr),stat=ierror1)
4268 ierror = ierror + ierror1
4269 ENDIF
4270C
4271 IF(ityp == 25.AND.ivis2==-1) THEN
4272 ALLOCATE(if_adhfi(i)%P(lenr),stat=ierror1)
4273 ierror = ierror + ierror1
4274 ENDIF
4275C
4276 IF(idt_therm ==1.AND.intth > 0) THEN
4277 ALLOCATE(condnfi(i)%P(lenr*nthread),stat=ierror1)
4278 ierror = ierror + ierror1
4279 condnfi(i)%P(1:lenr*nthread)=zero
4280 ENDIF
4281 ELSE
4282
4283
4284 nlskyfi(i) = 0
4285 lskyfi = 0
4286
4287
4288 IF(intth > 0 ) THEN
4289 ALLOCATE(tempfi(i)%P(lenr),stat=ierror1)
4290 ierror = ierror + ierror1
4291 ENDIF
4292C
4293 IF(intth>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
4294 ALLOCATE(areasfi(i)%P(lenr),stat=ierror1)
4295 ierror = ierror + ierror1
4296 ENDIF
4297 IF(ityp == 25.AND.ivis2==-1) THEN
4298 ALLOCATE(if_adhfi(i)%P(lenr),stat=ierror1)
4299 ierror = ierror + ierror1
4300 ENDIF
4301C
4302 END IF
4303 IF(ityp == 24)THEN
4304 ALLOCATE(time_sfi(i)%P(lenr),stat=ierror1)
4305 time_sfi(i)%P(1:lenr)=zero
4306 ierror = ierror + ierror1
4307 ELSEIF(ityp == 25)THEN
4308 ALLOCATE(time_sfi(i)%P(2*lenr),stat=ierror1)
4309 time_sfi(i)%P(1:2*lenr)=zero
4310 ierror = ierror + ierror1
4311 END IF
4312 IF(ityp == 24 .OR. ityp == 25)THEN
4313 ALLOCATE(secnd_frfi(i)%P(6,lenr),stat=ierror1)
4314 secnd_frfi(i)%P(1:6,1:lenr)=zero
4315 ierror = ierror + ierror1
4316 ALLOCATE(pene_oldfi(i)%P(5,lenr),stat=ierror1)
4317 pene_oldfi(i)%P(1:5,1:lenr)=zero
4318 ierror = ierror + ierror1
4319 ALLOCATE(stif_oldfi(i)%P(2,lenr),stat=ierror1)
4320 stif_oldfi(i)%P(1:2,1:lenr)=zero
4321 ierror = ierror + ierror1
4322
4323 IF(ipari(97,i) > 0) THEN
4324 ALLOCATE(stif_msdt_fi(i)%P(lenr))
4325 stif_msdt_fi(i)%P(1:lenr)=zero
4326 ENDIF
4327
4328 IF(ityp == 25.AND.parameters%INTCAREA > 0.AND.ipari(36,i)>0) THEN
4329 ALLOCATE(intareanfi(i)%P(lenr),stat=ierror1)
4330 ierror = ierror + ierror1
4331 intareanfi(i)%P(1:lenr) =zero
4332 ENDIF
4333 IF(ityp == 24.AND.parameters%INTCAREA > 0) THEN
4334 ALLOCATE(intareanfi(i)%P(lenr),stat=ierror1)
4335 ierror = ierror + ierror1
4336 intareanfi(i)%P(1:lenr) =zero
4337 ENDIF
4338 ENDIF
4339 ELSEIF(ityp==11)THEN
4340C type11
4341 ALLOCATE(itafi(i)%P(2*lenr),stat=ierror1)
4342 ierror = ierror + ierror1
4343 CALL read_i_c(itafi(i)%P(1),2*lenr)
4344C
4345 IF(idtmins_old == 2) THEN
4346 ALLOCATE (nodnxfi(i)%P(2*lenr),stat=ierror1)
4347 ierror = ierror + ierror1
4348 CALL read_i_c(nodnxfi(i)%P(1),2*lenr)
4349 ALLOCATE (nodamsfi(i)%P(2*lenr),stat=ierror1)
4350 ierror = ierror + ierror1
4351 CALL read_i_c(nodamsfi(i)%P(1),2*lenr)
4352 ALLOCATE (procamsfi(i)%P(2*lenr),stat=ierror1)
4353 ierror = ierror + ierror1
4354 CALL read_i_c(procamsfi(i)%P(1),2*lenr)
4355 ELSEIF(idtmins_int_old /= 0) THEN
4356 ALLOCATE (nodamsfi(i)%P(2*lenr),stat=ierror1)
4357 ierror = ierror + ierror1
4358 CALL read_i_c(nodamsfi(i)%P(1),2*lenr)
4359 ALLOCATE (procamsfi(i)%P(2*lenr),stat=ierror1)
4360 ierror = ierror + ierror1
4361 CALL read_i_c(procamsfi(i)%P(1),2*lenr)
4362 ENDIF
4363C
4364 IF(intth > 0 ) THEN
4365 ALLOCATE(matsfi(i)%P(lenr),stat=ierror1)
4366 ierror = ierror + ierror1
4367 CALL read_i_c(matsfi(i)%P(1),lenr)
4368 ENDIF
4369C
4370 IF(intfric > 0) THEN
4371 ALLOCATE(ipartfricsfi(i)%P(lenr),stat=ierror1)
4372 ierror = ierror + ierror
4373 CALL read_i_c(ipartfricsfi(i)%P(1),lenr)
4374 ENDIF
4375C
4376 ALLOCATE(msfi(i)%P(2*lenr),stat=ierror1)
4377 ierror = ierror + ierror1
4378 ALLOCATE(stifi(i)%P(lenr),stat=ierror1)
4379 ierror = ierror + ierror1
4380 IF(igap/=0)THEN
4381 ALLOCATE(gapfi(i)%P(lenr),stat=ierror1)
4382 ierror = ierror + ierror1
4383 IF(igap==3)THEN
4384 ALLOCATE(gap_lfi(i)%P(lenr),stat=ierror1)
4385 ierror = ierror + ierror1
4386 END IF
4387 END IF
4388 ALLOCATE(xfi(i)%P(3,2*lenr),stat=ierror1)
4389 ierror = ierror + ierror1
4390 ALLOCATE(vfi(i)%P(3,2*lenr),stat=ierror1)
4391 ierror = ierror + ierror1
4392 IF(inacti==5.OR.inacti==6) THEN
4393 ALLOCATE(penfi(i)%P(2,lenr),stat=ierror1)
4394 END IF
4395 IF(iparit==0) THEN
4396 ALLOCATE(afi(i)%P(3,2*lenr*nthread),stat=ierror1)
4397 ierror = ierror + ierror1
4398 ALLOCATE(stnfi(i)%P(2*lenr*nthread),stat=ierror1)
4399 ierror = ierror + ierror1
4400 IF(kdtint/=0)THEN
4401 ALLOCATE(vscfi(i)%P(2*lenr*nthread),stat=ierror1)
4402 ierror = ierror + ierror1
4403 ENDIF
4404 IF(intth > 0 )THEN
4405 ALLOCATE(fthefi(i)%P(2*lenr*nthread),stat=ierror1)
4406 ierror = ierror + ierror1
4407 ALLOCATE(tempfi(i)%P(2*lenr),stat=ierror1)
4408 ierror = ierror + ierror1
4409c ALLOCATE(MATSFI(I)%P(LENR),STAT=IERROR1)
4410c IERROR = IERROR + IERROR
4411 ALLOCATE(areasfi(i)%P(lenr),stat=ierror1)
4412 ierror = ierror + ierror1
4413 ENDIF
4414 IF(idt_therm ==1.AND.intth > 0) THEN
4415 ALLOCATE(condnfi(i)%P(2*lenr*nthread),stat=ierror1)
4416 ierror = ierror + ierror1
4417 ENDIF
4418 nlskyfi(i) = 2*lenr
4419
4420 ELSE
4421 lskyfi = 0
4422 nlskyfi(i) = 0
4423
4424 IF(intth > 0 ) THEN
4425 ALLOCATE(tempfi(i)%P(2*lenr),stat=ierror1)
4426 ierror = ierror + ierror1
4427c ALLOCATE(MATSFI(I)%P(LENR),STAT=IERROR1)
4428c IERROR = IERROR + IERROR
4429 ENDIF
4430
4431 IF(intth>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
4432 ALLOCATE(areasfi(i)%P(lenr),stat=ierror1)
4433 ierror = ierror + ierror1
4434 ENDIF
4435 END IF
4436C fin type11
4437 ELSEIF(ityp==17)THEN
4438 ALLOCATE(xfi17(i)%P(3,16,lenr),stat=ierror1)
4439 ierror = ierror + ierror1
4440 ALLOCATE(vfi17(i)%P(3,16,lenr),stat=ierror1)
4441 ierror = ierror + ierror1
4442 ALLOCATE(frotsfi(i)%P(7,lenr),stat=ierror1)
4443 ierror = ierror + ierror1
4444 ALLOCATE(ksfi(i)%P(2,lenr),stat=ierror1)
4445 ierror = ierror + ierror1
4446 ALLOCATE(eminxfi(i)%P(6,lenr),stat=ierror1)
4447 ierror = ierror + ierror1
4448 IF(iparit==0) THEN
4449 ALLOCATE(afi17(i)%P(3,16,lenr),stat=ierror1)
4450 ierror = ierror + ierror1
4451 ALLOCATE(stnfi17(i)%P(16,lenr),stat=ierror1)
4452 ierror = ierror + ierror1
4453 nlskyfi(i) = 0
4454 ELSE
4455 lskyfi = lenr * multimax
4456 nlskyfi(i) = lskyfi
4457
4458 ALLOCATE(iskyfi(i)%P(lskyfi),stat=ierror1)
4459 ierror = ierror + ierror1
4460 ALLOCATE(fskyfi(i)%P(40,lskyfi),stat=ierror1)
4461 ierror = ierror + ierror1
4462 END IF
4463C fin type 17
4464 END IF
4465C Lenr case = 0, we don't need an iskyfi and fskyfi table
4466 ELSE
4467 nlskyfi(i) = 0
4468 ENDIF
4469C
4470 IF(ierror/=0) THEN
4471 CALL ancmsg(msgid=20,anmode=aninfo)
4472 CALL arret(2)
4473 ENDIF
4474C
4475 IF(ityp==20)THEN
4476 ALLOCATE(daanc6fi(i)%P(3,6,lenr),stat=ierror1)
4477 ierror = ierror + ierror1
4478 ALLOCATE(dxancfi(i)%P(3,lenr),stat=ierror1)
4479 ierror = ierror + ierror1
4480 ALLOCATE(dvancfi(i)%P(3,lenr),stat=ierror1)
4481 ierror = ierror + ierror1
4482 IF((inacti==5.OR.inacti==6) .AND. lenr > 0) THEN
4483 ALLOCATE(penfi(i)%P(2,lenr),stat=ierror1)
4484 ierror = ierror + ierror1
4485 ALLOCATE(penfia(i)%P(5,lenr),stat=ierror1)
4486 ierror = ierror + ierror1
4487 END IF
4488 IF(idtmins_old > 0 .OR. idtmins_int_old /= 0) THEN
4489 ALLOCATE (diag_smsfi(i)%P(lenr),stat=ierror1)
4490 ierror = ierror + ierror1
4491 ENDIF
4492 ALLOCATE(alphakfi(i)%P(lenr),stat=ierror1)
4493 ierror = ierror + ierror1
4494 ALLOCATE(daancfi(i)%P(3,lenr),stat=ierror1)
4495 daancfi(i)%P(1:3,1:lenr)=zero
4496 ierror = ierror + ierror1
4497 IF(ierror/=0) THEN
4498 CALL ancmsg(msgid=20,anmode=aninfo)
4499 CALL arret(2)
4500 END IF
4501C type20 edge
4502 ALLOCATE(nsnsie(i)%P(nspmd),stat=ierror1)
4503 ierror = ierror + ierror1
4504 ALLOCATE(nsnfie(i)%P(nspmd),stat=ierror1)
4505 ierror = ierror + ierror1
4506 CALL read_i_c(nsnsie(i)%P(1),nspmd)
4507 CALL read_i_c(nsnfie(i)%P(1),nspmd)
4508 lens = 0
4509 lenr = 0
4510 DO p = 1, nspmd
4511 lens = lens + nsnsie(i)%P(p)
4512 lenr = lenr + nsnfie(i)%P(p)
4513 END DO
4514C
4515 IF(lens>0) THEN
4516 ALLOCATE(nsvsie(i)%P(lens),stat=ierror1)
4517 CALL read_i_c(nsvsie(i)%P(1),lens)
4518 ierror = ierror + ierror1
4519 ENDIF
4520C
4521 IF(lenr>0) THEN
4522 ALLOCATE(nsvfie(i)%P(lenr),stat=ierror1)
4523 ierror = ierror + ierror1
4524 CALL read_i_c(nsvfie(i)%P(1),lenr)
4525 ALLOCATE(itafie(i)%P(2*lenr),stat=ierror1)
4526 ierror = ierror + ierror1
4527 CALL read_i_c(itafie(i)%P(1),2*lenr)
4528 ALLOCATE(msfie(i)%P(2*lenr),stat=ierror1)
4529 ierror = ierror + ierror1
4530 ALLOCATE(stifie(i)%P(lenr),stat=ierror1)
4531 ierror = ierror + ierror1
4532 IF(igap/=0)THEN
4533 ALLOCATE(gapfie(i)%P(lenr),stat=ierror1)
4534 ierror = ierror + ierror1
4535 END IF
4536 ALLOCATE(xfie(i)%P(3,2*lenr),stat=ierror1)
4537 ierror = ierror + ierror1
4538 ALLOCATE(vfie(i)%P(3,2*lenr),stat=ierror1)
4539 ierror = ierror + ierror1
4540 IF(inacti==5.OR.inacti==6) THEN
4541 ALLOCATE(penfie(i)%P(2,lenr),stat=ierror1)
4542 ierror = ierror + ierror1
4543 ALLOCATE(penfiae(i)%P(5,2*lenr),stat=ierror1)
4544 ierror = ierror + ierror1
4545 END IF
4546 IF(iparit==0) THEN
4547 ALLOCATE(afie(i)%P(3,2*lenr*nthread),stat=ierror1)
4548 ierror = ierror + ierror1
4549 ALLOCATE(stnfie(i)%P(2*lenr*nthread),stat=ierror1)
4550 ierror = ierror + ierror1
4551 IF(kdtint/=0)THEN
4552 ALLOCATE(vscfie(i)%P(2*lenr*nthread),stat=ierror1)
4553 ierror = ierror + ierror1
4554 ENDIF
4555 nlskyfie(i) = 2*lenr
4556 ELSE
4557 lskyfi = lenr * multimax
4558 nlskyfie(i) = lskyfi
4559 ALLOCATE(iskyfie(i)%P(lskyfi),stat=ierror1)
4560 ierror = ierror + ierror1
4561 IF(kdtint==0) THEN
4562C ALLOCATE(FSKYFIE(I)%P(8,LSKYFI),STAT=IERROR1)
4563 ALLOCATE(fskyfie(i)%P(10,lskyfi),stat=ierror1)
4564
4565 ELSE
4566 ALLOCATE(fskyfie(i)%P(10,lskyfi),stat=ierror1)
4567 END IF
4568 ierror = ierror + ierror1
4569 END IF
4570 ALLOCATE(daanc6fie(i)%P(3,6,2*lenr),stat=ierror1)
4571 ierror = ierror + ierror1
4572 ALLOCATE(dxancfie(i)%P(3,2*lenr),stat=ierror1)
4573 ierror = ierror + ierror1
4574 ALLOCATE(dvancfie(i)%P(3,2*lenr),stat=ierror1)
4575 ierror = ierror + ierror1
4576 ALLOCATE(alphakfie(i)%P(2*lenr),stat=ierror1)
4577 ierror = ierror + ierror1
4578 ALLOCATE(daancfie(i)%P(3,lenr),stat=ierror1)
4579 ierror = ierror + ierror1
4580 IF(idtmins_old > 0 .OR. idtmins_int_old /= 0) THEN
4581 ALLOCATE (diag_smsfie(i)%P(lenr),stat=ierror1)
4582 ierror = ierror + ierror1
4583 ENDIF
4584C
4585 IF(idtmins_old == 2) THEN
4586 ALLOCATE (nodnxfie(i)%P(lenr),stat=ierror1)
4587 ierror = ierror + ierror1
4588 CALL read_i_c(nodnxfie(i)%P(1),lenr)
4589 ALLOCATE (nodamsfie(i)%P(lenr),stat=ierror1)
4590 ierror = ierror + ierror1
4591 CALL read_i_c(nodamsfie(i)%P(1),lenr)
4592 ALLOCATE (procamsfie(i)%P(lenr),stat=ierror1)
4593 ierror = ierror + ierror1
4594 CALL read_i_c(procamsfie(i)%P(1),lenr)
4595 ELSEIF(idtmins_int_old /= 0) THEN
4596 ALLOCATE (nodamsfie(i)%P(lenr),stat=ierror1)
4597 ierror = ierror + ierror1
4598 CALL read_i_c(nodamsfie(i)%P(1),lenr)
4599 ALLOCATE (procamsfie(i)%P(lenr),stat=ierror1)
4600 ierror = ierror + ierror1
4601 CALL read_i_c(procamsfie(i)%P(1),lenr)
4602 ENDIF
4603C
4604 IF(ierror/=0) THEN
4605 CALL ancmsg(msgid=20,anmode=aninfo)
4606 CALL arret(2)
4607 END IF
4608C Lenr case = 0, we don't need an iskyfi and fskyfi table
4609 ELSE
4610 nlskyfie(i) = 0
4611 END IF
4612 END IF ! Fin type20 edge
4613
4614 IF(ityp == 25 ) THEN
4615 ALLOCATE(edge_fi(i)%P(nspmd))
4616 ALLOCATE(nsnsie(i)%P(nspmd),stat=ierror1)
4617 ALLOCATE(nsnfie(i)%P(nspmd),stat=ierror1)
4618 edge_fi(i)%P(1:nspmd) = 0
4619 nsnsie(i)%P(1:nspmd) = 0
4620 nsnfie(i)%P(1:nspmd) = 0
4621
4622 IF(ipari(58,i) /=0) THEN
4623
4624 CALL read_i_c(nsnsie(i)%P(1),nspmd)
4625 CALL read_i_c(nsnfie(i)%P(1),nspmd)
4626
4627 lens_edge = 0
4628 lenr_edge = 0
4629 DO p = 1, nspmd
4630 lens_edge = lens_edge + nsnsie(i)%P(p)
4631 lenr_edge = lenr_edge + nsnfie(i)%P(p)
4632 END DO
4633C
4634 IF(lens_edge>0) THEN
4635 ALLOCATE(nsvsie(i)%P(lens_edge),stat=ierror1)
4636 CALL read_i_c(nsvsie(i)%P(1),lens_edge)
4637 ierror = ierror + ierror1
4638 ENDIF
4639C
4640 IF(iparit == 0) THEN
4641 nlskyfie(i) = lenr_edge*2
4642 ALLOCATE(afie(i)%P(3,2*lenr_edge*nthread),stat=ierror1)
4643 ierror = ierror + ierror1
4644 ALLOCATE(stnfie(i)%P(2*lenr_edge*nthread),stat=ierror1)
4645 ierror = ierror + ierror1
4646 IF(kdtint/=0)THEN
4647 ALLOCATE(vscfie(i)%P(2*lenr_edge*nthread),stat=ierror1)
4648 ierror = ierror + ierror1
4649 ENDIF
4650 ELSE
4651 lskyfi = lenr_edge * multimax
4652 nlskyfie(i) = lskyfi
4653 ALLOCATE(iskyfie(i)%P(lskyfi),stat=ierror1)
4654 ierror = ierror + ierror1
4655 IF(kdtint==0) THEN
4656 ALLOCATE(fskyfie(i)%P(8,lskyfi),stat=ierror1)
4657 ELSE
4658 ALLOCATE(fskyfie(i)%P(8,lskyfi),stat=ierror1)
4659 END IF
4660 ierror = ierror + ierror1
4661 ENDIF
4662 IF(lenr_edge>0) THEN
4663 ALLOCATE(nsvfie(i)%P(lenr_edge))
4664 ALLOCATE(itafie(i)%P(lenr_edge*2))
4665 ALLOCATE(ledge_fie(i)%P(e_ledge_size,lenr_edge))
4666 ALLOCATE(xfie(i)%P(3,lenr_edge*2))
4667 ALLOCATE(vfie(i)%P(3,lenr_edge*2))
4668 ALLOCATE(msfie(i)%P(lenr_edge*2))
4669 ALLOCATE(gapfie(i)%P(lenr_edge))
4670 IF( igap == 3) THEN
4671 ALLOCATE(gape_l_fie(i)%P(lenr_edge))
4672 ENDIF
4673 ALLOCATE(stifie(i)%P(lenr_edge))
4674 ALLOCATE(edg_bisector_fie(i)%P(3,3,lenr_edge))
4675 ALLOCATE(vtx_bisector_fie(i)%P(3,4,lenr_edge))
4676 ALLOCATE(x_seg_fie(i)%P(3,4,lenr_edge))
4677 edg_bisector_fie(i)%P(1:3,1:3,1:lenr_edge) = 0
4678 vtx_bisector_fie(i)%P(1:3,1:4,1:lenr_edge) = 0
4679 x_seg_fie(i)%P(1:3,1:4,1:lenr_edge) = 0
4680
4681 CALL read_i_c(nsvfie(i)%P,lenr_edge)
4682
4683 CALL read_i_c(ledge_fie(i)%P,e_ledge_size*lenr_edge)
4684 ipari(69,i) = lenr_edge
4685 IF(intfric > 0) THEN
4686 ALLOCATE(ipartfric_fie(i)%P(lenr_edge),stat=ierror1)
4687 CALL read_i_c(ipartfric_fie(i)%P,lenr_edge)
4688 ENDIF
4689 IF(ipari(97,i) > 0) THEN
4690 ALLOCATE(stife_msdt_fi(i)%P(lenr_edge))
4691 stife_msdt_fi(i)%P(1:lenr_edge)=zero
4692 ENDIF
4693
4694 ENDIF
4695 ENDIF
4696 ENDIF
4697
4698C
4699C
4700 IF(ipari(36,i)>0.AND.ipari(7,i)/=17) THEN
4701C Output structure under interfaces
4702 ierror = 0
4703 ALLOCATE(nisubsfi(i)%P(nspmd),stat=ierror1)
4704 ierror = ierror + ierror1
4705 CALL read_i_c(nisubsfi(i)%P(1),nspmd)
4706 leni = 0
4707 lenr = 0
4708 DO p = 1, nspmd
4709 leni = leni + nisubsfi(i)%P(p)
4710 lenr = lenr + nsnfi(i)%P(p)
4711 END DO
4712
4713 IF(leni>0) THEN
4714 IF(lenr>0) THEN
4715 ALLOCATE(addsubsfi(i)%P(lenr+1),stat=ierror1)
4716 ierror = ierror + ierror1
4717 CALL read_i_c(addsubsfi(i)%P(1),lenr+1)
4718 END IF
4719 ALLOCATE(lisubsfi(i)%P(leni),stat=ierror1)
4720 ierror = ierror + ierror1
4721 CALL read_i_c(lisubsfi(i)%P(1),leni)
4722 IF(ipari(7,i)==25.OR.ipari(7,i)==7.OR.ipari(7,i)==24.OR.ipari(7,i)==11)THEN
4723 ALLOCATE(inflg_subsfi(i)%P(leni),stat=ierror1)
4724 ierror = ierror + ierror1
4725 CALL read_i_c(inflg_subsfi(i)%P(1),leni)
4726 END IF
4727 ELSE
4728 IF(lenr>0) THEN
4729 ALLOCATE(addsubsfi(i)%P(lenr+1),stat=ierror1)
4730 DO j=1,lenr+1
4731 addsubsfi(i)%P(j)=1
4732 END DO
4733 END IF
4734 END IF
4735 IF(ierror/=0) THEN
4736 CALL ancmsg(msgid=20,anmode=aninfo)
4737 CALL arret(2)
4738 END IF
4739C =================== EDGES TO EDGE
4740C Output structure under interfaces
4741 IF(ipari(7,i) == 25 .AND. ipari(58,i) > 0) THEN
4742 ierror = 0
4743 ALLOCATE(nisubsfie(i)%P(nspmd),stat=ierror1)
4744 ierror = ierror + ierror1
4745 CALL read_i_c(nisubsfie(i)%P(1),nspmd)
4746 leni = 0
4747 DO p = 1, nspmd
4748 leni = leni + nisubsfie(i)%P(p)
4749 END DO
4750 IF(leni>0) THEN
4751 IF(lenr_edge>0) THEN
4752 ALLOCATE(addsubsfie(i)%P(lenr_edge+1),stat=ierror1)
4753 ierror = ierror + ierror1
4754 CALL read_i_c(addsubsfie(i)%P(1),lenr_edge+1)
4755 END IF
4756 ALLOCATE(lisubsfie(i)%P(leni),stat=ierror1)
4757 ierror = ierror + ierror1
4758 CALL read_i_c(lisubsfie(i)%P(1),leni)
4759 ALLOCATE(inflg_subsfie(i)%P(leni),stat=ierror1)
4760 ierror = ierror + ierror1
4761 CALL read_i_c(inflg_subsfie(i)%P(1),leni)
4762 ELSE
4763 IF(lenr_edge>0) THEN
4764 ALLOCATE(addsubsfie(i)%P(lenr_edge+1),stat=ierror1)
4765 DO j=1,lenr_edge+1
4766 addsubsfie(i)%P(j)=1
4767 END DO
4768 END IF
4769 END IF
4770 ENDIF
4771 END IF
4772
4773C
4774 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT >0)THEN
4775 ierror = 0
4776 ALLOCATE(fnconti(i)%P(3,lenr),stat=ierror1)
4777 ierror = ierror + ierror1
4778 ALLOCATE(ftconti(i)%P(3,lenr),stat=ierror1)
4779 ierror = ierror + ierror1
4780 IF(ierror/=0) THEN
4781 CALL ancmsg(msgid=20,anmode=aninfo)
4782 CALL arret(2)
4783 ELSE
4784 DO j = 1, lenr
4785 fnconti(i)%P(1,j)=zero
4786 fnconti(i)%P(2,j)=zero
4787 fnconti(i)%P(3,j)=zero
4788 ftconti(i)%P(1,j)=zero
4789 ftconti(i)%P(2,j)=zero
4790 ftconti(i)%P(3,j)=zero
4791 END DO
4792 END IF
4793 END IF
4794 END IF
4795C
4796C Allocate and Read in RST file inter 21 structure for nodal temperature
4797C Actualisation
4798C
4799 IF(ityp==21) THEN
4800C
4801 IF(intth==2.OR.ipari(95,i) > 0) THEN
4802 nbintc = nbintc + 1
4803C
4804 ierror = 0
4805C
4806 ierror1 = 0
4807 ALLOCATE(nmnsi(i)%P(nspmd),stat=ierror1)
4808 ierror = ierror + ierror1
4809C
4810 ALLOCATE(nmnfi(i)%P(nspmd),stat=ierror1)
4811 ierror = ierror + ierror1
4812 IF(ierror/=0) THEN
4813 CALL ancmsg(msgid=20,anmode=aninfo)
4814 CALL arret(2)
4815 ENDIF
4816 CALL read_i_c(nmnsi(i)%P(1),nspmd)
4817 CALL read_i_c(nmnfi(i)%P(1),nspmd)
4818 lens = 0
4819 lenr = 0
4820 DO p = 1, nspmd
4821 lens = lens + nmnsi(i)%P(p)
4822 lenr = lenr + nmnfi(i)%P(p)
4823 END DO
4824C
4825 ierror = 0
4826C
4827 ierror1 = 0
4828 IF(lens>0) THEN
4829 ALLOCATE(nmvsi(i)%P(lens),stat=ierror1)
4830 CALL read_i_c(nmvsi(i)%P(1),lens)
4831 ierror = ierror + ierror1
4832
4833 ALLOCATE(tempnod(i)%P(lens),stat=ierror1)
4834 CALL read_i_c(tempnod(i)%P(1),lens)
4835 ierror = ierror + ierror1
4836
4837 ENDIF
4838C
4839 IF(lenr>0) THEN
4840 ALLOCATE(nmvfi(i)%P(lenr),stat=ierror1)
4841 ierror = ierror + ierror1
4842
4843 IF(ierror/=0) THEN
4844 CALL ancmsg(msgid=20,anmode=aninfo)
4845 CALL arret(2)
4846 ENDIF
4847
4848 CALL read_i_c(nmvfi(i)%P(1),lenr)
4849
4850 IF(ipari(95,i) > 0) THEN
4851 ALLOCATE(tagncontfi(i)%P(lenr),stat=ierror1)
4852 DO j = 1, lenr
4853 tagncontfi(i)%P(j)=0
4854 END DO
4855 ENDIF
4856
4857 IF(ipari(48,i) /= 0 )THEN
4858 IF(iparit==0) THEN
4859 ALLOCATE(fthefi(i)%P(lenr*nthread),stat=ierror1)
4860 ierror = ierror + ierror1
4861
4862 fthefi(i)%P(1:lenr*nthread)=zero
4863 ELSE
4864 lskyfi = lenr * multimax
4865 ALLOCATE(iskyfi(i)%P(lskyfi),stat=ierror1)
4866 ierror = ierror + ierror1
4867 ALLOCATE(ftheskyfi(i)%P(lskyfi),stat=ierror1)
4868 ierror = ierror + ierror1
4869 iskyfi(i)%P(1:lskyfi)=0
4870 ftheskyfi(i)%P(1:lskyfi)=zero
4871 ENDIF
4872 ENDIF
4873
4874 ENDIF
4875C
4876
4877 ENDIF
4878 ENDIF
4879 ENDDO
4880C Buffer Allocation Exchanges => replaced by Dynamic Alloc in the exchanges
4881 ENDIF
4882C
4883
4884 ELSE
4885C Iflag = 2 Reading part Reel
4886 IF(ninter/=0) THEN
4887 DO i =1, ninter
4888 ityp = ipari(7,i)
4889 ivis2 = ipari(14,i) ! ivis2==-1 : Flag for interface adhesion
4890 igap = ipari(21,i)
4891 inacti = ipari(22,i)
4892 intth = ipari(47,i)
4893 IF(ityp==7.OR.ityp==10.OR.ityp==11.OR.
4894 + (ityp==17.AND.ipari(33,i)==0).OR.ityp==20.OR.
4895 + ityp==22.OR.ityp==23.OR.ityp==24.OR.
4896 + ityp==25)THEN
4897 lenr = 0
4898 DO p = 1, nspmd
4899 lenr = lenr + nsnfi(i)%P(p)
4900 END DO
4901 IF(lenr>0) THEN
4902 IF(ityp==7.OR.ityp==22.OR.ityp==23.OR.
4903 + ityp==20.OR.ityp==10.OR.ityp==24.OR.
4904 + ityp==25)THEN
4905 CALL read_db(msfi(i)%P(1),lenr)
4906 CALL read_db(stifi(i)%P(1),lenr)
4907 IF(igap/=0)THEN
4908 CALL read_db(gapfi(i)%P(1),lenr)
4909 IF(igap==3)THEN
4910 CALL read_db(gap_lfi(i)%P(1),lenr)
4911 END IF
4912 END IF
4913 CALL read_db(xfi(i)%P(1,1),3*lenr)
4914 CALL read_db(vfi(i)%P(1,1),3*lenr)
4915C
4916 IF((ityp == 7.OR.ityp == 20.OR.
4917 + ityp==22.OR.ityp==23.OR.ityp==24.OR.
4918 + ityp==25).AND.ipari(47,i) > 0) THEN
4919 CALL read_db(tempfi(i)%P(1),lenr)
4920 ENDIF
4921 IF(intth>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
4922 CALL read_db(areasfi(i)%P(1),lenr)
4923 ENDIF
4924 IF(ityp == 25.AND.ivis2==-1) THEN
4925 CALL read_i_c(if_adhfi(i)%P(1),lenr)
4926 ENDIF
4927
4928
4929C
4930 ELSEIF(ityp==11) THEN
4931 CALL read_db(msfi(i)%P(1),2*lenr)
4932 CALL read_db(stifi(i)%P(1),lenr)
4933 IF(igap/=0)THEN
4934 CALL read_db(gapfi(i)%P(1),lenr)
4935 IF(igap==3)THEN
4936 CALL read_db(gap_lfi(i)%P(1),lenr)
4937 END IF
4938 END IF
4939 CALL read_db(xfi(i)%P(1,1),3*2*lenr)
4940 CALL read_db(vfi(i)%P(1,1),3*2*lenr)
4941 IF(inacti==5.OR.inacti==6) THEN
4942 CALL read_db(penfi(i)%P(1,1),2*lenr)
4943 END IF
4944 IF(ipari(47,i)>0) THEN
4945 CALL read_db(tempfi(i)%P(1),2*lenr)
4946 CALL read_db(areasfi(i)%P(1),lenr)
4947 ENDIF
4948 ELSEIF(ityp==17.AND.ipari(33,i)==0)THEN
4949 CALL read_db(xfi17(i)%P(1,1,1),3*16*lenr)
4950 CALL read_db(vfi17(i)%P(1,1,1),3*16*lenr)
4951 CALL read_db(frotsfi(i)%P(1,1),7*lenr)
4952 CALL read_db(ksfi(i)%P(1,1),2*lenr)
4953 CALL read_db(eminxfi(i)%P(1,1),6*lenr)
4954 END IF
4955 END IF
4956 END IF
4957C Int 20 Specifique
4958 IF(ityp==20)THEN
4959C Addition anchoring
4960 IF(lenr>0) THEN
4961 CALL read_db(daanc6fi(i)%P(1,1,1),3*6*lenr)
4962 CALL read_db(dxancfi(i)%P(1,1),3*lenr)
4963 CALL read_db(dvancfi(i)%P(1,1),3*lenr)
4964 IF(inacti==5.OR.inacti==6) THEN
4965 CALL read_db(penfi(i)%P(1,1),2*lenr)
4966 CALL read_db(penfia(i)%P(1,1),5*lenr)
4967 END IF
4968 CALL read_db(daancfi(i)%P(1,1),3*lenr)
4969 CALL read_db(alphakfi(i)%P(1),lenr)
4970 IF(idtmins_old > 0 .OR. idtmins_int_old /= 0) THEN
4971 CALL read_db(diag_smsfi(i)%P(1),lenr)
4972 ENDIF
4973 END IF
4974C Edge part addition
4975 lenr = 0
4976 DO p = 1, nspmd
4977 lenr = lenr + nsnfie(i)%P(p)
4978 END DO
4979 IF(lenr>0) THEN
4980 CALL read_db(msfie(i)%P(1),2*lenr)
4981 CALL read_db(stifie(i)%P(1),lenr)
4982 IF(igap/=0)THEN
4983 CALL read_db(gapfie(i)%P(1),lenr)
4984 END IF
4985 CALL read_db(xfie(i)%P(1,1),3*2*lenr)
4986 CALL read_db(vfie(i)%P(1,1),3*2*lenr)
4987 IF(inacti==5.OR.inacti==6) THEN
4988 CALL read_db(penfie(i)%P(1,1),2*lenr)
4989 CALL read_db(penfiae(i)%P(1,1),5*2*lenr)
4990 END IF
4991 CALL read_db(daanc6fie(i)%P(1,1,1),3*6*2*lenr)
4992 CALL read_db(dxancfie(i)%P(1,1),3*2*lenr)
4993 CALL read_db(dvancfie(i)%P(1,1),3*2*lenr)
4994 IF(idtmins_old > 0 .OR. idtmins_int_old /= 0) THEN
4995 CALL read_db(diag_smsfie(i)%P(1),lenr)
4996 ENDIF
4997 END IF
4998 END IF ! fin partie type 20 edge
4999 IF (ityp==24)THEN
5000 CALL read_db(time_sfi(i)%P(1),lenr)
5001 ELSEIF(ityp==25)THEN
5002 CALL read_db(time_sfi(i)%P(1),2*lenr)
5003 END IF
5004 IF (ityp==24.OR.ityp==25)THEN
5005 CALL read_db(secnd_frfi(i)%P(1,1),6*lenr)
5006 CALL read_db(pene_oldfi(i)%P(1,1),5*lenr)
5007 CALL read_db(stif_oldfi(i)%P(1,1),2*lenr)
5008 IF(ipari(97,i) > 0) THEN
5009 CALL read_db(stif_msdt_fi(i)%P(1),lenr) ! stif based on mass and dt
5010 ENDIF
5011 IF(ityp==25.AND.parameters%INTCAREA > 0.AND.ipari(36,i)>0) THEN
5012 CALL read_db(intareanfi(i)%P(1),lenr) ! Area of secondary node
5013 ENDIF
5014 IF(ityp==24.AND.parameters%INTCAREA > 0) THEN
5015 CALL read_db(intareanfi(i)%P(1),lenr) ! Area of secondary node
5016 ENDIF
5017 ENDIF ! fin partie type 24 & 25
5018C
5019 IF (ityp==24) THEN
5020 IF(idtmins_old == 2) THEN
5021 ALLOCATE (t2fac_sms_fi(i)%P(lenr),stat=ierror1)
5022 ierror = ierror + ierror1
5023 CALL read_db(t2fac_sms_fi(i)%P(1),lenr)
5024 ELSEIF(idtmins_int_old /= 0) THEN
5025 ALLOCATE (t2fac_sms_fi(i)%P(lenr),stat=ierror1)
5026 ierror = ierror + ierror1
5027 CALL read_db(t2fac_sms_fi(i)%P(1),lenr)
5028 ENDIF
5029C
5030 IF(idtmins==2) THEN
5031 IF(.NOT.ASSOCIATED(t2fac_sms_fi(i)%P)) THEN
5032 ALLOCATE (t2fac_sms_fi(i)%P(lenr),stat=ierror1)
5033 ierror = ierror + ierror1
5034 t2fac_sms_fi(i)%P(1:lenr)=0
5035 ENDIF
5036 ELSEIF(idtmins_int /= 0) THEN
5037 IF(.NOT.ASSOCIATED(t2fac_sms_fi(i)%P)) THEN
5038 ALLOCATE (t2fac_sms_fi(i)%P(lenr),stat=ierror1)
5039 ierror = ierror + ierror1
5040 t2fac_sms_fi(i)%P(1:lenr)=0
5041 ENDIF
5042 END IF
5043 ENDIF
5044
5045 IF(ityp == 25 ) THEN
5046 IF(ipari(58,i) /=0) THEN !E2E
5047 lenr = 0
5048 DO p = 1, nspmd
5049 lenr = lenr + nsnfie(i)%P(p)
5050 END DO
5051 IF(lenr>0) THEN
5052 CALL read_db(xfie(i)%P(1,1),3*(lenr*2))
5053 CALL read_db(vfie(i)%P(1,1),3*(lenr*2))
5054 CALL read_db(msfie(i)%P(1),lenr*2)
5055 CALL read_db(stifie(i)%P(1),lenr)
5056 CALL read_db(gapfie(i)%P(1),lenr)
5057 IF( igap == 3) THEN
5058 CALL read_db(gape_l_fie(i)%P,lenr)
5059 ENDIF
5060 CALL read_r_c(edg_bisector_fie(i)%P(1,1,1),3*3*lenr)
5061 CALL read_r_c(vtx_bisector_fie(i)%P(1,1,1),3*4*lenr)
5062 CALL read_db(x_seg_fie(i)%P(1,1,1),3*4*lenr)
5063 IF(idtmins_old == 2) THEN
5064 ALLOCATE(nodnxfie(i)%P(lenr*2))
5065 CALL read_i_c(nodnxfie(i)%P(1),lenr*2)
5066 ALLOCATE(nodamsfie(i)%P(lenr*2))
5067 CALL read_i_c(nodamsfie(i)%P(1),lenr*2)
5068 ALLOCATE(procamsfie(i)%P(lenr*2))
5069 CALL read_i_c(procamsfie(i)%P(1),lenr*2)
5070 ELSEIF(idtmins_int_old /= 0) THEN
5071 ALLOCATE(nodamsfie(i)%P(lenr*2))
5072 CALL read_i_c(nodamsfie(i)%P(1),lenr*2)
5073 ALLOCATE(procamsfie(i)%P(lenr*2))
5074 CALL read_i_c(procamsfie(i)%P(1),lenr*2)
5075 ENDIF
5076
5077 IF(ipari(97,i) > 0) THEN
5078 CALL read_db(stife_msdt_fi(i)%P(1),lenr)
5079 ENDIF
5080 ENDIF
5081 ENDIF
5082 ENDIF
5083
5084 IF(ityp==21) THEN
5085C
5086 IF(intth==2) THEN
5087C
5088 lenr = 0
5089 DO p = 1, nspmd
5090 lenr = lenr + nmnfi(i)%P(p)
5091 END DO
5092C
5093 ierror = 0
5094C
5095 ierror1 = 0
5096C
5097 IF(lenr>0) THEN
5098 ALLOCATE(nmtemp(i)%P(lenr),stat=ierror1)
5099 ierror = ierror + ierror1
5100 CALL read_db(nmtemp(i)%P(1),lenr)
5101 ENDIF
5102 IF(ierror/=0) THEN
5103 CALL ancmsg(msgid=20,anmode=aninfo)
5104 CALL arret(2)
5105 ENDIF
5106 ENDIF
5107 ENDIF
5108C
5109 END DO
5110 END IF
5111 END IF
5112C
5113 RETURN
5114 END
5115C
5116!||====================================================================
5117!|| spmd_savefi ../engine/source/mpi/interfaces/spmd_i7tool.F
5118!||--- called by ------------------------------------------------------
5119!|| wrrestp ../engine/source/output/restart/wrrestp.F
5120!||--- calls -----------------------------------------------------
5121!|| write_db ../common_source/tools/input_output/write_db.F
5122!|| write_i_c ../common_source/tools/input_output/write_routines.c
5123!|| write_r_c ../common_source/tools/input_output/write_routines.c
5124!||--- uses -----------------------------------------------------
5125!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
5126!|| interface_modification_mod ../engine/share/modules/interface_modification_mod.F
5127!|| intstamp_glob_mod ../engine/share/modules/intstamp_glob_mod.F
5128!|| parameters_mod ../common_source/modules/interfaces/parameters_mod.F
5129!|| sensor_mod ../common_source/modules/sensor_mod.F90
5130!|| tri25ebox ../engine/share/modules/tri25ebox.F
5131!|| tri7box ../engine/share/modules/tri7box.f
5132!||====================================================================
5133 SUBROUTINE spmd_savefi(IPARI, IFLAG,INTBUF_TAB,NSENSOR,SENSOR_TAB,PARAMETERS)
5134C-----------------------------------------------
5135C M o d u l e s
5136C-----------------------------------------------
5137 USE tri7box
5138 USE tri25ebox
5139 USE intbufdef_mod
5140 USE intstamp_glob_mod
5141 USE interface_modification_mod
5142 USE sensor_mod
5143 USE parameters_mod
5144C-----------------------------------------------
5145C I m p l i c i t T y p e s
5146C-----------------------------------------------
5147#include "implicit_f.inc"
5148C-----------------------------------------------
5149C C o m m o n B l o c k s
5150C-----------------------------------------------
5151#include "com01_c.inc"
5152#include "com04_c.inc"
5153#include "com08_c.inc"
5154#include "param_c.inc"
5155#include "sms_c.inc"
5156C-----------------------------------------------
5157C D u m m y A r g u m e n t s
5158C-----------------------------------------------
5159 INTEGER ,INTENT(IN) :: NSENSOR
5160 INTEGER IPARI(NPARI,*), IFLAG
5161 TYPE(intbuf_struct_) INTBUF_TAB(*)
5162 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
5163 TYPE (PARAMETERS_) ,INTENT(IN):: PARAMETERS
5164C-----------------------------------------------
5165C L o c a l V a r i a b l e s
5166C-----------------------------------------------
5167 INTEGER I, P, NSN, NMN, ITYP, IGAP, LENS, LENR, MULTIMP,
5168 . inacti, lskyfi, leni,intth,iedge4, ivis2, intnitsche
5169 INTEGER INTERACT,ISENS
5170 my_real ts,startt,stopt
5171 INTEGER, DIMENSION(NSPMD) :: SAVE_NSNFI,SAVE_NSNSI
5172C-----------------------------------------------
5173C S o u r c e L i n e s
5174C-----------------------------------------------
5175C Global init of variable
5176 iedge4=0
5177C
5178C Building Structure Interfaces on Restart
5179C
5180 IF(iflag==1) THEN
5181 IF(ninter/=0) THEN
5182C Writing Structures Interfaces on Restart file (integer part)
5183 DO i =1, ninter
5184 ityp = ipari(7,i)
5185 IF(ityp==7.OR.
5186 + ityp==10.OR.ityp==11.OR.
5187 + (ityp==17.AND.ipari(33,i)==0).OR.ityp==20.OR.
5188 + ityp==22.OR.ityp==23.OR.ityp==24.OR.
5189 + ityp==25)THEN
5190
5191C Issue : Restarts + INACTI + TSTART when Start timee was not reached before Restart
5192 interact = 1
5193
5194 save_nsnfi(1:nspmd) = nsnfi(i)%P(1:nspmd)
5195 save_nsnsi(1:nspmd) = nsnsi(i)%P(1:nspmd)
5196
5197 inacti=ipari(22,i)
5198 IF (inacti==5.OR.inacti==6.OR.inacti==7.OR.ityp==23.OR.inacti==-1)THEN
5199C
5200 isens = 0
5201 IF(ityp == 7.OR.ityp == 11.OR.ityp == 24) ! All but ITYP == 25
5202 . isens = ipari(64,i)
5203 IF (isens > 0) THEN
5204 ts = sensor_tab(isens)%TSTART
5205 IF (ts>tt) interact = 0
5206 ELSE
5207 startt = intbuf_tab(i)%VARIABLES(3)
5208 stopt = intbuf_tab(i)%VARIABLES(11)
5209 IF (startt>tt) interact = 0
5210 ENDIF
5211 ENDIF
5212 IF((interact == 0 .OR. nsnfi_flag(i)==1).AND.ityp/=25) THEN
5213 nsnfi(i)%P(1:nspmd) = nsnfi_sav(i)%P(1:nspmd)
5214 nsnsi(i)%P(1:nspmd) = nsnsi_sav(i)%P(1:nspmd)
5215
5216 nsnfi_sav(i)%P(1:nspmd) = save_nsnfi(1:nspmd)
5217 nsnsi_sav(i)%P(1:nspmd) = save_nsnsi(1:nspmd)
5218 ENDIF
5219
5220 IF(ityp==24)THEN
5221 iedge4=ipari(59,i)
5222 ELSE
5223 iedge4=0
5224 ENDIF
5225 intnitsche=ipari(86,i)
5226
5227 lens = 0
5228 lenr = 0
5229 DO p = 1, nspmd
5230 lens = lens + nsnsi(i)%P(p)
5231 lenr = lenr + nsnfi(i)%P(p)
5232 END DO
5233C
5234 CALL write_i_c(nsnsi(i)%P(1),nspmd)
5235 CALL write_i_c(nsnfi(i)%P(1),nspmd)
5236
5237 IF (lens>0)
5238 . CALL write_i_c(nsvsi(i)%P(1),lens)
5239C
5240 IF (lenr>0) THEN
5241 CALL write_i_c(nsvfi(i)%P(1),lenr)
5242 IF(ityp==7.OR.ityp==20.OR.ityp==22.OR.
5243 + ityp==23.OR.ityp==24.OR.ityp==25) THEN
5244 CALL write_i_c(itafi(i)%P(1),lenr)
5245 CALL write_i_c(kinfi(i)%P(1),lenr)
5246 IF(ityp==20)THEN
5247 CALL write_i_c(nbinflfi(i)%P(1),lenr)
5248 END IF
5249C
5250 IF(ipari(47,i) > 0)CALL write_i_c(matsfi(i)%P(1),lenr)
5251C
5252 IF((ityp == 7.OR.ityp == 24.OR.ityp == 25).AND.ipari(72,i) > 0) THEN
5253 CALL write_i_c(ipartfricsfi(i)%P(1),lenr)
5254 ENDIF
5255C
5256 IF (ityp==24)THEN
5257 CALL write_i_c(irtlm_fi(i)%P(1,1),2*lenr)
5258 CALL write_i_c(icont_i_fi(i)%P(1),lenr)
5259C E2E Arrays
5260 CALL write_i_c(isedge_fi(i)%P(1),lenr)
5261
5262 IF(iedge4>0)THEN
5263 CALL write_i_c(irtse_fi(i)%P(1,1),5*lenr)
5264 CALL write_i_c(is2pt_fi(i)%P(1),lenr)
5265 CALL write_i_c(ispt2_fi(i)%P(1),lenr)
5266 CALL write_i_c(isegpt_fi(i)%P(1),lenr)
5267 CALL write_i_c(is2se_fi(i)%P(1,1),2*lenr)
5268 ENDIF
5269 IF(intnitsche > 0) CALL write_i_c(forneqsfi(i)%P(1,1),3*lenr)
5270
5271 ENDIF
5272C
5273 IF (ityp==25)THEN
5274 CALL write_i_c(pmainfi(i)%P(1),lenr)
5275 CALL write_i_c(irtlm_fi(i)%P(1,1),4*lenr)
5276 CALL write_i_c(icont_i_fi(i)%P(1),lenr)
5277C Not added to rst files
5278C CALL WRITE_I_C(ICODT_FI(I)%P(1),LENR)
5279C CALL WRITE_I_C(ISKEW_FI(I)%P(1),LENR)
5280
5281C Remove banned main segment
5282 IF(ipari(63,i)==2) THEN
5283 CALL write_i_c(kremnor_fi(i)%P(1),lenr+1)
5284 IF(kremnor_fi(i)%P(lenr+1)/=0) THEN
5285 CALL write_i_c(remnor_fi(i)%P(1),kremnor_fi(i)%P(lenr+1))
5286 ENDIF
5287 ENDIF
5288 ENDIF
5289C
5290 IF(idtmins==2)THEN
5291 CALL write_i_c(nodnxfi(i)%P(1),lenr)
5292 CALL write_i_c(nodamsfi(i)%P(1),lenr)
5293 CALL write_i_c(procamsfi(i)%P(1),lenr)
5294 IF (ityp==24) CALL write_i_c(t2main_sms_fi(i)%P(1,1),6*lenr)
5295 ELSEIF(idtmins_int/=0)THEN
5296 CALL write_i_c(nodamsfi(i)%P(1),lenr)
5297 CALL write_i_c(procamsfi(i)%P(1),lenr)
5298 IF (ityp==24) CALL write_i_c(t2main_sms_fi(i)%P(1,1),6*lenr)
5299 END IF
5300C
5301 ELSEIF(ityp==10) THEN
5302 CALL write_i_c(itafi(i)%P(1),lenr)
5303C
5304 IF(idtmins==2)THEN
5305 CALL write_i_c(nodnxfi(i)%P(1),lenr)
5306 CALL write_i_c(nodamsfi(i)%P(1),lenr)
5307 CALL write_i_c(procamsfi(i)%P(1),lenr)
5308 ELSEIF(idtmins_int/=0)THEN
5309 CALL write_i_c(nodamsfi(i)%P(1),lenr)
5310 CALL write_i_c(procamsfi(i)%P(1),lenr)
5311 END IF
5312C
5313 ELSEIF(ityp==11) THEN
5314 CALL write_i_c(itafi(i)%P(1),2*lenr)
5315C
5316 IF(idtmins==2)THEN
5317 CALL write_i_c(nodnxfi(i)%P(1),2*lenr)
5318 CALL write_i_c(nodamsfi(i)%P(1),2*lenr)
5319 CALL write_i_c(procamsfi(i)%P(1),2*lenr)
5320 ELSEIF(idtmins_int/=0)THEN
5321 CALL write_i_c(nodamsfi(i)%P(1),2*lenr)
5322 CALL write_i_c(procamsfi(i)%P(1),2*lenr)
5323 END IF
5324C
5325 IF(ipari(47,i) > 0) CALL write_i_c(matsfi(i)%P(1),lenr)
5326C
5327 IF(ipari(72,i) > 0) CALL write_i_c(ipartfricsfi(i)%P(1),lenr)
5328C
5329 ELSEIF(ityp==17)THEN
5330 END IF
5331 END IF
5332C type20 edge
5333 IF(ityp==20)THEN
5334 lens = 0
5335 lenr = 0
5336 DO p = 1, nspmd
5337 lens = lens + nsnsie(i)%P(p)
5338 lenr = lenr + nsnfie(i)%P(p)
5339 END DO
5340C
5341 CALL write_i_c(nsnsie(i)%P(1),nspmd)
5342 CALL write_i_c(nsnfie(i)%P(1),nspmd)
5343 IF (lens>0)
5344 . CALL write_i_c(nsvsie(i)%P(1),lens)
5345C
5346 IF (lenr>0) THEN
5347 CALL write_i_c(nsvfie(i)%P(1),lenr)
5348 CALL write_i_c(itafie(i)%P(1),2*lenr)
5349 END IF
5350C
5351 IF(idtmins==2)THEN
5352 CALL write_i_c(nodnxfie(i)%P(1),lenr)
5353 CALL write_i_c(nodamsfie(i)%P(1),lenr)
5354 CALL write_i_c(procamsfie(i)%P(1),lenr)
5355 ELSEIF(idtmins_int/=0)THEN
5356 CALL write_i_c(nodamsfie(i)%P(1),lenr)
5357 CALL write_i_c(procamsfie(i)%P(1),lenr)
5358 END IF
5359C
5360 END IF ! Fin type 20 edge
5361
5362 IF(ityp == 25 ) THEN
5363 IF(ipari(58,i) /=0) THEN
5364 CALL write_i_c(nsnsie(i)%P(1),nspmd)
5365 CALL write_i_c(nsnfie(i)%P(1),nspmd)
5366 lens = 0
5367 lenr = 0
5368 DO p = 1, nspmd
5369 lens = lens + nsnsie(i)%P(p)
5370 lenr = lenr + nsnfie(i)%P(p)
5371 END DO
5372
5373 IF(lens>0) THEN
5374 CALL write_i_c(nsvsie(i)%P(1),lens)
5375 ENDIF
5376 IF(lenr>0) THEN
5377 CALL write_i_c(nsvfie(i)%P,lenr)
5378 CALL write_i_c(ledge_fie(i)%P,e_ledge_size*lenr)
5379 IF(ipari(72,i) > 0) CALL write_i_c(ipartfric_fie(i)%P(1),lenr)
5380 ENDIF
5381 ENDIF
5382 ENDIF
5383C
5384 IF(ipari(36,i)>0.AND.ipari(7,i)/=17) THEN
5385 CALL write_i_c(nisubsfi(i)%P(1),nspmd)
5386 leni = 0
5387 lenr = 0
5388 DO p = 1, nspmd
5389 leni = leni + nisubsfi(i)%P(p)
5390 lenr = lenr + nsnfi(i)%P(p)
5391 END DO
5392 IF(leni>0) THEN
5393 IF(lenr>0) THEN
5394 CALL write_i_c(addsubsfi(i)%P(1),lenr+1)
5395 END IF
5396 CALL write_i_c(lisubsfi(i)%P(1),leni)
5397 IF(ipari(7,i)==25.OR.ipari(7,i)==7.OR.ipari(7,i)==24.OR.ipari(7,i)==11)THEN
5398 CALL write_i_c(inflg_subsfi(i)%P(1),leni)
5399 END IF
5400 END IF
5401C =================== EDGES TO EDGE
5402C Output structure under interfaces
5403 IF(ipari(7,i) == 25 .AND. ipari(58,i) > 0) THEN
5404 CALL write_i_c(nisubsfie(i)%P(1),nspmd)
5405 leni = 0
5406 DO p = 1, nspmd
5407 leni = leni +nisubsfie(i)%P(p)
5408 END DO
5409 lenr = 0
5410 DO p = 1, nspmd
5411 lenr = lenr + nsnfie(i)%P(p)
5412 END DO
5413 IF(leni > 0 .AND. lenr > 0) THEN
5414 CALL write_i_c(addsubsfie(i)%P(1),lenr+1)
5415 ENDIF
5416 IF(leni > 0) THEN
5417 CALL write_i_c(lisubsfie(i)%P(1),leni)
5418 CALL write_i_c(inflg_subsfie(i)%P(1),leni)
5419 ENDIF
5420 ENDIF
5421 END IF
5422 END IF
5423
5424
5425C
5426C Write in RST file inter 21 structure for nodal temperature
5427C Actualisation
5428C
5429 IF(ityp==21) THEN
5430 intth = ipari(47,i)
5431C
5432 IF(intth==2.OR.ipari(95,i) > 0) THEN
5433 lens = 0
5434 lenr = 0
5435 DO p = 1, nspmd
5436 lens = lens + nmnsi(i)%P(p)
5437 lenr = lenr + nmnfi(i)%P(p)
5438 END DO
5439C
5440 CALL write_i_c(nmnsi(i)%P(1),nspmd)
5441 CALL write_i_c(nmnfi(i)%P(1),nspmd)
5442
5443 IF (lens>0) THEN
5444 CALL write_i_c(nmvsi(i)%P(1),lens)
5445 CALL write_i_c(tempnod(i)%P(1),lens)
5446 ENDIF
5447C
5448 IF (lenr>0) THEN
5449 CALL write_i_c(nmvfi(i)%P(1),lenr)
5450 ENDIF
5451 ENDIF
5452 ENDIF
5453
5454 ENDDO
5455 END IF
5456C
5457 ELSE ! WRITE REAL
5458
5459 IF(ninter/=0) THEN
5460C Writing Structures Interfaces on Restart file (real part)
5461 DO i =1, ninter
5462 ityp = ipari(7,i)
5463 igap = ipari(21,i)
5464 inacti = ipari(22,i)
5465 ivis2 = ipari(14,i) ! ivis2==-1 : Flag for interface adhesion
5466 lenr = 0
5467 IF(ityp==7.OR.
5468 + ityp==10.OR.ityp==11.OR.
5469 + (ityp==17.AND.ipari(33,i)==0).OR.ityp==20.OR.
5470 + ityp==22.OR.ityp==23.OR.ityp==24.OR.
5471 + ityp==25)THEN
5472 lenr = 0
5473 DO p = 1, nspmd
5474 lenr = lenr + nsnfi(i)%P(p)
5475 END DO
5476
5477C In case deactivated Interface - Flush NSNFI back to Zero
5478C Issue : Restarts + INACTI + TSTART when Start timee was not reached before Restart
5479 interact = 1
5480
5481 isens = 0
5482 IF(ityp == 7.OR.ityp == 11.OR.ityp == 24) isens = ipari(64,i) ! All but ITYP == 25
5483
5484 IF (isens > 0) THEN ! Sensors may be deactivated w/o INACTI
5485 ts = sensor_tab(isens)%TSTART
5486 IF (ts>tt) interact = 0
5487 ENDIF
5488
5489 inacti=ipari(22,i)
5490 IF (inacti==5.OR.inacti==6.OR.inacti==7.OR.ityp==23.OR.inacti==-1)THEN
5491C
5492 isens = 0
5493 IF(ityp == 7.OR.ityp == 11.OR.ityp == 24) isens = ipari(64,i) ! All but ITYP == 25
5494 IF(isens == 0)THEN
5495 startt = intbuf_tab(i)%VARIABLES(3)
5496 stopt = intbuf_tab(i)%VARIABLES(11)
5497 IF (startt>tt) interact = 0
5498 ENDIF
5499 ENDIF
5500
5501 IF((interact == 0 .OR. nsnfi_flag(i)==1).AND.ityp/=25) THEN
5502 nsnfi(i)%P(1:nspmd) = nsnfi_sav(i)%P(1:nspmd)
5503 nsnsi(i)%P(1:nspmd) = nsnsi_sav(i)%P(1:nspmd)
5504 ENDIF
5505
5506C
5507 IF(lenr>0) THEN
5508C
5509 IF(ityp==7.OR.ityp==22.OR.ityp==23.OR.
5510 + ityp==10.OR.ityp==20.OR.ityp==24.OR.
5511 + ityp==25) THEN
5512 CALL write_db(msfi(i)%P(1),lenr)
5513 CALL write_db(stifi(i)%P(1),lenr)
5514 IF(igap/=0)CALL write_db(gapfi(i)%P(1),lenr)
5515 IF(igap==3)CALL write_db(gap_lfi(i)%P(1),lenr)
5516 CALL write_db(xfi(i)%P(1,1),3*lenr)
5517 CALL write_db(vfi(i)%P(1,1),3*lenr)
5518C
5519 IF((ityp == 7.OR.ityp == 20.OR.ityp == 22.OR.
5520 + ityp == 23.OR.ityp == 24.OR.ityp == 25).AND.
5521 + ipari(47,i)>0) THEN
5522 CALL write_db(tempfi(i)%P(1),lenr)
5523 ENDIF
5524 IF(ipari(47,i)>0.OR.(ityp == 25.AND.ivis2==-1)) THEN
5525 CALL write_db(areasfi(i)%P(1),lenr)
5526 ENDIF
5527 IF(ityp == 25.AND.ivis2==-1) THEN
5528 CALL write_i_c(if_adhfi(i)%P(1),lenr)
5529 ENDIF
5530C
5531 ELSEIF(ityp==11)THEN
5532 CALL write_db(msfi(i)%P(1),2*lenr)
5533 CALL write_db(stifi(i)%P(1),lenr)
5534 IF(igap/=0)CALL write_db(gapfi(i)%P(1),lenr)
5535 IF(igap==3)CALL write_db(gap_lfi(i)%P(1),lenr)
5536 CALL write_db(xfi(i)%P(1,1),3*2*lenr)
5537 CALL write_db(vfi(i)%P(1,1),3*2*lenr)
5538 IF(inacti==5.OR.inacti==6)
5539 . CALL write_db(penfi(i)%P(1,1),2*lenr)
5540 IF(ipari(47,i)>0) THEN
5541 CALL write_db(tempfi(i)%P(1),2*lenr)
5542 CALL write_db(areasfi(i)%P(1),lenr)
5543 ENDIF
5544C
5545 ELSEIF(ityp==17)THEN
5546 CALL write_db(xfi17(i)%P(1,1,1),3*16*lenr)
5547 CALL write_db(vfi17(i)%P(1,1,1),3*16*lenr)
5548 CALL write_db(frotsfi(i)%P(1,1),7*lenr)
5549 CALL write_db(ksfi(i)%P(1,1),2*lenr)
5550 CALL write_db(eminxfi(i)%P(1,1),6*lenr)
5551 END IF
5552 END IF
5553 END IF
5554C SPECIFIC TYPE20
5555 IF(ityp==20)THEN
5556C Addition anchoring
5557 IF(lenr>0) THEN
5558 CALL write_db(daanc6fi(i)%P(1,1,1),3*6*lenr)
5559 CALL write_db(dxancfi(i)%P(1,1),3*lenr)
5560 CALL write_db(dvancfi(i)%P(1,1),3*lenr)
5561 IF(inacti==5.OR.inacti==6) THEN
5562 CALL write_db(penfi(i)%P(1,1),2*lenr)
5563 CALL write_db(penfia(i)%P(1,1),5*lenr)
5564 END IF
5565 CALL write_db(daancfi(i)%P(1,1),3*lenr)
5566 CALL write_db(alphakfi(i)%P(1),lenr)
5567 IF(idtmins > 0 .OR. idtmins_int/=0) THEN
5568 CALL write_db(diag_smsfi(i)%P(1),lenr)
5569 ENDIF
5570 END IF
5571C rajout edge
5572 lenr = 0
5573 DO p = 1, nspmd
5574 lenr = lenr + nsnfie(i)%P(p)
5575 END DO
5576C
5577 IF(lenr>0) THEN
5578 CALL write_db(msfie(i)%P(1),2*lenr)
5579 CALL write_db(stifie(i)%P(1),lenr)
5580 IF(igap/=0)CALL write_db(gapfie(i)%P(1),lenr)
5581 CALL write_db(xfie(i)%P(1,1),3*2*lenr)
5582 CALL write_db(vfie(i)%P(1,1),3*2*lenr)
5583 IF(inacti==5.OR.inacti==6) THEN
5584 CALL write_db(penfie(i)%P(1,1),2*lenr)
5585 CALL write_db(penfiae(i)%P(1,1),5*2*lenr)
5586 END IF
5587 CALL write_db(daanc6fie(i)%P(1,1,1),3*6*2*lenr)
5588 CALL write_db(dxancfie(i)%P(1,1),3*2*lenr)
5589 CALL write_db(dvancfie(i)%P(1,1),3*2*lenr)
5590 IF(idtmins > 0 .OR. idtmins_int/=0) THEN
5591 CALL write_db(diag_smsfie(i)%P(1),lenr)
5592 ENDIF
5593 END IF
5594 END IF ! fin type 20 edge
5595
5596 IF(lenr > 0) THEN
5597 IF (ityp==24)THEN
5598 CALL write_db(time_sfi(i)%P(1),lenr)
5599 ELSEIF(ityp==25)THEN
5600 CALL write_db(time_sfi(i)%P(1),2*lenr)
5601 END IF
5602 IF (ityp==24.OR.ityp==25)THEN
5603 CALL write_db(secnd_frfi(i)%P(1,1),6*lenr)
5604 CALL write_db(pene_oldfi(i)%P(1,1),5*lenr)
5605 CALL write_db(stif_oldfi(i)%P(1,1),2*lenr)
5606 IF(ipari(97,i) > 0) CALL write_db(stif_msdt_fi(i)%P(1),lenr) ! stif based on mass and dt
5607 ENDIF ! fin partie type 24 & 25
5608 IF(ityp==25.AND.parameters%INTCAREA > 0.AND.ipari(36,i)>0) CALL write_db(intareanfi(i)%P(1),lenr) ! output carea th (only case NISUB)
5609 IF(ityp==24.AND.parameters%INTCAREA > 0) CALL write_db(intareanfi(i)%P(1),lenr) ! output carea th
5610C
5611 IF (ityp==24) THEN
5612 IF(idtmins==2)THEN
5613 CALL write_db(t2fac_sms_fi(i)%P(1),lenr)
5614 ELSEIF(idtmins_int/=0)THEN
5615 CALL write_db(t2fac_sms_fi(i)%P(1),lenr)
5616 ENDIF
5617 END IF
5618 ENDIF
5619C
5620 IF(ityp == 25 ) THEN
5621 IF(ipari(58,i) /=0) THEN !E2E
5622 lenr = 0
5623 DO p = 1, nspmd
5624 lenr = lenr + nsnfie(i)%P(p)
5625 END DO
5626 IF(lenr>0) THEN
5627 CALL write_db(xfie(i)%P(1,1),3*(lenr*2))
5628 CALL write_db(vfie(i)%P(1,1),3*(lenr*2))
5629 CALL write_db(msfie(i)%P(1),lenr*2)
5630 CALL write_db(stifie(i)%P(1),lenr)
5631 CALL write_db(gapfie(i)%P(1),lenr)
5632 IF( igap == 3) THEN
5633 CALL write_db(gape_l_fie(i)%P,lenr)
5634 ENDIF
5635 CALL write_r_c(edg_bisector_fie(i)%P(1,1,1),3*3*lenr)
5636 CALL write_r_c(vtx_bisector_fie(i)%P(1,1,1),3*4*lenr)
5637 CALL write_db(x_seg_fie(i)%P(1,1,1),3*4*lenr)
5638
5639 IF(idtmins==2)THEN
5640 CALL write_i_c(nodnxfie(i)%P(1),lenr*2)
5641 CALL write_i_c(nodamsfie(i)%P(1),lenr*2)
5642 CALL write_i_c(procamsfie(i)%P(1),lenr*2)
5643 ELSEIF(idtmins_int/=0)THEN
5644 CALL write_i_c(nodamsfie(i)%P(1),lenr*2)
5645 CALL write_i_c(procamsfie(i)%P(1),lenr*2)
5646 END IF
5647
5648 IF(ipari(97,i) > 0) THEN
5649 CALL write_db(stife_msdt_fi(i)%P(1),lenr)
5650 ENDIF
5651
5652 ENDIF
5653 ENDIF
5654 ENDIF
5655
5656 IF(ityp==21) THEN
5657 intth = ipari(47,i)
5658C
5659 IF(intth==2) THEN
5660 lenr = 0
5661 DO p = 1, nspmd
5662 lenr = lenr + nmnfi(i)%P(p)
5663 END DO
5664C
5665 IF (lenr>0) THEN
5666 CALL write_db(nmtemp(i)%P(1),lenr)
5667 ENDIF
5668 ENDIF
5669 ENDIF
5670C
5671 END DO
5672 END IF
5673 ENDIF
5674C
5675 RETURN
5676 END
5677C
5678!||====================================================================
5679!|| sortint ../engine/source/mpi/interfaces/spmd_i7tool.F
5680!||--- called by ------------------------------------------------------
5681!|| spmd_i21fthecom ../engine/source/mpi/interfaces/send_cand.F
5682!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
5683!||====================================================================
5684 SUBROUTINE sortint(N,ISKY,INDEX)
5685C
5686C-----------------------------------------------
5687C I m p l i c i t T y p e s
5688C-----------------------------------------------
5689#include "implicit_f.inc"
5690C-----------------------------------------------
5691C D u m m y A r g u m e n t s
5692C-----------------------------------------------
5693 INTEGER N, ISKY(*),INDEX(*)
5694C-----------------------------------------------
5695C L o c a l V a r i a b l e s
5696C-----------------------------------------------
5697 INTEGER I, J, L, IR, IIA,IIA2
5698 my_real
5699 . rra1, rra2, rra3, rra4, rra5,ppa
5700C-----------------------------------------------
5701C S o u r c e L i n e s
5702C-----------------------------------------------
5703C test on n=0
5704 IF (n==0) RETURN
5705 l=n/2+1
5706 ir=n
5707
570810 CONTINUE
5709 IF(l>1)THEN
5710 l=l-1
5711 iia =isky(l)
5712 iia2=index(l)
5713 ELSE
5714 iia =isky(ir)
5715 iia2=index(ir)
5716
5717 isky(ir)=isky(1)
5718 index(ir)=index(1)
5719
5720 ir=ir-1
5721
5722 IF(ir<=1)THEN
5723 isky(1)=iia
5724 index(1)=iia2
5725 RETURN
5726 ENDIF
5727 ENDIF
5728 i=l
5729 j=l+l
573020 IF(j<=ir)THEN
5731 IF(j<ir)THEN
5732 IF(isky(j)<isky(j+1))j=j+1
5733 ENDIF
5734 IF(iia<isky(j))THEN
5735 isky(i)=isky(j)
5736 index(i)=index(j)
5737 i=j
5738 j=j+j
5739 ELSE
5740 j=ir+1
5741 ENDIF
5742 GO TO 20
5743 ENDIF
5744 isky(i)=iia
5745 index(i)=iia2
5746 GO TO 10
5747C
5748 RETURN
5749 END
5750C
5751!||====================================================================
5752!|| sorti7 ../engine/source/mpi/interfaces/spmd_i7tool.F
5753!||====================================================================
5754 SUBROUTINE sorti7(N,ISKY,FSKYI,FTHESKYI,NFSKYI)
5755C
5756C-----------------------------------------------
5757C I m p l i c i t T y p e s
5758C-----------------------------------------------
5759#include "implicit_f.inc"
5760C-----------------------------------------------
5761C D u m m y A r g u m e n t s
5762C-----------------------------------------------
5763 INTEGER N, NFSKYI, ISKY(*)
5764 my_real
5765 . fskyi(nfskyi,*),ftheskyi(*)
5766C-----------------------------------------------
5767C L o c a l V a r i a b l e s
5768C-----------------------------------------------
5769 INTEGER I, J, L, IR, IIA
5770 my_real
5771 . rra1, rra2, rra3, rra4, rra5,ppa
5772C-----------------------------------------------
5773C S o u r c e L i n e s
5774C-----------------------------------------------
5775C test on n=0
5776 IF (n==0) RETURN
5777 l=n/2+1
5778 ir=n
5779 IF(nfskyi==4)THEN
578010 CONTINUE
5781 IF(l>1)THEN
5782 l=l-1
5783 iia =isky(l)
5784 rra1=fskyi(1,l)
5785 rra2=fskyi(2,l)
5786 rra3=fskyi(3,l)
5787 rra4=fskyi(4,l)
5788 ppa =ftheskyi(l)
5789 ELSE
5790 iia =isky(ir)
5791 rra1=fskyi(1,ir)
5792 rra2=fskyi(2,ir)
5793 rra3=fskyi(3,ir)
5794 rra4=fskyi(4,ir)
5795 ppa =ftheskyi(ir)
5796 isky(ir)=isky(1)
5797 fskyi(1,ir)=fskyi(1,1)
5798 fskyi(2,ir)=fskyi(2,1)
5799 fskyi(3,ir)=fskyi(3,1)
5800 fskyi(4,ir)=fskyi(4,1)
5801 ftheskyi(ir)=ftheskyi(1)
5802 ir=ir-1
5803C IF(IR==1)THEN
5804 IF(ir<=1)THEN
5805 isky(1)=iia
5806 fskyi(1,1)=rra1
5807 fskyi(2,1)=rra2
5808 fskyi(3,1)=rra3
5809 fskyi(4,1)=rra4
5810 ftheskyi(1)=ppa
5811 RETURN
5812 ENDIF
5813 ENDIF
5814 i=l
5815 j=l+l
581620 IF(j<=ir)THEN
5817 IF(j<ir)THEN
5818 IF(isky(j)<isky(j+1))j=j+1
5819 ENDIF
5820 IF(iia<isky(j))THEN
5821 isky(i)=isky(j)
5822 fskyi(1,i)=fskyi(1,j)
5823 fskyi(2,i)=fskyi(2,j)
5824 fskyi(3,i)=fskyi(3,j)
5825 fskyi(4,i)=fskyi(4,j)
5826 ftheskyi(i)=ftheskyi(j)
5827 i=j
5828 j=j+j
5829 ELSE
5830 j=ir+1
5831 ENDIF
5832 GO TO 20
5833 ENDIF
5834 isky(i)=iia
5835 fskyi(1,i)=rra1
5836 fskyi(2,i)=rra2
5837 fskyi(3,i)=rra3
5838 fskyi(4,i)=rra4
5839 ftheskyi(i)=ppa
5840 GO TO 10
5841 ELSE
5842100 CONTINUE
5843 IF(l>1)THEN
5844 l=l-1
5845 iia =isky(l)
5846 rra1=fskyi(1,l)
5847 rra2=fskyi(2,l)
5848 rra3=fskyi(3,l)
5849 rra4=fskyi(4,l)
5850 rra5=fskyi(5,l)
5851 ppa =ftheskyi(l)
5852 ELSE
5853 iia =isky(ir)
5854 rra1=fskyi(1,ir)
5855 rra2=fskyi(2,ir)
5856 rra3=fskyi(3,ir)
5857 rra4=fskyi(4,ir)
5858 rra5=fskyi(5,ir)
5859 isky(ir)=isky(1)
5860 fskyi(1,ir)=fskyi(1,1)
5861 fskyi(2,ir)=fskyi(2,1)
5862 fskyi(3,ir)=fskyi(3,1)
5863 fskyi(4,ir)=fskyi(4,1)
5864 fskyi(5,ir)=fskyi(5,1)
5865 ftheskyi(ir)=ftheskyi(1)
5866 ir=ir-1
5867C IF(IR==1)THEN
5868 IF(ir<=1)THEN
5869 isky(1)=iia
5870 fskyi(1,1)=rra1
5871 fskyi(2,1)=rra2
5872 fskyi(3,1)=rra3
5873 fskyi(4,1)=rra4
5874 fskyi(5,1)=rra5
5875 ftheskyi(1)=ppa
5876 RETURN
5877 ENDIF
5878 ENDIF
5879 i=l
5880 j=l+l
5881200 IF(j<=ir)THEN
5882 IF(j<ir)THEN
5883 IF(isky(j)<isky(j+1))j=j+1
5884 ENDIF
5885 IF(iia<isky(j))THEN
5886 isky(i)=isky(j)
5887 fskyi(1,i)=fskyi(1,j)
5888 fskyi(2,i)=fskyi(2,j)
5889 fskyi(3,i)=fskyi(3,j)
5890 fskyi(4,i)=fskyi(4,j)
5891 fskyi(5,i)=fskyi(5,j)
5892 ftheskyi(i)=ftheskyi(j)
5893 i=j
5894 j=j+j
5895 ELSE
5896 j=ir+1
5897 ENDIF
5898 GO TO 200
5899 ENDIF
5900 isky(i)=iia
5901 fskyi(1,i)=rra1
5902 fskyi(2,i)=rra2
5903 fskyi(3,i)=rra3
5904 fskyi(4,i)=rra4
5905 fskyi(5,i)=rra5
5906 ftheskyi(i)=ppa
5907 GO TO 100
5908 ENDIF
5909C
5910 RETURN
5911 END
5912C
5913!||====================================================================
5914!|| sorti7t ../engine/source/mpi/interfaces/spmd_i7tool.F
5915!||====================================================================
5916 SUBROUTINE sorti7t(N,ISKY,FSKYI,FTHESKYI,CONDNSKYI,NFSKYI)
5917C
5918C-----------------------------------------------
5919C I m p l i c i t T y p e s
5920C-----------------------------------------------
5921#include "implicit_f.inc"
5922C-----------------------------------------------
5923C D u m m y A r g u m e n t s
5924C-----------------------------------------------
5925 INTEGER N, NFSKYI, ISKY(*)
5926 my_real
5927 . fskyi(nfskyi,*),ftheskyi(*),condnskyi(*)
5928C-----------------------------------------------
5929C L o c a l V a r i a b l e s
5930C-----------------------------------------------
5931 INTEGER I, J, L, IR, IIA
5932 my_real
5933 . rra1, rra2, rra3, rra4, rra5,ppa,kka
5934C-----------------------------------------------
5935C S o u r c e L i n e s
5936C-----------------------------------------------
5937C test on n=0
5938 IF (n==0) RETURN
5939 l=n/2+1
5940 ir=n
5941 IF(nfskyi==4)THEN
594210 CONTINUE
5943 IF(l>1)THEN
5944 l=l-1
5945 iia =isky(l)
5946 rra1=fskyi(1,l)
5947 rra2=fskyi(2,l)
5948 rra3=fskyi(3,l)
5949 rra4=fskyi(4,l)
5950 ppa =ftheskyi(l)
5951 kka =condnskyi(l)
5952 ELSE
5953 iia =isky(ir)
5954 rra1=fskyi(1,ir)
5955 rra2=fskyi(2,ir)
5956 rra3=fskyi(3,ir)
5957 rra4=fskyi(4,ir)
5958 ppa =ftheskyi(ir)
5959 isky(ir)=isky(1)
5960 fskyi(1,ir)=fskyi(1,1)
5961 fskyi(2,ir)=fskyi(2,1)
5962 fskyi(3,ir)=fskyi(3,1)
5963 fskyi(4,ir)=fskyi(4,1)
5964 ftheskyi(ir)=ftheskyi(1)
5965 condnskyi(ir)=condnskyi(1)
5966 ir=ir-1
5967C IF(IR==1)THEN
5968 IF(ir<=1)THEN
5969 isky(1)=iia
5970 fskyi(1,1)=rra1
5971 fskyi(2,1)=rra2
5972 fskyi(3,1)=rra3
5973 fskyi(4,1)=rra4
5974 ftheskyi(1)=ppa
5975 condnskyi(1)=kka
5976 RETURN
5977 ENDIF
5978 ENDIF
5979 i=l
5980 j=l+l
598120 IF(j<=ir)THEN
5982 IF(j<ir)THEN
5983 IF(isky(j)<isky(j+1))j=j+1
5984 ENDIF
5985 IF(iia<isky(j))THEN
5986 isky(i)=isky(j)
5987 fskyi(1,i)=fskyi(1,j)
5988 fskyi(2,i)=fskyi(2,j)
5989 fskyi(3,i)=fskyi(3,j)
5990 fskyi(4,i)=fskyi(4,j)
5991 ftheskyi(i)=ftheskyi(j)
5992 condnskyi(i)=condnskyi(j)
5993 i=j
5994 j=j+j
5995 ELSE
5996 j=ir+1
5997 ENDIF
5998 GO TO 20
5999 ENDIF
6000 isky(i)=iia
6001 fskyi(1,i)=rra1
6002 fskyi(2,i)=rra2
6003 fskyi(3,i)=rra3
6004 fskyi(4,i)=rra4
6005 ftheskyi(i)=ppa
6006 condnskyi(i)=kka
6007 GO TO 10
6008 ELSE
6009100 CONTINUE
6010 IF(l>1)THEN
6011 l=l-1
6012 iia =isky(l)
6013 rra1=fskyi(1,l)
6014 rra2=fskyi(2,l)
6015 rra3=fskyi(3,l)
6016 rra4=fskyi(4,l)
6017 rra5=fskyi(5,l)
6018 ppa =ftheskyi(l)
6019 kka =condnskyi(l)
6020 ELSE
6021 iia =isky(ir)
6022 rra1=fskyi(1,ir)
6023 rra2=fskyi(2,ir)
6024 rra3=fskyi(3,ir)
6025 rra4=fskyi(4,ir)
6026 rra5=fskyi(5,ir)
6027 isky(ir)=isky(1)
6028 fskyi(1,ir)=fskyi(1,1)
6029 fskyi(2,ir)=fskyi(2,1)
6030 fskyi(3,ir)=fskyi(3,1)
6031 fskyi(4,ir)=fskyi(4,1)
6032 fskyi(5,ir)=fskyi(5,1)
6033 ftheskyi(ir)=ftheskyi(1)
6034 condnskyi(ir)=condnskyi(1)
6035 ir=ir-1
6036C IF(IR==1)THEN
6037 IF(ir<=1)THEN
6038 isky(1)=iia
6039 fskyi(1,1)=rra1
6040 fskyi(2,1)=rra2
6041 fskyi(3,1)=rra3
6042 fskyi(4,1)=rra4
6043 fskyi(5,1)=rra5
6044 ftheskyi(1)=ppa
6045 condnskyi(1)=ppa
6046 RETURN
6047 ENDIF
6048 ENDIF
6049 i=l
6050 j=l+l
6051200 IF(j<=ir)THEN
6052 IF(j<ir)THEN
6053 IF(isky(j)<isky(j+1))j=j+1
6054 ENDIF
6055 IF(iia<isky(j))THEN
6056 isky(i)=isky(j)
6057 fskyi(1,i)=fskyi(1,j)
6058 fskyi(2,i)=fskyi(2,j)
6059 fskyi(3,i)=fskyi(3,j)
6060 fskyi(4,i)=fskyi(4,j)
6061 fskyi(5,i)=fskyi(5,j)
6062 ftheskyi(i)=ftheskyi(j)
6063 condnskyi(i)=condnskyi(j)
6064 i=j
6065 j=j+j
6066 ELSE
6067 j=ir+1
6068 ENDIF
6069 GO TO 200
6070 ENDIF
6071 isky(i)=iia
6072 fskyi(1,i)=rra1
6073 fskyi(2,i)=rra2
6074 fskyi(3,i)=rra3
6075 fskyi(4,i)=rra4
6076 fskyi(5,i)=rra5
6077 ftheskyi(i)=ppa
6078 condnskyi(i)=ppa
6079 GO TO 100
6080 ENDIF
6081C
6082 RETURN
6083 END
6084C
6085!||====================================================================
6086!|| sorti20 ../engine/source/mpi/interfaces/spmd_i7tool.F
6087!||--- called by ------------------------------------------------------
6088!|| spmd_i17frots_pon ../engine/source/mpi/interfaces/spmd_i17frots_pon.F
6089!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
6090!||====================================================================
6091 SUBROUTINE sorti20(N,ISKY,FSKYI,NFSKYI)
6092C
6093C-----------------------------------------------
6094C I m p l i c i t T y p e s
6095C-----------------------------------------------
6096#include "implicit_f.inc"
6097C-----------------------------------------------
6098C D u m m y A r g u m e n t s
6099C-----------------------------------------------
6100 INTEGER N, NFSKYI, ISKY(*)
6101 my_real
6102 . fskyi(nfskyi,*)
6103C-----------------------------------------------
6104C L o c a l V a r i a b l e s
6105C-----------------------------------------------
6106 INTEGER I, J, L, IR, IIA
6107 my_real
6108 . rra1, rra2, rra3, rra4, rra5
6109C-----------------------------------------------
6110C S o u r c e L i n e s
6111C-----------------------------------------------
6112C test on n=0
6113 IF (n==0) RETURN
6114 l=n/2+1
6115 ir=n
6116 IF(nfskyi==4)THEN
611710 CONTINUE
6118 IF(l>1)THEN
6119 l=l-1
6120 iia =isky(l)
6121 rra1=fskyi(1,l)
6122 rra2=fskyi(2,l)
6123 rra3=fskyi(3,l)
6124 rra4=fskyi(4,l)
6125 ELSE
6126 iia =isky(ir)
6127 rra1=fskyi(1,ir)
6128 rra2=fskyi(2,ir)
6129 rra3=fskyi(3,ir)
6130 rra4=fskyi(4,ir)
6131 isky(ir)=isky(1)
6132 fskyi(1,ir)=fskyi(1,1)
6133 fskyi(2,ir)=fskyi(2,1)
6134 fskyi(3,ir)=fskyi(3,1)
6135 fskyi(4,ir)=fskyi(4,1)
6136 ir=ir-1
6137C IF(IR==1)THEN
6138 IF(ir<=1)THEN
6139 isky(1)=iia
6140 fskyi(1,1)=rra1
6141 fskyi(2,1)=rra2
6142 fskyi(3,1)=rra3
6143 fskyi(4,1)=rra4
6144 RETURN
6145 ENDIF
6146 ENDIF
6147 i=l
6148 j=l+l
614920 IF(j<=ir)THEN
6150 IF(j<ir)THEN
6151 IF(isky(j)<isky(j+1))j=j+1
6152 ENDIF
6153 IF(iia<isky(j))THEN
6154 isky(i)=isky(j)
6155 fskyi(1,i)=fskyi(1,j)
6156 fskyi(2,i)=fskyi(2,j)
6157 fskyi(3,i)=fskyi(3,j)
6158 fskyi(4,i)=fskyi(4,j)
6159 i=j
6160 j=j+j
6161 ELSE
6162 j=ir+1
6163 ENDIF
6164 GO TO 20
6165 ENDIF
6166 isky(i)=iia
6167 fskyi(1,i)=rra1
6168 fskyi(2,i)=rra2
6169 fskyi(3,i)=rra3
6170 fskyi(4,i)=rra4
6171 GO TO 10
6172 ELSE
6173100 CONTINUE
6174 IF(l>1)THEN
6175 l=l-1
6176 iia =isky(l)
6177 rra1=fskyi(1,l)
6178 rra2=fskyi(2,l)
6179 rra3=fskyi(3,l)
6180 rra4=fskyi(4,l)
6181 rra5=fskyi(5,l)
6182 ELSE
6183 iia =isky(ir)
6184 rra1=fskyi(1,ir)
6185 rra2=fskyi(2,ir)
6186 rra3=fskyi(3,ir)
6187 rra4=fskyi(4,ir)
6188 rra5=fskyi(5,ir)
6189 isky(ir)=isky(1)
6190 fskyi(1,ir)=fskyi(1,1)
6191 fskyi(2,ir)=fskyi(2,1)
6192 fskyi(3,ir)=fskyi(3,1)
6193 fskyi(4,ir)=fskyi(4,1)
6194 fskyi(5,ir)=fskyi(5,1)
6195 ir=ir-1
6196C IF(IR==1)THEN
6197 IF(ir<=1)THEN
6198 isky(1)=iia
6199 fskyi(1,1)=rra1
6200 fskyi(2,1)=rra2
6201 fskyi(3,1)=rra3
6202 fskyi(4,1)=rra4
6203 fskyi(5,1)=rra5
6204 RETURN
6205 ENDIF
6206 ENDIF
6207 i=l
6208 j=l+l
6209200 IF(j<=ir)THEN
6210 IF(j<ir)THEN
6211 IF(isky(j)<isky(j+1))j=j+1
6212 ENDIF
6213 IF(iia<isky(j))THEN
6214 isky(i)=isky(j)
6215 fskyi(1,i)=fskyi(1,j)
6216 fskyi(2,i)=fskyi(2,j)
6217 fskyi(3,i)=fskyi(3,j)
6218 fskyi(4,i)=fskyi(4,j)
6219 fskyi(5,i)=fskyi(5,j)
6220 i=j
6221 j=j+j
6222 ELSE
6223 j=ir+1
6224 ENDIF
6225 GO TO 200
6226 ENDIF
6227 isky(i)=iia
6228 fskyi(1,i)=rra1
6229 fskyi(2,i)=rra2
6230 fskyi(3,i)=rra3
6231 fskyi(4,i)=rra4
6232 fskyi(5,i)=rra5
6233 GO TO 100
6234 ENDIF
6235C
6236 RETURN
6237 END
6238C
6239!||====================================================================
6240!|| intcontp ../engine/source/mpi/interfaces/spmd_i7tool.F
6241!||--- called by ------------------------------------------------------
6242!|| spmd_i17frots_pon ../engine/source/mpi/interfaces/spmd_i17frots_pon.F
6243!|| spmd_i21fthecom ../engine/source/mpi/interfaces/send_cand.F
6244!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
6245!||====================================================================
6246 SUBROUTINE intcontp(N,ISKY,NSNFI,ISIZENV,NSNFITOT,LEN)
6247C
6248C-----------------------------------------------
6249C I m p l i c i t T y p e s
6250C-----------------------------------------------
6251#include "implicit_f.inc"
6252C-----------------------------------------------
6253C C o m m o n B l o c k s
6254C-----------------------------------------------
6255#include "com01_c.inc"
6256C-----------------------------------------------
6257C D u m m y A r g u m e n t s
6258C-----------------------------------------------
6259 INTEGER N, LEN,
6260 . nsnfi(*), isky(*), isizenv(2,*), nsnfitot(*)
6261C-----------------------------------------------
6262C L o c a l V a r i a b l e s
6263C-----------------------------------------------
6264 INTEGER IG, P, I, LASTIG
6265C-----------------------------------------------
6266C S o u r c e L i n e s
6267C-----------------------------------------------
6268C
6269 IF(n>0)THEN
6270 i = 1
6271 p = 1
6272 lastig = nsnfi(p)
6273 DO WHILE (i <= n)
6274 ig = isky(i)
6275 IF(ig<=lastig)THEN
6276 isizenv(1,p) = isizenv(1,p) + len
6277 isizenv(2,p) = isizenv(2,p) + 1
6278 i = i + 1
6279 ELSE
6280 p = p + 1
6281 lastig = lastig+nsnfi(p)
6282 END IF
6283 END DO
6284 END IF
6285C
6286 DO p = 1, nspmd
6287 nsnfitot(p) = nsnfitot(p) + nsnfi(p)
6288 END DO
6289C
6290 RETURN
6291 END
6292C
6293!||====================================================================
6294!|| addcomi20 ../engine/source/mpi/interfaces/spmd_i7tool.F
6295!||--- called by ------------------------------------------------------
6296!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
6297!||====================================================================
6298 SUBROUTINE addcomi20(NSNFI,NSVFI,ISIZENV,LENI20)
6299C
6300C-----------------------------------------------
6301C I m p l i c i t T y p e s
6302C-----------------------------------------------
6303#include "implicit_f.inc"
6304C-----------------------------------------------
6305C C o m m o n B l o c k s
6306C-----------------------------------------------
6307#include "com01_c.inc"
6308C-----------------------------------------------
6309C D u m m y A r g u m e n t s
6310C-----------------------------------------------
6311 INTEGER LENI20,
6312 . nsnfi(*), nsvfi(*), isizenv(2,*)
6313C-----------------------------------------------
6314C L o c a l V a r i a b l e s
6315C-----------------------------------------------
6316 INTEGER IDEB, P, N, NB
6317C-----------------------------------------------
6318C S o u r c e L i n e s
6319C-----------------------------------------------
6320C
6321C IDEB = 0
6322 DO P = 1, nspmd
6323 nb = nsnfi(p)
6324 isizenv(1,p) = isizenv(1,p) + nb*leni20
6325C always send but maybe optimistic
6326C DO N = 1, NB
6327C IF(NSVFI(IDEB+N)<0) THEN
6328C ISIZENV(P) = ISIZENV(P) + LENI20
6329C END IF
6330C END DO
6331C IDEB = IDEB + NB
6332 END DO
6333C
6334 RETURN
6335 END
6336C
6337!||====================================================================
6338!|| sorti11 ../engine/source/mpi/interfaces/spmd_i7tool.F
6339!||--- called by ------------------------------------------------------
6340!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
6341!||====================================================================
6342 SUBROUTINE sorti11(N,ISKY,FSKYI,NFSKYI)
6343C
6344C-----------------------------------------------
6345C I m p l i c i t T y p e s
6346C-----------------------------------------------
6347#include "implicit_f.inc"
6348C-----------------------------------------------
6349C D u m m y A r g u m e n t s
6350C-----------------------------------------------
6351 INTEGER N, NFSKYI, ISKY(*)
6352 my_real
6353 . fskyi(2*nfskyi,*)
6354C-----------------------------------------------
6355C L o c a l V a r i a b l e s
6356C-----------------------------------------------
6357 INTEGER I, J, L, IR, IIA
6358 my_real
6359 . RRA1, RRA2, RRA3, RRA4, RRA5,
6360 . RRA6, RRA7, RRA8, RRA9, RRA10
6361C-----------------------------------------------
6362C S o u r c e L i n e s
6363C-----------------------------------------------
6364C test on n=0
6365 IF (n==0) RETURN
6366 l=n/2+1
6367 ir=n
6368 IF(nfskyi==4)THEN
636910 CONTINUE
6370 IF(l>1)THEN
6371 l=l-1
6372 iia =isky(l)
6373 rra1=fskyi(1,l)
6374 rra2=fskyi(2,l)
6375 rra3=fskyi(3,l)
6376 rra4=fskyi(4,l)
6377 rra5=fskyi(5,l)
6378 rra6=fskyi(6,l)
6379 rra7=fskyi(7,l)
6380 rra8=fskyi(8,l)
6381 ELSE
6382 iia =isky(ir)
6383 rra1=fskyi(1,ir)
6384 rra2=fskyi(2,ir)
6385 rra3=fskyi(3,ir)
6386 rra4=fskyi(4,ir)
6387 rra5=fskyi(5,ir)
6388 rra6=fskyi(6,ir)
6389 rra7=fskyi(7,ir)
6390 rra8=fskyi(8,ir)
6391 isky(ir)=isky(1)
6392 fskyi(1,ir)=fskyi(1,1)
6393 fskyi(2,ir)=fskyi(2,1)
6394 fskyi(3,ir)=fskyi(3,1)
6395 fskyi(4,ir)=fskyi(4,1)
6396 fskyi(5,ir)=fskyi(5,1)
6397 fskyi(6,ir)=fskyi(6,1)
6398 fskyi(7,ir)=fskyi(7,1)
6399 fskyi(8,ir)=fskyi(8,1)
6400 ir=ir-1
6401C IF(IR==1)THEN
6402 IF(ir<=1)THEN
6403 isky(1)=iia
6404 fskyi(1,1)=rra1
6405 fskyi(2,1)=rra2
6406 fskyi(3,1)=rra3
6407 fskyi(4,1)=rra4
6408 fskyi(5,1)=rra5
6409 fskyi(6,1)=rra6
6410 fskyi(7,1)=rra7
6411 fskyi(8,1)=rra8
6412 RETURN
6413 ENDIF
6414 ENDIF
6415 i=l
6416 j=l+l
641720 IF(j<=ir)THEN
6418 IF(j<ir)THEN
6419 IF(isky(j)<isky(j+1))j=j+1
6420 ENDIF
6421 IF(iia<isky(j))THEN
6422 isky(i)=isky(j)
6423 fskyi(1,i)=fskyi(1,j)
6424 fskyi(2,i)=fskyi(2,j)
6425 fskyi(3,i)=fskyi(3,j)
6426 fskyi(4,i)=fskyi(4,j)
6427 fskyi(5,i)=fskyi(5,j)
6428 fskyi(6,i)=fskyi(6,j)
6429 fskyi(7,i)=fskyi(7,j)
6430 fskyi(8,i)=fskyi(8,j)
6431 i=j
6432 j=j+j
6433 ELSE
6434 j=ir+1
6435 ENDIF
6436 GO TO 20
6437 ENDIF
6438 isky(i)=iia
6439 fskyi(1,i)=rra1
6440 fskyi(2,i)=rra2
6441 fskyi(3,i)=rra3
6442 fskyi(4,i)=rra4
6443 fskyi(5,i)=rra5
6444 fskyi(6,i)=rra6
6445 fskyi(7,i)=rra7
6446 fskyi(8,i)=rra8
6447 GO TO 10
6448 ELSE
6449100 CONTINUE
6450 IF(l>1)THEN
6451 l=l-1
6452 iia =isky(l)
6453 rra1=fskyi(1,l)
6454 rra2=fskyi(2,l)
6455 rra3=fskyi(3,l)
6456 rra4=fskyi(4,l)
6457 rra5=fskyi(5,l)
6458 rra6=fskyi(6,l)
6459 rra7=fskyi(7,l)
6460 rra8=fskyi(8,l)
6461 rra9=fskyi(9,l)
6462 rra10=fskyi(10,l)
6463 ELSE
6464 iia =isky(ir)
6465 rra1=fskyi(1,ir)
6466 rra2=fskyi(2,ir)
6467 rra3=fskyi(3,ir)
6468 rra4=fskyi(4,ir)
6469 rra5=fskyi(5,ir)
6470 rra6=fskyi(6,ir)
6471 rra7=fskyi(7,ir)
6472 rra8=fskyi(8,ir)
6473 rra9=fskyi(9,ir)
6474 rra10=fskyi(10,ir)
6475 isky(ir)=isky(1)
6476 fskyi(1,ir)=fskyi(1,1)
6477 fskyi(2,ir)=fskyi(2,1)
6478 fskyi(3,ir)=fskyi(3,1)
6479 fskyi(4,ir)=fskyi(4,1)
6480 fskyi(5,ir)=fskyi(5,1)
6481 fskyi(6,ir)=fskyi(6,1)
6482 fskyi(7,ir)=fskyi(7,1)
6483 fskyi(8,ir)=fskyi(8,1)
6484 fskyi(9,ir)=fskyi(9,1)
6485 fskyi(10,ir)=fskyi(10,1)
6486 ir=ir-1
6487C IF(IR==1)THEN
6488 IF(ir<=1)THEN
6489 isky(1)=iia
6490 fskyi(1,1)=rra1
6491 fskyi(2,1)=rra2
6492 fskyi(3,1)=rra3
6493 fskyi(4,1)=rra4
6494 fskyi(5,1)=rra5
6495 fskyi(6,1)=rra6
6496 fskyi(7,1)=rra7
6497 fskyi(8,1)=rra8
6498 fskyi(9,1)=rra9
6499 fskyi(10,1)=rra10
6500 RETURN
6501 ENDIF
6502 ENDIF
6503 i=l
6504 j=l+l
6505200 IF(j<=ir)THEN
6506 IF(j<ir)THEN
6507 IF(isky(j)<isky(j+1))j=j+1
6508 ENDIF
6509 IF(iia<isky(j))THEN
6510 isky(i)=isky(j)
6511 fskyi(1,i)=fskyi(1,j)
6512 fskyi(2,i)=fskyi(2,j)
6513 fskyi(3,i)=fskyi(3,j)
6514 fskyi(4,i)=fskyi(4,j)
6515 fskyi(5,i)=fskyi(5,j)
6516 fskyi(6,i)=fskyi(6,j)
6517 fskyi(7,i)=fskyi(7,j)
6518 fskyi(8,i)=fskyi(8,j)
6519 fskyi(9,i)=fskyi(9,j)
6520 fskyi(10,i)=fskyi(10,j)
6521 i=j
6522 j=j+j
6523 ELSE
6524 j=ir+1
6525 ENDIF
6526 GO TO 200
6527 ENDIF
6528 isky(i)=iia
6529 fskyi(1,i)=rra1
6530 fskyi(2,i)=rra2
6531 fskyi(3,i)=rra3
6532 fskyi(4,i)=rra4
6533 fskyi(5,i)=rra5
6534 fskyi(6,i)=rra6
6535 fskyi(7,i)=rra7
6536 fskyi(8,i)=rra8
6537 fskyi(9,i)=rra9
6538 fskyi(10,i)=rra10
6539 GO TO 100
6540 ENDIF
6541C
6542 RETURN
6543 END
6544C
6545!||====================================================================
6546!|| sorti11t ../engine/source/mpi/interfaces/spmd_i7tool.F
6547!||--- called by ------------------------------------------------------
6548!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
6549!||====================================================================
6550 SUBROUTINE sorti11t(N,ISKY,FSKYI,FTHESKYI,NFSKYI)
6551C
6552C-----------------------------------------------
6553C I m p l i c i t T y p e s
6554C-----------------------------------------------
6555#include "implicit_f.inc"
6556C-----------------------------------------------
6557C D u m m y A r g u m e n t s
6558C-----------------------------------------------
6559 INTEGER N, NFSKYI, ISKY(*)
6560 my_real
6561 . fskyi(2*nfskyi,*),ftheskyi(*)
6562C-----------------------------------------------
6563C L o c a l V a r i a b l e s
6564C-----------------------------------------------
6565 INTEGER I, J, L, IR, IIA
6566 my_real
6567 . rra1, rra2, rra3, rra4, rra5,
6568 . rra6, rra7, rra8, rra9, rra10,
6569 . rra11,rra12
6570C-----------------------------------------------
6571C S o u r c e L i n e s
6572C-----------------------------------------------
6573C test on n=0
6574 IF (n==0) RETURN
6575 l=n/2+1
6576 ir=n
6577 IF(nfskyi==4)THEN
657810 CONTINUE
6579 IF(l>1)THEN
6580 l=l-1
6581 iia =isky(l)
6582 rra1=fskyi(1,l)
6583 rra2=fskyi(2,l)
6584 rra3=fskyi(3,l)
6585 rra4=fskyi(4,l)
6586 rra5=fskyi(5,l)
6587 rra6=fskyi(6,l)
6588 rra7=fskyi(7,l)
6589 rra8=fskyi(8,l)
6590 rra9=ftheskyi(l)
6591 ELSE
6592 iia =isky(ir)
6593 rra1=fskyi(1,ir)
6594 rra2=fskyi(2,ir)
6595 rra3=fskyi(3,ir)
6596 rra4=fskyi(4,ir)
6597 rra5=fskyi(5,ir)
6598 rra6=fskyi(6,ir)
6599 rra7=fskyi(7,ir)
6600 rra8=fskyi(8,ir)
6601 rra9=ftheskyi(ir)
6602 isky(ir)=isky(1)
6603 fskyi(1,ir)=fskyi(1,1)
6604 fskyi(2,ir)=fskyi(2,1)
6605 fskyi(3,ir)=fskyi(3,1)
6606 fskyi(4,ir)=fskyi(4,1)
6607 fskyi(5,ir)=fskyi(5,1)
6608 fskyi(6,ir)=fskyi(6,1)
6609 fskyi(7,ir)=fskyi(7,1)
6610 fskyi(8,ir)=fskyi(8,1)
6611 ftheskyi(ir)=ftheskyi(1)
6612 ir=ir-1
6613C IF(IR==1)THEN
6614 IF(ir<=1)THEN
6615 isky(1)=iia
6616 fskyi(1,1)=rra1
6617 fskyi(2,1)=rra2
6618 fskyi(3,1)=rra3
6619 fskyi(4,1)=rra4
6620 fskyi(5,1)=rra5
6621 fskyi(6,1)=rra6
6622 fskyi(7,1)=rra7
6623 fskyi(8,1)=rra8
6624 ftheskyi(1)=rra9
6625 RETURN
6626 ENDIF
6627 ENDIF
6628 i=l
6629 j=l+l
663020 IF(j<=ir)THEN
6631 IF(j<ir)THEN
6632 IF(isky(j)<isky(j+1))j=j+1
6633 ENDIF
6634 IF(iia<isky(j))THEN
6635 isky(i)=isky(j)
6636 fskyi(1,i)=fskyi(1,j)
6637 fskyi(2,i)=fskyi(2,j)
6638 fskyi(3,i)=fskyi(3,j)
6639 fskyi(4,i)=fskyi(4,j)
6640 fskyi(5,i)=fskyi(5,j)
6641 fskyi(6,i)=fskyi(6,j)
6642 fskyi(7,i)=fskyi(7,j)
6643 fskyi(8,i)=fskyi(8,j)
6644 ftheskyi(i)=ftheskyi(j)
6645 i=j
6646 j=j+j
6647 ELSE
6648 j=ir+1
6649 ENDIF
6650 GO TO 20
6651 ENDIF
6652 isky(i)=iia
6653 fskyi(1,i)=rra1
6654 fskyi(2,i)=rra2
6655 fskyi(3,i)=rra3
6656 fskyi(4,i)=rra4
6657 fskyi(5,i)=rra5
6658 fskyi(6,i)=rra6
6659 fskyi(7,i)=rra7
6660 fskyi(8,i)=rra8
6661 ftheskyi(i)=rra9
6662 GO TO 10
6663 ELSE
6664100 CONTINUE
6665 IF(l>1)THEN
6666 l=l-1
6667 iia =isky(l)
6668 rra1=fskyi(1,l)
6669 rra2=fskyi(2,l)
6670 rra3=fskyi(3,l)
6671 rra4=fskyi(4,l)
6672 rra5=fskyi(5,l)
6673 rra6=fskyi(6,l)
6674 rra7=fskyi(7,l)
6675 rra8=fskyi(8,l)
6676 rra9=fskyi(9,l)
6677 rra10=fskyi(10,l)
6678 rra9=ftheskyi(l)
6679 ELSE
6680 iia =isky(ir)
6681 rra1=fskyi(1,ir)
6682 rra2=fskyi(2,ir)
6683 rra3=fskyi(3,ir)
6684 rra4=fskyi(4,ir)
6685 rra5=fskyi(5,ir)
6686 rra6=fskyi(6,ir)
6687 rra7=fskyi(7,ir)
6688 rra8=fskyi(8,ir)
6689 rra9=fskyi(9,ir)
6690 rra10=fskyi(10,ir)
6691 rra11=ftheskyi(ir)
6692 isky(ir)=isky(1)
6693 fskyi(1,ir)=fskyi(1,1)
6694 fskyi(2,ir)=fskyi(2,1)
6695 fskyi(3,ir)=fskyi(3,1)
6696 fskyi(4,ir)=fskyi(4,1)
6697 fskyi(5,ir)=fskyi(5,1)
6698 fskyi(6,ir)=fskyi(6,1)
6699 fskyi(7,ir)=fskyi(7,1)
6700 fskyi(8,ir)=fskyi(8,1)
6701 fskyi(9,ir)=fskyi(9,1)
6702 fskyi(10,ir)=fskyi(10,1)
6703 ftheskyi(ir)=ftheskyi(1)
6704 ir=ir-1
6705C IF(IR==1)THEN
6706 IF(ir<=1)THEN
6707 isky(1)=iia
6708 fskyi(1,1)=rra1
6709 fskyi(2,1)=rra2
6710 fskyi(3,1)=rra3
6711 fskyi(4,1)=rra4
6712 fskyi(5,1)=rra5
6713 fskyi(6,1)=rra6
6714 fskyi(7,1)=rra7
6715 fskyi(8,1)=rra8
6716 fskyi(9,1)=rra9
6717 fskyi(10,1)=rra10
6718 ftheskyi(1)=rra11
6719 RETURN
6720 ENDIF
6721 ENDIF
6722 i=l
6723 j=l+l
6724200 IF(j<=ir)THEN
6725 IF(j<ir)THEN
6726 IF(isky(j)<isky(j+1))j=j+1
6727 ENDIF
6728 IF(iia<isky(j))THEN
6729 isky(i)=isky(j)
6730 fskyi(1,i)=fskyi(1,j)
6731 fskyi(2,i)=fskyi(2,j)
6732 fskyi(3,i)=fskyi(3,j)
6733 fskyi(4,i)=fskyi(4,j)
6734 fskyi(5,i)=fskyi(5,j)
6735 fskyi(6,i)=fskyi(6,j)
6736 fskyi(7,i)=fskyi(7,j)
6737 fskyi(8,i)=fskyi(8,j)
6738 fskyi(9,i)=fskyi(9,j)
6739 fskyi(10,i)=fskyi(10,j)
6740 ftheskyi(i)=ftheskyi(j)
6741 i=j
6742 j=j+j
6743 ELSE
6744 j=ir+1
6745 ENDIF
6746 GO TO 200
6747 ENDIF
6748 isky(i)=iia
6749 fskyi(1,i)=rra1
6750 fskyi(2,i)=rra2
6751 fskyi(3,i)=rra3
6752 fskyi(4,i)=rra4
6753 fskyi(5,i)=rra5
6754 fskyi(6,i)=rra6
6755 fskyi(7,i)=rra7
6756 fskyi(8,i)=rra8
6757 fskyi(9,i)=rra9
6758 fskyi(10,i)=rra10
6759 ftheskyi(i)=rra11
6760 GO TO 100
6761 ENDIF
6762C
6763 RETURN
6764 END
6765C
6766!||====================================================================
6767!|| sorti11tt ../engine/source/mpi/interfaces/spmd_i7tool.F
6768!||--- called by ------------------------------------------------------
6769!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
6770!||====================================================================
6771 SUBROUTINE sorti11tt(N,ISKY,FSKYI,FTHESKYI,CONDNSKYI,NFSKYI)
6772C
6773C-----------------------------------------------
6774C I m p l i c i t T y p e s
6775C-----------------------------------------------
6776#include "implicit_f.inc"
6777C-----------------------------------------------
6778C D u m m y A r g u m e n t s
6779C-----------------------------------------------
6780 INTEGER N, NFSKYI, ISKY(*)
6781 my_real
6782 . fskyi(2*nfskyi,*),ftheskyi(*),condnskyi(*)
6783C-----------------------------------------------
6784C L o c a l V a r i a b l e s
6785C-----------------------------------------------
6786 INTEGER I, J, L, IR, IIA
6787 my_real
6788 . rra1, rra2, rra3, rra4, rra5,
6789 . rra6, rra7, rra8, rra9, rra10,
6790 . rra11,rra12
6791C-----------------------------------------------
6792C S o u r c e L i n e s
6793C-----------------------------------------------
6794C test on n=0
6795 IF (n==0) RETURN
6796 l=n/2+1
6797 ir=n
6798 IF(nfskyi==4)THEN
679910 CONTINUE
6800 IF(l>1)THEN
6801 l=l-1
6802 iia =isky(l)
6803 rra1=fskyi(1,l)
6804 rra2=fskyi(2,l)
6805 rra3=fskyi(3,l)
6806 rra4=fskyi(4,l)
6807 rra5=fskyi(5,l)
6808 rra6=fskyi(6,l)
6809 rra7=fskyi(7,l)
6810 rra8=fskyi(8,l)
6811 rra9=ftheskyi(l)
6812 rra10=condnskyi(l)
6813 ELSE
6814 iia =isky(ir)
6815 rra1=fskyi(1,ir)
6816 rra2=fskyi(2,ir)
6817 rra3=fskyi(3,ir)
6818 rra4=fskyi(4,ir)
6819 rra5=fskyi(5,ir)
6820 rra6=fskyi(6,ir)
6821 rra7=fskyi(7,ir)
6822 rra8=fskyi(8,ir)
6823 rra9=ftheskyi(ir)
6824 rra10=condnskyi(ir)
6825 isky(ir)=isky(1)
6826 fskyi(1,ir)=fskyi(1,1)
6827 fskyi(2,ir)=fskyi(2,1)
6828 fskyi(3,ir)=fskyi(3,1)
6829 fskyi(4,ir)=fskyi(4,1)
6830 fskyi(5,ir)=fskyi(5,1)
6831 fskyi(6,ir)=fskyi(6,1)
6832 fskyi(7,ir)=fskyi(7,1)
6833 fskyi(8,ir)=fskyi(8,1)
6834 ftheskyi(ir)=ftheskyi(1)
6835 condnskyi(ir)=condnskyi(1)
6836 ir=ir-1
6837C IF(IR==1)THEN
6838 IF(ir<=1)THEN
6839 isky(1)=iia
6840 fskyi(1,1)=rra1
6841 fskyi(2,1)=rra2
6842 fskyi(3,1)=rra3
6843 fskyi(4,1)=rra4
6844 fskyi(5,1)=rra5
6845 fskyi(6,1)=rra6
6846 fskyi(7,1)=rra7
6847 fskyi(8,1)=rra8
6848 ftheskyi(1)=rra9
6849 condnskyi(1)=rra10
6850 RETURN
6851 ENDIF
6852 ENDIF
6853 i=l
6854 j=l+l
685520 IF(j<=ir)THEN
6856 IF(j<ir)THEN
6857 IF(isky(j)<isky(j+1))j=j+1
6858 ENDIF
6859 IF(iia<isky(j))THEN
6860 isky(i)=isky(j)
6861 fskyi(1,i)=fskyi(1,j)
6862 fskyi(2,i)=fskyi(2,j)
6863 fskyi(3,i)=fskyi(3,j)
6864 fskyi(4,i)=fskyi(4,j)
6865 fskyi(5,i)=fskyi(5,j)
6866 fskyi(6,i)=fskyi(6,j)
6867 fskyi(7,i)=fskyi(7,j)
6868 fskyi(8,i)=fskyi(8,j)
6869 ftheskyi(i)=ftheskyi(j)
6870 condnskyi(i)=condnskyi(j)
6871 i=j
6872 j=j+j
6873 ELSE
6874 j=ir+1
6875 ENDIF
6876 GO TO 20
6877 ENDIF
6878 isky(i)=iia
6879 fskyi(1,i)=rra1
6880 fskyi(2,i)=rra2
6881 fskyi(3,i)=rra3
6882 fskyi(4,i)=rra4
6883 fskyi(5,i)=rra5
6884 fskyi(6,i)=rra6
6885 fskyi(7,i)=rra7
6886 fskyi(8,i)=rra8
6887 ftheskyi(i)=rra9
6888 condnskyi(i)=rra10
6889 GO TO 10
6890 ELSE
6891100 CONTINUE
6892 IF(l>1)THEN
6893 l=l-1
6894 iia =isky(l)
6895 rra1=fskyi(1,l)
6896 rra2=fskyi(2,l)
6897 rra3=fskyi(3,l)
6898 rra4=fskyi(4,l)
6899 rra5=fskyi(5,l)
6900 rra6=fskyi(6,l)
6901 rra7=fskyi(7,l)
6902 rra8=fskyi(8,l)
6903 rra9=fskyi(9,l)
6904 rra10=fskyi(10,l)
6905 rra9=ftheskyi(l)
6906 rra10=condnskyi(l)
6907 ELSE
6908 iia =isky(ir)
6909 rra1=fskyi(1,ir)
6910 rra2=fskyi(2,ir)
6911 rra3=fskyi(3,ir)
6912 rra4=fskyi(4,ir)
6913 rra5=fskyi(5,ir)
6914 rra6=fskyi(6,ir)
6915 rra7=fskyi(7,ir)
6916 rra8=fskyi(8,ir)
6917 rra9=fskyi(9,ir)
6918 rra10=fskyi(10,ir)
6919 rra11=ftheskyi(ir)
6920 rra12=condnskyi(ir)
6921 isky(ir)=isky(1)
6922 fskyi(1,ir)=fskyi(1,1)
6923 fskyi(2,ir)=fskyi(2,1)
6924 fskyi(3,ir)=fskyi(3,1)
6925 fskyi(4,ir)=fskyi(4,1)
6926 fskyi(5,ir)=fskyi(5,1)
6927 fskyi(6,ir)=fskyi(6,1)
6928 fskyi(7,ir)=fskyi(7,1)
6929 fskyi(8,ir)=fskyi(8,1)
6930 fskyi(9,ir)=fskyi(9,1)
6931 fskyi(10,ir)=fskyi(10,1)
6932 ftheskyi(ir)=ftheskyi(1)
6933 condnskyi(ir)=condnskyi(1)
6934 ir=ir-1
6935C IF(IR==1)THEN
6936 IF(ir<=1)THEN
6937 isky(1)=iia
6938 fskyi(1,1)=rra1
6939 fskyi(2,1)=rra2
6940 fskyi(3,1)=rra3
6941 fskyi(4,1)=rra4
6942 fskyi(5,1)=rra5
6943 fskyi(6,1)=rra6
6944 fskyi(7,1)=rra7
6945 fskyi(8,1)=rra8
6946 fskyi(9,1)=rra9
6947 fskyi(10,1)=rra10
6948 ftheskyi(1)=rra11
6949 condnskyi(1)=rra12
6950 RETURN
6951 ENDIF
6952 ENDIF
6953 i=l
6954 j=l+l
6955200 IF(j<=ir)THEN
6956 IF(j<ir)THEN
6957 IF(isky(j)<isky(j+1))j=j+1
6958 ENDIF
6959 IF(iia<isky(j))THEN
6960 isky(i)=isky(j)
6961 fskyi(1,i)=fskyi(1,j)
6962 fskyi(2,i)=fskyi(2,j)
6963 fskyi(3,i)=fskyi(3,j)
6964 fskyi(4,i)=fskyi(4,j)
6965 fskyi(5,i)=fskyi(5,j)
6966 fskyi(6,i)=fskyi(6,j)
6967 fskyi(7,i)=fskyi(7,j)
6968 fskyi(8,i)=fskyi(8,j)
6969 fskyi(9,i)=fskyi(9,j)
6970 fskyi(10,i)=fskyi(10,j)
6971 ftheskyi(i)=ftheskyi(j)
6972 condnskyi(i)=condnskyi(j)
6973 i=j
6974 j=j+j
6975 ELSE
6976 j=ir+1
6977 ENDIF
6978 GO TO 200
6979 ENDIF
6980 isky(i)=iia
6981 fskyi(1,i)=rra1
6982 fskyi(2,i)=rra2
6983 fskyi(3,i)=rra3
6984 fskyi(4,i)=rra4
6985 fskyi(5,i)=rra5
6986 fskyi(6,i)=rra6
6987 fskyi(7,i)=rra7
6988 fskyi(8,i)=rra8
6989 fskyi(9,i)=rra9
6990 fskyi(10,i)=rra10
6991 ftheskyi(i)=rra11
6992 condnskyi(i)=rra12
6993 GO TO 100
6994 ENDIF
6995C
6996 RETURN
6997 END
6998C
6999!||====================================================================
7000!|| sorti17 ../engine/source/mpi/interfaces/spmd_i7tool.F
7001!||--- called by ------------------------------------------------------
7002!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
7003!||====================================================================
7004 SUBROUTINE sorti17(N,ISKY,FSKYI)
7005C
7006C-----------------------------------------------
7007C I m p l i c i t T y p e s
7008C-----------------------------------------------
7009#include "implicit_f.inc"
7010C-----------------------------------------------
7011C D u m m y A r g u m e n t s
7012C-----------------------------------------------
7013 INTEGER N, NFSKYI, ISKY(*)
7014 my_real
7015 . fskyi(40,*)
7016C-----------------------------------------------
7017C L o c a l V a r i a b l e s
7018C-----------------------------------------------
7019 INTEGER I, J, L, IR, IIA, II
7020 my_real
7021 . rra(40)
7022C-----------------------------------------------
7023C S o u r c e L i n e s
7024C-----------------------------------------------
7025 IF (n==0) RETURN
7026 l=n/2+1
7027 ir=n
702810 CONTINUE
7029 IF(l>1)THEN
7030 l=l-1
7031 iia =isky(l)
7032 DO ii = 1, 40
7033 rra(ii)=fskyi(ii,l)
7034 END DO
7035 ELSE
7036 iia =isky(ir)
7037 DO ii = 1, 40
7038 rra(ii)=fskyi(ii,ir)
7039 END DO
7040 isky(ir)=isky(1)
7041 DO ii = 1, 40
7042 fskyi(ii,ir)=fskyi(ii,1)
7043 END DO
7044 ir=ir-1
7045 IF(ir<=1)THEN
7046 isky(1)=iia
7047 DO ii = 1, 40
7048 fskyi(ii,1)=rra(ii)
7049 END DO
7050 RETURN
7051 ENDIF
7052 ENDIF
7053 i=l
7054 j=l+l
705520 IF(j<=ir)THEN
7056 IF(j<ir)THEN
7057 IF(isky(j)<isky(j+1))j=j+1
7058 ENDIF
7059 IF(iia<isky(j))THEN
7060 isky(i)=isky(j)
7061 DO ii = 1, 40
7062 fskyi(ii,i)=fskyi(ii,j)
7063 END DO
7064 i=j
7065 j=j+j
7066 ELSE
7067 j=ir+1
7068 ENDIF
7069 GO TO 20
7070 ENDIF
7071 isky(i)=iia
7072 DO ii = 1, 40
7073 fskyi(ii,i)=rra(ii)
7074 END DO
7075 GO TO 10
7076C
7077 RETURN
7078 END
7079
7080
7081!||====================================================================
7082!|| putdpzero ../engine/source/mpi/interfaces/spmd_i7tool.F
7083!||--- called by ------------------------------------------------------
7084!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
7085!|| spmd_i7xvcom2 ../engine/source/mpi/interfaces/spmd_i7xvcom2.F
7086!||====================================================================
7087 SUBROUTINE putdpzero(ZZ,BUF,IRESP,INC)
7088C
7089C-----------------------------------------------
7090C I m p l i c i t T y p e s
7091C-----------------------------------------------
7092#include "implicit_f.inc"
7093C-----------------------------------------------
7094C D u m m y A r g u m e n t s
7095C-----------------------------------------------
7096 INTEGER IRESP,INC
7097 my_real
7098 . buf(*), zz(*)
7099C-----------------------------------------------
7100C L o c a l V a r i a b l e s
7101C-----------------------------------------------
7102 INTEGER I
7103C-----------------------------------------------
7104C S o u r c e L i n e s
7105C-----------------------------------------------
7106C If double precision, we compact 18 DP values
7107C If simple precision, we compact 18 DP values or 36 SP
7108 inc = 18
7109 IF(iresp==0) THEN
7110 DO i = 1,inc
7111 buf(i) = zz(1)
7112 END DO
7113 ELSE
7114 DO i = 1, inc
7115 buf(2*i-1) = zz(1)
7116 buf(2*i) = zz(2)
7117 END DO
7118 inc = inc + 18
7119 END IF
7120C
7121 RETURN
7122 END
7123
7124!||====================================================================
7125!|| adddp ../engine/source/mpi/interfaces/spmd_i7tool.F
7126!||--- called by ------------------------------------------------------
7127!|| spmd_exch_da20 ../engine/source/mpi/interfaces/spmd_exch_da20.F
7128!||====================================================================
7129 SUBROUTINE adddp(DAANC6,DAANC6L,LEN)
7130C
7131C-----------------------------------------------
7132C I m p l i c i t T y p e s
7133C-----------------------------------------------
7134#include "implicit_f.inc"
7135C-----------------------------------------------
7136C D u m m y A r g u m e n t s
7137C-----------------------------------------------
7138 INTEGER LEN
7139 double precision
7140 . daanc6(*), daanc6l(*)
7141C-----------------------------------------------
7142C L o c a l V a r i a b l e s
7143C-----------------------------------------------
7144 INTEGER I
7145 DOUBLE PRECISION
7146 . DATMP(LEN)
7147C-----------------------------------------------
7148C S o u r c e L i n e s
7149C-----------------------------------------------
7150 DO I = 1,len
7151 datmp(i) = daanc6(i) + daanc6l(i)
7152 END DO
7153C 2 loops to avoid integer dp alignment problem on pgi
7154 DO i = 1,len
7155 daanc6(i) = datmp(i)
7156 END DO
7157C
7158 RETURN
7159 END
7160
7161!||====================================================================
7162!|| conversion7 ../engine/source/mpi/interfaces/spmd_i7tool.f
7163!||--- called by ------------------------------------------------------
7164!|| spmd_tri20box ../engine/source/mpi/interfaces/spmd_tri20box.F
7165!||====================================================================
7166 SUBROUTINE conversion7(XREM,XREM_DP,IREM,SIZ,LEN)
7167C
7168C-----------------------------------------------
7169C I m p l i c i t T y p e s
7170C-----------------------------------------------
7171#include "implicit_f.inc"
7172C-----------------------------------------------
7173C D u m m y A r g u m e n t s
7174C-----------------------------------------------
7175 INTEGER LEN, SIZ, IREM(1,*)
7176 real*4 xrem(siz,*)
7177 double precision
7178 . xrem_dp(siz,*)
7179C-----------------------------------------------
7180C L o c a l V a r i a b l e s
7181C-----------------------------------------------
7182 INTEGER I, J
7183C-----------------------------------------------
7184C S o u r c e L i n e s
7185C-----------------------------------------------
7186 DO i = 1, len
7187 irem(1,i) = nint(xrem_dp(10,i))
7188 END DO
7189 DO i = 1, len
7190 DO j = 1, siz
7191 xrem(j,i) = xrem_dp(j,i)
7192 END DO
7193 END DO
7194C
7195 RETURN
7196 END
7197
7198!||====================================================================
7199!|| conversion11 ../engine/source/mpi/interfaces/spmd_i7tool.F
7200!||--- called by ------------------------------------------------------
7201!|| spmd_tri20boxe ../engine/source/mpi/interfaces/spmd_tri20boxe.F
7202!|| spmd_tri22vox ../engine/source/mpi/interfaces/spmd_tri22vox.F
7203!||====================================================================
7204 SUBROUTINE conversion11(XREM,XREM_DP,IREM,SIZ,LEN)
7205C
7206C-----------------------------------------------
7207C I m p l i c i t T y p e s
7208C-----------------------------------------------
7209#include "implicit_f.inc"
7210C-----------------------------------------------
7211C D u m m y A r g u m e n t s
7212C-----------------------------------------------
7213 INTEGER LEN, SIZ, IREM(2,*)
7214 REAL*4 XREM(SIZ,*)
7215 DOUBLE PRECISION
7216 . xrem_dp(siz,*)
7217C-----------------------------------------------
7218C L o c a l V a r i a b l e s
7219C-----------------------------------------------
7220 INTEGER I, J
7221C-----------------------------------------------
7222C S o u r c e L i n e s
7223C-----------------------------------------------
7224 DO i = 1, len
7225 irem(1,i) = nint(xrem_dp(9,i))
7226 irem(2,i) = nint(xrem_dp(17,i))
7227 END DO
7228 DO i = 1, len
7229 DO j = 1, siz
7230 xrem(j,i) = xrem_dp(j,i)
7231 END DO
7232 END DO
7233C
7234 RETURN
7235 END
7236!||====================================================================
7237!|| upgrade_rem_2ry ../engine/source/mpi/interfaces/spmd_i7tool.F
7238!||--- called by ------------------------------------------------------
7239!|| resol ../engine/source/engine/resol.F
7240!||--- calls -----------------------------------------------------
7241!|| ancmsg ../engine/source/output/message/message.F
7242!|| arret ../engine/source/system/arret.F
7243!||--- uses -----------------------------------------------------
7244!|| message_mod ../engine/share/message_module/message_mod.F
7245!|| tri25ebox ../engine/share/modules/tri25ebox.F
7246!|| tri7box ../engine/share/modules/tri7box.F
7247!||====================================================================
7248 SUBROUTINE upgrade_rem_2ry(IPARI,COUNT_REMSLV,COUNT_REMSLVE,NODADT_THERM)
7249 USE tri7box
7250 USE tri25ebox
7251 USE message_mod
7252C-----------------------------------------------
7253C I m p l i c i t T y p e s
7254C-----------------------------------------------
7255#include "implicit_f.inc"
7256C-----------------------------------------------
7257C C o m m o n B l o c k s
7258C-----------------------------------------------
7259#include "com04_c.inc"
7260#include "scr18_c.inc"
7261#include "param_c.inc"
7262C-----------------------------------------------
7263C D u m m y A r g u m e n t s
7264C-----------------------------------------------
7265 INTEGER IPARI(NPARI,*),COUNT_REMSLV(*),COUNT_REMSLVE(*)
7266 INTEGER, INTENT(IN) :: NODADT_THERM
7267C-----------------------------------------------
7268C L o c a l V a r i a b l e s
7269C-----------------------------------------------
7270 INTEGER NI,ITYP,LSKYFI,IERROR1,INTTH,IERROR
7271C-----------------------------------------------
7272 LSKYFI = 0
7273 do ni=1,ninter
7274 ierror = 0
7275 ierror1 = 0
7276
7277 IF (count_remslv(ni) > nlskyfi(ni))THEN
7278
7279 ityp = ipari(7,ni)
7280C
7281 nlskyfi(ni)=nint(count_remslv(ni)*1.20d0)
7282
7283 lskyfi=nlskyfi(ni)
7284C
7285 IF(ityp==7.OR.ityp==10.OR.ityp==20.OR.
7286 . ityp==22.OR.ityp==23.OR.ityp==24.OR.
7287 . ityp==25)THEN
7288 intth = ipari(47,ni)
7289
7290 IF (ASSOCIATED(iskyfi(ni)%P)) DEALLOCATE(iskyfi(ni)%P)
7291 IF (ASSOCIATED(fskyfi(ni)%P)) DEALLOCATE(fskyfi(ni)%P)
7292C
7293 ALLOCATE(iskyfi(ni)%P(lskyfi),stat=ierror1)
7294 ierror = ierror + ierror1
7295 IF(kdtint==0) THEN
7296 ALLOCATE(fskyfi(ni)%P(4,lskyfi),stat=ierror1)
7297 ierror = ierror + ierror1
7298 ELSE
7299 ALLOCATE(fskyfi(ni)%P(5,lskyfi),stat=ierror1)
7300 ierror = ierror + ierror1
7301 END IF
7302 IF(ityp==7 .OR. ityp==25) THEN
7303 IF(intth /=0 ) THEN
7304 IF(ASSOCIATED(ftheskyfi(ni)%P)) DEALLOCATE(ftheskyfi(ni)%P)
7305 ALLOCATE(ftheskyfi(ni)%P(lskyfi),stat=ierror1)
7306 ierror = ierror + ierror1
7307 ENDIF
7308 IF(intth /= 0 .AND. nodadt_therm ==1) THEN
7309 IF(ASSOCIATED(condnskyfi(ni)%P)) DEALLOCATE(condnskyfi(ni)%P)
7310 ALLOCATE(condnskyfi(ni)%P(lskyfi),stat=ierror1)
7311 ierror = ierror + ierror1
7312 ENDIF
7313 ENDIF
7314 ELSEIF(ityp==11)THEN
7315 intth = ipari(47,ni)
7316 ierror = 0
7317 IF(ASSOCIATED(iskyfi(ni)%P)) DEALLOCATE(iskyfi(ni)%P)
7318 IF(ASSOCIATED(fskyfi(ni)%P)) DEALLOCATE(fskyfi(ni)%P)
7319 ALLOCATE(iskyfi(ni)%P(lskyfi),stat=ierror1)
7320 ierror = ierror + ierror1
7321 IF(intth /=0 ) THEN
7322 IF(ASSOCIATED(ftheskyfi(ni)%P)) DEALLOCATE(ftheskyfi(ni)%P)
7323 ALLOCATE(ftheskyfi(ni)%P(2*lskyfi),stat=ierror1)
7324 ierror = ierror + ierror1
7325 ENDIF
7326 IF(kdtint==0) THEN
7327 ALLOCATE(fskyfi(ni)%P(8,lskyfi),stat=ierror1)
7328 ierror = ierror + ierror1
7329 ELSE
7330 ALLOCATE(fskyfi(ni)%P(10,lskyfi),stat=ierror1)
7331 ierror = ierror + ierror1
7332 END IF
7333 IF(intth /= 0 .AND. nodadt_therm ==1) THEN
7334 IF(ASSOCIATED(condnskyfi(ni)%P)) DEALLOCATE(condnskyfi(ni)%P)
7335 ALLOCATE(condnskyfi(ni)%P(2*lskyfi),stat=ierror1)
7336 ierror = ierror + ierror1
7337 ENDIF
7338 ENDIF
7339 ENDIF
7340 IF( count_remslve(ni) > nlskyfie(ni) )THEN
7341 nlskyfie(ni) = nint(1.2d0 * count_remslve(ni))
7342 lskyfi = count_remslve(ni)
7343 IF (ASSOCIATED(fskyfie(ni)%P))DEALLOCATE(fskyfie(ni)%P)
7344 IF (ASSOCIATED(iskyfie(ni)%P)) DEALLOCATE(iskyfie(ni)%P)
7345 ALLOCATE(iskyfie(ni)%P(lskyfi),stat=ierror1)
7346 IF(kdtint==0) THEN
7347C ALLOCATE(FSKYFIE(NI)%P(8,LSKYFI),STAT=IERROR1)
7348 ALLOCATE(fskyfie(ni)%P(8,lskyfi),stat=ierror1)
7349 ierror = ierror + ierror1
7350 ELSE
7351 ALLOCATE(fskyfie(ni)%P(8,lskyfi),stat=ierror1)
7352 ierror = ierror + ierror1
7353 END IF
7354 ENDIF
7355
7356 IF(ierror/=0) THEN
7357 CALL ancmsg(msgid=20,anmode=aninfo)
7358 CALL arret(2)
7359 ENDIF
7360 ENDDO
7361 RETURN
7362 END
7363
7364!||====================================================================
7365!|| getdpdaanc ../engine/source/mpi/interfaces/spmd_i7tool.F
7366!||--- called by ------------------------------------------------------
7367!|| spmd_exch_da20 ../engine/source/mpi/interfaces/spmd_exch_da20.F
7368!|| spmd_fiadd20_poff ../engine/source/mpi/interfaces/spmd_i7tool.F
7369!|| spmd_fiadd20_pon ../engine/source/mpi/interfaces/spmd_i20tool.F
7370!|| spmd_fiadd20e_poff ../engine/source/mpi/interfaces/spmd_i7tool.F
7371!|| spmd_fiadd20e_pon ../engine/source/mpi/interfaces/spmd_i20tool.F
7372!|| spmd_i7xvcom2 ../engine/source/mpi/interfaces/spmd_i7xvcom2.F
7373!||====================================================================
7374 SUBROUTINE getdpdaanc(DAANC6,BUF,IRESP,INC)
7375C
7376C-----------------------------------------------
7377C I m p l i c i t T y p e s
7378C-----------------------------------------------
7379#include "implicit_f.inc"
7380C-----------------------------------------------
7381C D u m m y A r g u m e n t s
7382C-----------------------------------------------
7383 INTEGER IRESP,INC
7384 my_real
7385 . buf(*), daanc6(*)
7386C-----------------------------------------------
7387C L o c a l V a r i a b l e s
7388C-----------------------------------------------
7389 INTEGER I
7390C-----------------------------------------------
7391C S o u r c e L i n e s
7392C-----------------------------------------------
7393C If double precision, we compact 18 DP values
7394C If simple precision, we compact 18 DP values or 36 SP
7395 inc = 18*(1+iresp)
7396 DO i = 1,inc
7397 daanc6(i) = buf(i)
7398 END DO
7399C
7400 RETURN
7401 END
7402
7403
7404!||====================================================================
7405!|| putdpdaanc ../engine/source/mpi/interfaces/spmd_i7tool.F
7406!||--- called by ------------------------------------------------------
7407!|| spmd_exch_da20 ../engine/source/mpi/interfaces/spmd_exch_da20.F
7408!|| spmd_i7fcom_poff ../engine/source/mpi/forces/spmd_i7fcom_poff.F
7409!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
7410!|| spmd_i7xvcom2 ../engine/source/mpi/interfaces/spmd_i7xvcom2.F
7411!||====================================================================
7412 SUBROUTINE putdpdaanc(DAANC6,BUF,IRESP,INC)
7413C
7414C-----------------------------------------------
7415C I m p l i c i t T y p e s
7416C-----------------------------------------------
7417#include "implicit_f.inc"
7418C-----------------------------------------------
7419C D u m m y A r g u m e n t s
7420C-----------------------------------------------
7421 INTEGER IRESP,INC
7422 my_real
7423 . buf(*), daanc6(*)
7424C-----------------------------------------------
7425C L o c a l V a r i a b l e s
7426C-----------------------------------------------
7427 INTEGER I
7428C-----------------------------------------------
7429C S o u r c e L i n e s
7430C-----------------------------------------------
7431C If double precision, we compact 18 DP values
7432C If simple precision, we compact 18 DP values or 36 SP
7433 inc = 18*(1+iresp)
7434 DO i = 1,inc
7435 buf(i) = daanc6(i)
7436 END DO
7437C
7438 RETURN
7439 END
my_real
#define my_real
Definition cppsort.cpp:32
i10tri
subroutine i10tri(add, nsn, renum, nsnr, nrtm, irect, x, xyzm, igap, gap, i_add, nsv, maxsiz, ii_stok, cand_n, cand_e, nsn4, noint, tzinf, maxbox, minbox, i_mem, nb_n_b, i_add_max, cand_a, eshift, nsnrold, stf, stfn, gap_s, gap_m, gapmin, gapmax, marge, nin, intheat, idt_therm, nodadt_therm)
Definition i10tri.F:43
i23main_tri
subroutine i23main_tri(timers, ipari, x, intbuf_tab, v, ms, nin, itask, mwag, weight, isendto, ircvfrom, retri, iad_elem, fr_elem, itab, kinet, nrtm_t, renum, nsnfiold, eshift, num_imp, ind_imp, nodnx_sms, h3d_data, multi_fvm, intheat, idt_therm, nodadt_therm)
Definition i23main_tri.F:59
ibcoff
subroutine ibcoff(ibc, icodt)
Definition ibcoff.F:44
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
groupdef_mod
Definition groupdef_mod.F:668
h3d_mod
Definition h3d_mod.F:311
inter_sorting_mod
Definition inter_sorting_mod.F:57
interface_modification_mod
Definition interface_modification_mod.F:33
interface_modification_mod::nsnsi_sav
type(int_pointer), dimension(:), allocatable nsnsi_sav
Definition interface_modification_mod.F:35
intstamp_glob_mod
Definition intstamp_glob_mod.F:30
intstamp_glob_mod::nmvsi
type(int_pointer), dimension(:), allocatable nmvsi
Definition intstamp_glob_mod.F:73
intstamp_glob_mod::nmnsi
type(int_pointer), dimension(:), allocatable nmnsi
Definition intstamp_glob_mod.F:73
intstamp_glob_mod::nmvfi
type(int_pointer), dimension(:), allocatable nmvfi
Definition intstamp_glob_mod.F:73
intstamp_glob_mod::nmnfi
type(int_pointer), dimension(:), allocatable nmnfi
Definition intstamp_glob_mod.F:73
intstamp_glob_mod::nmtemp
type(real_pointer), dimension(:), allocatable nmtemp
Definition intstamp_glob_mod.F:76
intstamp_glob_mod::tempnod
type(int_pointer), dimension(:), allocatable tempnod
Definition intstamp_glob_mod.F:73
message_mod
Definition message_mod.F:1257
parameters_mod
Definition parameters_mod.F:49
tri25ebox::nisubsfie
type(int_pointer), dimension(:), allocatable nisubsfie
Definition tri25ebox.F:103
tri25ebox::islen25e
integer islen25e
Definition tri25ebox.F:79
tri25ebox::inflg_subsfie
type(int_pointer), dimension(:), allocatable inflg_subsfie
Definition tri25ebox.F:111
tri25ebox::gape_l_fie
type(real_pointer), dimension(:), allocatable gape_l_fie
Definition tri25ebox.F:88
tri25ebox::lisubsfie
type(int_pointer), dimension(:), allocatable lisubsfie
Definition tri25ebox.F:107
tri25ebox::edg_bisector_fie
type(real4_pointer3), dimension(:), allocatable edg_bisector_fie
Definition tri25ebox.F:85
tri25ebox::vtx_bisector_fie
type(real4_pointer3), dimension(:), allocatable vtx_bisector_fie
Definition tri25ebox.F:86
tri25ebox::addsubsfie
type(int_pointer), dimension(:), allocatable addsubsfie
Definition tri25ebox.F:115
tri25ebox::x_seg_fie
type(real_pointer3), dimension(:), allocatable x_seg_fie
Definition tri25ebox.F:87
tri25ebox::edge_fi
type(int_pointer), dimension(:), allocatable edge_fi
Definition tri25ebox.F:69
tri25ebox::irlen25e
integer irlen25e
Definition tri25ebox.F:79
tri25ebox::ledge_fie
type(int_pointer2), dimension(:), allocatable ledge_fie
Definition tri25ebox.F:90
tri7box::ispt2_fi
type(int_pointer), dimension(:), allocatable ispt2_fi
Definition tri7box.F:538
tri7box::stif_oldfi
type(real_pointer2), dimension(:), allocatable stif_oldfi
Definition tri7box.F:545
tri7box::dxancfi
type(real_pointer2), dimension(:), allocatable dxancfi
Definition tri7box.F:473
tri7box::stnfi17
type(real_pointer2), dimension(:), allocatable stnfi17
Definition tri7box.F:467
tri7box::gapfie
type(real_pointer), dimension(:), allocatable gapfie
Definition tri7box.F:449
tri7box::eminxfi
type(real_pointer2), dimension(:), allocatable eminxfi
Definition tri7box.F:467
tri7box::secnd_frfi
type(real_pointer2), dimension(:), allocatable secnd_frfi
Definition tri7box.F:543
tri7box::stif_msdt_fi
type(real_pointer), dimension(:), allocatable stif_msdt_fi
Definition tri7box.F:552
tri7box::condnfi
type(real_pointer), dimension(:), allocatable condnfi
Definition tri7box.F:449
tri7box::is2pt_fi
type(int_pointer), dimension(:), allocatable is2pt_fi
Definition tri7box.F:537
tri7box::inflg_subsfi
type(int_pointer), dimension(:), allocatable inflg_subsfi
Definition tri7box.F:505
tri7box::iskew_fi
type(int_pointer), dimension(:), allocatable iskew_fi
Definition tri7box.F:550
tri7box::ftheskyfi
type(real_pointer), dimension(:), allocatable ftheskyfi
Definition tri7box.F:449
tri7box::isegpt_fi
type(int_pointer), dimension(:), allocatable isegpt_fi
Definition tri7box.F:539
tri7box::forneqsfi
type(real_pointer2), dimension(:), allocatable forneqsfi
Definition tri7box.F:459
tri7box::vfie
type(real_pointer2), dimension(:), allocatable vfie
Definition tri7box.F:459
tri7box::time_sfi
type(real_pointer), dimension(:), allocatable time_sfi
Definition tri7box.F:542
tri7box::afi17
type(real_pointer3), dimension(:), allocatable afi17
Definition tri7box.F:470
tri7box::daancfi
type(real_pointer2), dimension(:), allocatable daancfi
Definition tri7box.F:459
tri7box::fskyfie
type(real_pointer2), dimension(:), allocatable fskyfie
Definition tri7box.F:459
tri7box::i18kafi
type(real_pointer2), dimension(:), allocatable i18kafi
Definition tri7box.F:459
tri7box::vfi
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459
tri7box::fnconti
type(real_pointer2), dimension(:), allocatable fnconti
Definition tri7box.F:510
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533
tri7box::frotsfi
type(real_pointer2), dimension(:), allocatable frotsfi
Definition tri7box.F:467
tri7box::matsfi
type(int_pointer), dimension(:), allocatable matsfi
Definition tri7box.F:440
tri7box::is2se_fi
type(int_pointer2), dimension(:), allocatable is2se_fi
Definition tri7box.F:536
tri7box::ipartfric_fie
type(int_pointer), dimension(:), allocatable ipartfric_fie
Definition tri7box.F:440
tri7box::efricgfi
type(real_pointer), dimension(:), allocatable efricgfi
Definition tri7box.F:511
tri7box::dvancfi
type(real_pointer2), dimension(:), allocatable dvancfi
Definition tri7box.F:473
tri7box::tempfi
type(real_pointer), dimension(:), allocatable tempfi
Definition tri7box.F:449
tri7box::candf_si
type(int_pointer), dimension(:), allocatable candf_si
Definition tri7box.F:560
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::xfi17
type(real_pointer3), dimension(:), allocatable xfi17
Definition tri7box.F:470
tri7box::vfi17
type(real_pointer3), dimension(:), allocatable vfi17
Definition tri7box.F:470
tri7box::ksfi
type(real_pointer2), dimension(:), allocatable ksfi
Definition tri7box.F:467
tri7box::nsvsi
type(int_pointer), dimension(:), allocatable nsvsi
Definition tri7box.F:485
tri7box::xfie
type(real_pointer2), dimension(:), allocatable xfie
Definition tri7box.F:459
tri7box::iskyfie
type(int_pointer), dimension(:), allocatable iskyfie
Definition tri7box.F:480
tri7box::kremnor_fi
type(int_pointer), dimension(:), allocatable kremnor_fi
Definition tri7box.F:549
tri7box::gap_lfi
type(real_pointer), dimension(:), allocatable gap_lfi
Definition tri7box.F:449
tri7box::nsnfie
type(int_pointer), dimension(:), allocatable nsnfie
Definition tri7box.F:440
tri7box::dvancfie
type(real_pointer2), dimension(:), allocatable dvancfie
Definition tri7box.F:473
tri7box::mtfi_a
type(real_pointer2), dimension(:), allocatable mtfi_a
Definition tri7box.F:459
tri7box::daanc6fi
type(r8_pointer3), dimension(:), allocatable daanc6fi
Definition tri7box.F:476
tri7box::condnskyfi
type(real_pointer), dimension(:), allocatable condnskyfi
Definition tri7box.F:449
tri7box::penfi
type(real_pointer2), dimension(:), allocatable penfi
Definition tri7box.F:459
tri7box::nsnsie
type(int_pointer), dimension(:), allocatable nsnsie
Definition tri7box.F:491
tri7box::alphakfi
type(real_pointer), dimension(:), allocatable alphakfi
Definition tri7box.F:449
tri7box::stnfi
type(real_pointer), dimension(:), allocatable stnfi
Definition tri7box.F:449
tri7box::lisubsfi
type(int_pointer), dimension(:), allocatable lisubsfi
Definition tri7box.F:501
tri7box::irtse_fi
type(int_pointer2), dimension(:), allocatable irtse_fi
Definition tri7box.F:535
tri7box::penfia
type(real_pointer2), dimension(:), allocatable penfia
Definition tri7box.F:459
tri7box::afi
type(real_pointer2), dimension(:), allocatable afi
Definition tri7box.F:459
tri7box::nsvsie
type(int_pointer), dimension(:), allocatable nsvsie
Definition tri7box.F:485
tri7box::mtfi_pene
type(real_pointer), dimension(:), allocatable mtfi_pene
Definition tri7box.F:449
tri7box::nodamsfi
type(int_pointer), dimension(:), allocatable nodamsfi
Definition tri7box.F:440
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::fskyfi
type(real_pointer2), dimension(:), allocatable fskyfi
Definition tri7box.F:459
tri7box::nisubsfi
type(int_pointer), dimension(:), allocatable nisubsfi
Definition tri7box.F:497
tri7box::remnor_fi
type(int_pointer), dimension(:), allocatable remnor_fi
Definition tri7box.F:548
tri7box::stifie
type(real_pointer), dimension(:), allocatable stifie
Definition tri7box.F:449
tri7box::pmainfi
type(int_pointer), dimension(:), allocatable pmainfi
Definition tri7box.F:435
tri7box::stnfie
type(real_pointer), dimension(:), allocatable stnfie
Definition tri7box.F:449
tri7box::gapfi
type(real_pointer), dimension(:), allocatable gapfi
Definition tri7box.F:449
tri7box::procamsfie
type(int_pointer), dimension(:), allocatable procamsfie
Definition tri7box.F:440
tri7box::nodnxfi
type(int_pointer), dimension(:), allocatable nodnxfi
Definition tri7box.F:440
tri7box::nodnxfie
type(int_pointer), dimension(:), allocatable nodnxfie
Definition tri7box.F:440
tri7box::nsvfi
type(int_pointer), dimension(:), allocatable nsvfi
Definition tri7box.F:431
tri7box::intareanfi
type(real_pointer), dimension(:), allocatable intareanfi
Definition tri7box.F:554
tri7box::areasfi
type(real_pointer), dimension(:), allocatable areasfi
Definition tri7box.F:449
tri7box::icodt_fi
type(int_pointer), dimension(:), allocatable icodt_fi
Definition tri7box.F:551
tri7box::iskyfi
type(int_pointer), dimension(:), allocatable iskyfi
Definition tri7box.F:480
tri7box::isedge_fi
type(int_pointer), dimension(:), allocatable isedge_fi
Definition tri7box.F:540
tri7box::afie
type(real_pointer2), dimension(:), allocatable afie
Definition tri7box.F:459
tri7box::nbinflfi
type(int_pointer), dimension(:), allocatable nbinflfi
Definition tri7box.F:440
tri7box::nsnfi_sav
type(int_pointer), dimension(:), allocatable nsnfi_sav
Definition tri7box.F:440
tri7box::efricfi
type(real_pointer), dimension(:), allocatable efricfi
Definition tri7box.F:511
tri7box::msfi
type(real_pointer), dimension(:), allocatable msfi
Definition tri7box.F:449
tri7box::diag_smsfi
type(real_pointer), dimension(:), allocatable diag_smsfi
Definition tri7box.F:449
tri7box::vscfi
type(real_pointer), dimension(:), allocatable vscfi
Definition tri7box.F:449
tri7box::mtfi_n
type(real_pointer2), dimension(:), allocatable mtfi_n
Definition tri7box.F:459
tri7box::nsvfie
type(int_pointer), dimension(:), allocatable nsvfie
Definition tri7box.F:440
tri7box::addsubsfi
type(int_pointer), dimension(:), allocatable addsubsfi
Definition tri7box.F:509
tri7box::ipartfricsfi
type(int_pointer), dimension(:), allocatable ipartfricsfi
Definition tri7box.F:440
tri7box::nodamsfie
type(int_pointer), dimension(:), allocatable nodamsfie
Definition tri7box.F:440
tri7box::t2fac_sms_fi
type(real_pointer), dimension(:), allocatable t2fac_sms_fi
Definition tri7box.F:557
tri7box::daanc6fie
type(r8_pointer3), dimension(:), allocatable daanc6fie
Definition tri7box.F:476
tri7box::xfi
type(real_pointer2), dimension(:), allocatable xfi
Definition tri7box.F:459
tri7box::kinfi
type(int_pointer), dimension(:), allocatable kinfi
Definition tri7box.F:440
tri7box::vscfie
type(real_pointer), dimension(:), allocatable vscfie
Definition tri7box.F:449
tri7box::diag_smsfie
type(real_pointer), dimension(:), allocatable diag_smsfie
Definition tri7box.F:449
tri7box::alphakfie
type(real_pointer), dimension(:), allocatable alphakfie
Definition tri7box.F:449
tri7box::itafie
type(int_pointer), dimension(:), allocatable itafie
Definition tri7box.F:440
tri7box::nlskyfie
integer, dimension(:), allocatable nlskyfie
Definition tri7box.F:512
tri7box::penfie
type(real_pointer2), dimension(:), allocatable penfie
Definition tri7box.F:459
tri7box::nsnfi_flag
integer, dimension(:), allocatable nsnfi_flag
Definition tri7box.F:530
tri7box::dxancfie
type(real_pointer2), dimension(:), allocatable dxancfie
Definition tri7box.F:473
tri7box::stife_msdt_fi
type(real_pointer), dimension(:), allocatable stife_msdt_fi
Definition tri7box.F:553
tri7box::mtfi_penemin
type(real_pointer), dimension(:), allocatable mtfi_penemin
Definition tri7box.F:449
tri7box::nlskyfi
integer, dimension(:), allocatable nlskyfi
Definition tri7box.F:512
tri7box::fthefi
type(real_pointer), dimension(:), allocatable fthefi
Definition tri7box.F:449
tri7box::ftconti
type(real_pointer2), dimension(:), allocatable ftconti
Definition tri7box.F:510
tri7box::procamsfi
type(int_pointer), dimension(:), allocatable procamsfi
Definition tri7box.F:440
tri7box::islide_fi
type(int_pointer2), dimension(:), allocatable islide_fi
Definition tri7box.F:547
tri7box::pene_oldfi
type(real_pointer2), dimension(:), allocatable pene_oldfi
Definition tri7box.F:544
tri7box::icont_i_fi
type(int_pointer), dimension(:), allocatable icont_i_fi
Definition tri7box.F:532
tri7box::mtfi_v
type(real_pointer2), dimension(:), allocatable mtfi_v
Definition tri7box.F:459
tri7box::tagncontfi
type(int_pointer), dimension(:), allocatable tagncontfi
Definition tri7box.F:505
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
tri7box::if_adhfi
type(int_pointer), dimension(:), allocatable if_adhfi
Definition tri7box.F:440
tri7box::t2main_sms_fi
type(int_pointer2), dimension(:), allocatable t2main_sms_fi
Definition tri7box.F:558
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339
tri7box::daancfie
type(real_pointer2), dimension(:), allocatable daancfie
Definition tri7box.F:459
tri7box::msfie
type(real_pointer), dimension(:), allocatable msfie
Definition tri7box.F:449
tri7box::itafi
type(int_pointer), dimension(:), allocatable itafi
Definition tri7box.F:440
tri7box::penfiae
type(real_pointer2), dimension(:), allocatable penfiae
Definition tri7box.F:459
read_db
subroutine read_db(a, n)
Definition read_db.F:90
spmd_fiadd20f_pon
subroutine spmd_fiadd20f_pon(output, nb, len, bufr, nsv, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, ftheskyi, nlg, h3d_data)
Definition spmd_i7tool.F:2012
spmd_rnumcd
subroutine spmd_rnumcd(cand_n, renum, ii_stok, nin, nsn, nsnfiold, nsnrold)
Definition spmd_i7tool.F:162
putdpdaanc
subroutine putdpdaanc(daanc6, buf, iresp, inc)
Definition spmd_i7tool.F:7413
intcontp
subroutine intcontp(n, isky, nsnfi, isizenv, nsnfitot, len)
Definition spmd_i7tool.F:6247
getdpdaanc
subroutine getdpdaanc(daanc6, buf, iresp, inc)
Definition spmd_i7tool.F:7375
spmd_rnumcd10
subroutine spmd_rnumcd10(cand_n, renum, ii_stok, nin, nsn, nsnfiold, nsnrold)
Definition spmd_i7tool.F:239
sorti7t
subroutine sorti7t(n, isky, fskyi, ftheskyi, condnskyi, nfskyi)
Definition spmd_i7tool.F:5917
addcomi20
subroutine addcomi20(nsnfi, nsvfi, isizenv, leni20)
Definition spmd_i7tool.F:6299
sorti7
subroutine sorti7(n, isky, fskyi, ftheskyi, nfskyi)
Definition spmd_i7tool.F:5755
spmd_fiadd20e_poff
subroutine spmd_fiadd20e_poff(output, nb, len, bufr, ixlins, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, daanc6, nlg, alphak, h3d_data)
Definition spmd_i7tool.F:1484
spmd_savefi
subroutine spmd_savefi(ipari, iflag, intbuf_tab, nsensor, sensor_tab, parameters)
Definition spmd_i7tool.F:5134
spmd_fiadd20_poff
subroutine spmd_fiadd20_poff(output, nb, len, bufr, nsv, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, daanc6, fthe, nlg, alphak, h3d_data)
Definition spmd_i7tool.F:1214
spmd_rnumcd11
subroutine spmd_rnumcd11(cand_n, renum, ii_stok, nin, nrts, nsnfiold, nsnrold, addcm, chaine, cand_m, nsn4, nrtm)
Definition spmd_i7tool.F:387
sorti11t
subroutine sorti11t(n, isky, fskyi, ftheskyi, nfskyi)
Definition spmd_i7tool.F:6551
sorti11
subroutine sorti11(n, isky, fskyi, nfskyi)
Definition spmd_i7tool.F:6343
spmd_rnumcd20
subroutine spmd_rnumcd20(cand_n, renum, ii_stok, nin, nsn, nsnfiold, nsnrold)
Definition spmd_i7tool.F:85
conversion11
subroutine conversion11(xrem, xrem_dp, irem, siz, len)
Definition spmd_i7tool.F:7205
mpp_init
subroutine mpp_init(ipari, isendto, ircvfrom, intlist, nbintc, isizxv, ilenxv, iad_elem, i2size, itask, islen7, irlen7, islen11, irlen11, igrbric, nme17, islen17, irlen17, irlen7t, islen7t, lindidel, lbufidel, irlen20, islen20, irlen20t, islen20t, nbint20, irlen20e, islen20e, fr_rby, fr_rby6, npby, irbkin_l, nrbykin_l, kindrby, nsensor, sensor_tab, lbufidel24, intbuf_tab, sort_comm, need_comm_int25_solid_erosion, comm_int25_solid_erosion)
Definition spmd_i7tool.F:2881
spmd_oldnumcd
subroutine spmd_oldnumcd(renum, oldnum, nsnr, nsnrold, intheat, idt_therm, nodadt_therm)
Definition spmd_i7tool.F:38
spmd_fiadd17_poff
subroutine spmd_fiadd17_poff(output, nb, len, bufr, nelems, a, stifn, fcont, ixs, ixs16, frots, h3d_data)
Definition spmd_i7tool.F:989
sorti20
subroutine sorti20(n, isky, fskyi, nfskyi)
Definition spmd_i7tool.F:6092
spmd_fiadd_pon
subroutine spmd_fiadd_pon(output, nb, len, bufr, nsv, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, ftheskyi, condnskyi, h3d_data, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, intcarea, fsav, parameters, nodadt_therm)
Definition spmd_i7tool.F:1800
sorti17
subroutine sorti17(n, isky, fskyi)
Definition spmd_i7tool.F:7005
spmd_rnum25
subroutine spmd_rnum25(renum, nin, nsn, nsnfiold, nsnrold)
Definition spmd_i7tool.F:322
spmd_initfi
subroutine spmd_initfi(ipari, iflag, h3d_data, parameters, idt_therm, intheat)
Definition spmd_i7tool.F:3412
sortint
subroutine sortint(n, isky, index)
Definition spmd_i7tool.F:5685
spmd_fiadd11_pon
subroutine spmd_fiadd11_pon(output, nb, len, bufr, irects, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, intth, ftheskyi, condnskyi, h3d_data, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, nodadt_therm)
Definition spmd_i7tool.F:2207
spmd_fiadd17_pon
subroutine spmd_fiadd17_pon(output, nb, len, bufr, nelems, fskyi, isky, fcont, ixs, ixs16, h3d_data)
Definition spmd_i7tool.F:2766
upgrade_rem_2ry
subroutine upgrade_rem_2ry(ipari, count_remslv, count_remslve, nodadt_therm)
Definition spmd_i7tool.F:7249
spmd_fiadd11_poff
subroutine spmd_fiadd11_poff(output, nb, len, bufr, irects, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, intth, fthe, condn, h3d_data, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, nodadt_therm)
Definition spmd_i7tool.F:684
conversion7
subroutine conversion7(xrem, xrem_dp, irem, siz, len)
Definition spmd_i7tool.F:7167
spmd_fiadd20fe_pon
subroutine spmd_fiadd20fe_pon(output, nb, len, bufr, irects, fskyi, isky, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, nlg, h3d_data)
Definition spmd_i7tool.F:2546
putdpzero
subroutine putdpzero(zz, buf, iresp, inc)
Definition spmd_i7tool.F:7088
adddp
subroutine adddp(daanc6, daanc6l, len)
Definition spmd_i7tool.F:7130
spmd_fiadd_poff
subroutine spmd_fiadd_poff(output, nb, len, bufr, nsv, a, stifn, viscn, ibc, isecin, noint, ibag, icodt, secfcum, nstrf, icontact, fcont, inacti, iadm, intth, fthe, condn, h3d_data, multi_fvm, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, intcarea, fsav, parameters, nodadt_therm)
Definition spmd_i7tool.F:484
sorti11tt
subroutine sorti11tt(n, isky, fskyi, ftheskyi, condnskyi, nfskyi)
Definition spmd_i7tool.F:6772
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57
spmd_split_comm
subroutine spmd_split_comm(isactive, comm_local)
Definition spmd_split_comm.F:33
spmd_split_comm_inter
subroutine spmd_split_comm_inter(intbuf_tab, nbintc, intlist, ipari, isendto, ircvfrom, sort_comm, need_comm_int25_solid_erosion, comm_int25_solid_erosion)
Definition spmd_split_comm_inter.F:37
spmd_split_comm_joint
subroutine spmd_split_comm_joint()
Definition spmd_split_comm_joint.F:33
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
arret
subroutine arret(nn)
Definition arret.F:86
h3d_mod::h3d_database
Definition h3d_mod.F:438
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
write_r_c
void write_r_c(float *w, int *len)
Definition write_routines.c:519
read_i_c
void read_i_c(int *w, int *len)
Definition write_routines.c:805
read_r_c
void read_r_c(float *w, int *len)
Definition write_routines.c:756