OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_exch2_a_pon.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_exch2_a_pon ../engine/source/mpi/forces/spmd_exch2_a_pon.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| reallocate_i_skyline ../engine/source/system/reallocate_skyline.F
29!|| spmd_exchi_a_pon ../engine/source/mpi/forces/spmd_exchi_a_pon.F
30!||--- uses -----------------------------------------------------
31!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
32!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
33!|| h3d_mod ../engine/share/modules/h3d_mod.F
34!|| heat_mod ../engine/share/modules/heat_mod.f
35!|| interfaces_mod ../common_source/modules/interfaces/interfaces_mod.F90
36!|| plyxfem_mod ../engine/share/modules/plyxfem_mod.F
37!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
38!||====================================================================
39 SUBROUTINE spmd_exch2_a_pon(INTERFACES,
40 1 IAD_ELEM,FR_ELEM,ADDCNE,PROCNE,FR_NBCC,
41 2 SIZE ,LENR ,LENS ,FSKY ,FSKYV ,
42 3 FSKYM ,IFSUBM ,SIZI ,LENI ,IADSDP ,
43 4 IADRCP ,ISENDP ,IRECVP,FFSKY ,PROCNE_PXFEM,
44 5 FR_NBCC1,IADSDP_PXFEM,IADRCP_PXFEM, ISENDP_PXFEM,
45 6 IRECVP_PXFEM,LENR1 ,LENS1 ,IADSDP_CRK,IADRCP_CRK,
46 7 ISENDP_CRK,IRECVP_CRK, FSKYD,CRKNODIAD,CRKSKY,
47 8 FORNEQSKY,NFACNIT ,LENC ,FCONT ,H3D_DATA,
48 9 FNCONT ,FTCONT ,GLOB_THERM)
49C--------------------------------------
50 USE plyxfem_mod
51 USE crackxfem_mod
52 USE plyxfem_mod
53 USE heat_mod
54 USE h3d_mod
55 USE glob_therm_mod
56 USE interfaces_mod
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60 USE spmd_comm_world_mod, ONLY : spmd_comm_world
61#include "implicit_f.inc"
62C-----------------------------------------------------------------
63C M e s s a g e P a s s i n g
64C-----------------------------------------------
65#include "spmd.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "com01_c.inc"
70#include "com04_c.inc"
71#include "com_xfem1.inc"
72#include "task_c.inc"
73#include "parit_c.inc"
74#include "param_c.inc"
75#include "tabsiz_c.inc"
76#include "sphcom.inc"
77#include "scr18_c.inc"
78#include "scr14_c.inc"
79#include "intstamp_c.inc"
80C-----------------------------------------------
81C D u m m y A r g u m e n t s
82C-----------------------------------------------
83 TYPE(interfaces_) :: INTERFACES
84 INTEGER IAD_ELEM(2,*),FR_ELEM(*),FR_NBCC(2,*),
85 . ADDCNE(*), PROCNE(*),
86 . IADSDP(*), IADRCP(*), ISENDP(*), IRECVP(*),
87 . SIZE ,SIZI, LENI ,LENR ,LENS, IFSUBM, LENR1 ,LENS1,
88 . PROCNE_PXFEM(*), FR_NBCC1(2,*),IADSDP_PXFEM(*),
89 . IADRCP_PXFEM(*), ISENDP_PXFEM(*),IRECVP_PXFEM(*),
90 . IADSDP_CRK(*),IADRCP_CRK(*),ISENDP_CRK(*),
91 . IRECVP_CRK(*),CRKNODIAD(*),NFACNIT,
92 . lenc
93 my_real
94 . fsky(8,lsky),fskyv(lsky,8),fskym(*),
95 . ffsky(3,lsky),fskyd(*),forneqsky(3*nfacnit,*)
96 my_real , INTENT(INOUT) :: fcont(3,numnod),fncont(3,numnod),
97 . ftcont(3,numnod)
98 TYPE(xfem_sky_), DIMENSION(*) :: CRKSKY
99 TYPE(H3D_DATABASE) :: H3D_DATA
100 TYPE(GLOB_THERM_) ,INTENT(IN) :: GLOB_THERM
101C-----------------------------------------------
102C L o c a l V a r i a b l e s
103C-----------------------------------------------
104#ifdef MPI
105 INTEGER MSGTYP,I,NOD,LOC_PROC,IERROR,INDEX, NISKYF, N, IDEB,
106 . SIZ,J,K,L,NB_NOD,CC,NBIRECV, II, JJ, NN, IPT, MSGOFF,
107 . iad_recv(nspmd+1),
108 . status(mpi_status_size),
109 . req_r(nspmd),req_s(nspmd),irindex(nspmd),
110 . nbi,nbirct,nbisdt,l0,nbircp(nspmd),nbisdp(nspmd),
111 . lskyi_old,sisky_old
112
113 INTEGER, DIMENSION(:), ALLOCATABLE :: ISKYFT,ISKYF,ITAGX,ADSKYI
114 my_real, DIMENSION(:), ALLOCATABLE :: rbuf,sbuf, fskyt,ftheskyif,
115 . condnskyif
116 my_real, DIMENSION(:,:), ALLOCATABLE :: fskyif
117 my_real, DIMENSION(:,:), ALLOCATABLE :: fskyif_pxfem
118
119 DATA msgoff/169/
120C-----------------------------------------------
121C S o u r c e L i n e s
122C-----------------------------------------------
123
124
125
126C === Allocate local arrays
127 ALLOCATE(iskyf(nisky))
128 ALLOCATE(iskyft(nisky))
129 ALLOCATE(itagx(numnod))
130 ALLOCATE(adskyi(0:numnod+1))
131
132 ALLOCATE(rbuf(size*lenr + 4*nplymax*lenr1 +
133 . (17*nlevmax+1)*lenr1+ nspmd + 3*nfacnit*lenr+lenc))
134
135 ALLOCATE(fskyif(nfskyi,nisky))
136 ALLOCATE(fskyt(nisky))
137
138 IF(glob_therm%INTHEAT /= 0) THEN
139 ALLOCATE(ftheskyif(nisky))
140 ALLOCATE(condnskyif(nisky))
141 ELSE
142 ALLOCATE(ftheskyif(1))
143 ALLOCATE(condnskyif(1))
144 ENDIF
145
146 IF( intplyxfem > 0) THEN
147 ALLOCATE(fskyif_pxfem(5,nisky))
148 ELSE
149 ALLOCATE(fskyif_pxfem(5,1))
150 ENDIF
151
152C=======================================================================
153
154
155! NISKYF = 0
156 loc_proc = ispmd + 1
157C
158 niskyf = 0
159 nbirecv = 0
160 l = 1
161 iad_recv(1) = 1
162 DO i = 1, nspmd
163 nbisdp(i)=0
164 nbircp(i) = 0
165 IF(iad_elem(1,i+1)-iad_elem(1,i)>0) THEN
166 siz = size*fr_nbcc(2,i)+1
167 IF(iplyxfem > 0) siz = siz + 4*nplymax*fr_nbcc1(2,i)
168 IF(icrack3d > 0) siz = siz +
169 . (17*nlevmax+1)*fr_nbcc1(2,i)
170 siz = siz + 3*nfacnit*fr_nbcc(2,i) !NITSCHE METHOD
171 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0)
172 . siz = siz + 3*(iad_elem(1,i+1)-iad_elem(1,i)) !Output max contact forces
173 IF(h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0)
174 . siz = siz + 6*(iad_elem(1,i+1)-iad_elem(1,i)) !Output max contact pressure
175 msgtyp = msgoff
176 nbirecv = nbirecv + 1
177 irindex(nbirecv) = i
178 CALL mpi_irecv(
179 s rbuf(l),siz,real,it_spmd(i),msgtyp,
180 g spmd_comm_world,req_r(nbirecv),ierror)
181 l = l + siz
182 ENDIF
183 iad_recv(i+1) = l
184 ENDDO
185C
186C Pre Traitement interfaces
187C
188 IF(nisky/=0) THEN
189 DO i = 1, numnod
190 itagx(i) = 0
191 ENDDO
192 DO i = 1, nisky
193 itagx(interfaces%PON%ISKY(i)) = -1
194 ENDDO
195 DO i = 1, nspmd
196 IF(iad_elem(1,i+1)-iad_elem(1,i)>0) THEN
197 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
198 nod = fr_elem(j)
199 IF(itagx(nod)==-1)THEN
200 itagx(nod) = 1
201 ENDIF
202 ENDDO
203 ENDIF
204 ENDDO
205C NISKYF : forces d'interfaces frontiere a echanger
206 niskyf = 0
207C
208 IF(intplyxfem == 0) THEN
209 IF(glob_therm%INTHEAT == 0 ) THEN
210 IF(nfskyi==4) THEN
211 DO i = 1, nisky
212 IF(itagx(interfaces%PON%ISKY(i))==1)THEN
213 niskyf=niskyf+1
214 iskyf(niskyf) = interfaces%PON%ISKY(i)
215 fskyif(1,niskyf) = interfaces%PON%FSKYI(i,1)
216 fskyif(2,niskyf) = interfaces%PON%FSKYI(i,2)
217 fskyif(3,niskyf) = interfaces%PON%FSKYI(i,3)
218 fskyif(4,niskyf) = interfaces%PON%FSKYI(i,4)
219 ENDIF
220 ENDDO
221 ELSE
222 DO i = 1, nisky
223 IF(itagx(interfaces%PON%ISKY(i))==1)THEN
224 niskyf=niskyf+1
225 iskyf(niskyf) = interfaces%PON%ISKY(i)
226 fskyif(1,niskyf) = interfaces%PON%FSKYI(i,1)
227 fskyif(2,niskyf) = interfaces%PON%FSKYI(i,2)
228 fskyif(3,niskyf) = interfaces%PON%FSKYI(i,3)
229 fskyif(4,niskyf) = interfaces%PON%FSKYI(i,4)
230 fskyif(5,niskyf) = interfaces%PON%FSKYI(i,5)
231 ENDIF
232 ENDDO
233 ENDIF
234C + la t hermique
235 ELSE
236 IF(glob_therm%NODADT_THERM == 1) THEN
237 IF(nfskyi==4) THEN
238 DO i = 1, nisky
239 IF(itagx(interfaces%PON%ISKY(i))==1)THEN
240 niskyf=niskyf+1
241 iskyf(niskyf) = interfaces%PON%ISKY(i)
242 fskyif(1,niskyf) = interfaces%PON%FSKYI(i,1)
243 fskyif(2,niskyf) = interfaces%PON%FSKYI(i,2)
244 fskyif(3,niskyf) = interfaces%PON%FSKYI(i,3)
245 fskyif(4,niskyf) = interfaces%PON%FSKYI(i,4)
246 ftheskyif(niskyf) = ftheskyi(i)
247 condnskyif(niskyf) = condnskyi(i)
248 ENDIF
249 ENDDO
250 ELSE
251 DO i = 1, nisky
252 IF(itagx(interfaces%PON%ISKY(i))==1)THEN
253 niskyf=niskyf+1
254 iskyf(niskyf) = interfaces%PON%ISKY(i)
255 fskyif(1,niskyf) = interfaces%PON%FSKYI(i,1)
256 fskyif(2,niskyf) = interfaces%PON%FSKYI(i,2)
257 fskyif(3,niskyf) = interfaces%PON%FSKYI(i,3)
258 fskyif(4,niskyf) = interfaces%PON%FSKYI(i,4)
259 fskyif(5,niskyf) = interfaces%PON%FSKYI(i,5)
260 ftheskyif(niskyf) = ftheskyi(i)
261 condnskyif(niskyf) = condnskyi(i)
262 ENDIF
263 ENDDO
264 ENDIF
265 ELSE
266 IF(nfskyi==4) THEN
267 DO i = 1, nisky
268 IF(itagx(interfaces%PON%ISKY(i))==1)THEN
269 niskyf=niskyf+1
270 iskyf(niskyf) = interfaces%PON%ISKY(i)
271 fskyif(1,niskyf) = interfaces%PON%FSKYI(i,1)
272 fskyif(2,niskyf) = interfaces%PON%FSKYI(i,2)
273 fskyif(3,niskyf) = interfaces%PON%FSKYI(i,3)
274 fskyif(4,niskyf) = interfaces%PON%FSKYI(i,4)
275 ftheskyif(niskyf) = ftheskyi(i)
276 ENDIF
277 ENDDO
278 ELSE
279 DO i = 1, nisky
280 IF(itagx(interfaces%PON%ISKY(i))==1)THEN
281 niskyf=niskyf+1
282 iskyf(niskyf) = interfaces%PON%ISKY(i)
283 fskyif(1,niskyf) = interfaces%PON%FSKYI(i,1)
284 fskyif(2,niskyf) = interfaces%PON%FSKYI(i,2)
285 fskyif(3,niskyf) = interfaces%PON%FSKYI(i,3)
286 fskyif(4,niskyf) = interfaces%PON%FSKYI(i,4)
287 fskyif(5,niskyf) = interfaces%PON%FSKYI(i,5)
288 ftheskyif(niskyf) = ftheskyi(i)
289 ENDIF
290 ENDDO
291 ENDIF
292 ENDIF
293 ENDIF ! INTHEAT
294C! + Plyxfem + type 24
295 ELSE
296 IF(glob_therm%INTHEAT == 0 ) THEN
297 IF(nfskyi==4) THEN
298 DO i = 1, nisky
299 IF(itagx(interfaces%PON%ISKY(i))==1)THEN
300 niskyf=niskyf+1
301 iskyf(niskyf) = interfaces%PON%ISKY(i)
302 fskyif(1,niskyf) = interfaces%PON%FSKYI(i,1)
303 fskyif(2,niskyf) = interfaces%PON%FSKYI(i,2)
304 fskyif(3,niskyf) = interfaces%PON%FSKYI(i,3)
305 fskyif(4,niskyf) = interfaces%PON%FSKYI(i,4)
306C
307 fskyif_pxfem(1,niskyf) = plyskyi%FSKYI(i,1)
308 fskyif_pxfem(2,niskyf) = plyskyi%FSKYI(i,2)
309 fskyif_pxfem(3,niskyf) = plyskyi%FSKYI(i,3)
310 fskyif_pxfem(4,niskyf) = plyskyi%FSKYI(i,4)
311 fskyif_pxfem(5,niskyf) = plyskyi%FSKYI(i,5)
312 ENDIF
313 ENDDO
314 ELSE
315 DO i = 1, nisky
316 IF(itagx(interfaces%PON%ISKY(i))==1)THEN
317 niskyf=niskyf+1
318 iskyf(niskyf) = interfaces%PON%ISKY(i)
319 fskyif(1,niskyf) =interfaces%PON%FSKYI(i,1)
320 fskyif(2,niskyf) =interfaces%PON%FSKYI(i,2)
321 fskyif(3,niskyf) =interfaces%PON%FSKYI(i,3)
322 fskyif(4,niskyf) =interfaces%PON%FSKYI(i,4)
323 fskyif(5,niskyf) =interfaces%PON%FSKYI(i,5)
324C
325 fskyif_pxfem(1,niskyf) = plyskyi%FSKYI(i,1)
326 fskyif_pxfem(2,niskyf) = plyskyi%FSKYI(i,2)
327 fskyif_pxfem(3,niskyf) = plyskyi%FSKYI(i,3)
328 fskyif_pxfem(4,niskyf) = plyskyi%FSKYI(i,4)
329 fskyif_pxfem(5,niskyf) = plyskyi%FSKYI(i,5)
330 ENDIF
331 ENDDO
332 ENDIF
333C + la t hermique
334 ELSE
335 IF(glob_therm%NODADT_THERM == 1) THEN
336 IF(nfskyi==4) THEN
337 DO i = 1, nisky
338 IF(itagx(interfaces%PON%ISKY(i))==1)THEN
339 niskyf=niskyf+1
340 iskyf(niskyf) = interfaces%PON%ISKY(i)
341 fskyif(1,niskyf) =interfaces%PON%FSKYI(i,1)
342 fskyif(2,niskyf) =interfaces%PON%FSKYI(i,2)
343 fskyif(3,niskyf) =interfaces%PON%FSKYI(i,3)
344 fskyif(4,niskyf) =interfaces%PON%FSKYI(i,4)
345 ftheskyif(niskyf) = ftheskyi(i)
346 condnskyif(niskyf) = condnskyi(i)
347C
348 fskyif_pxfem(1,niskyf) = plyskyi%FSKYI(i,1)
349 fskyif_pxfem(2,niskyf) = plyskyi%FSKYI(i,2)
350 fskyif_pxfem(3,niskyf) = plyskyi%FSKYI(i,3)
351 fskyif_pxfem(4,niskyf) = plyskyi%FSKYI(i,4)
352 fskyif_pxfem(5,niskyf) = plyskyi%FSKYI(i,5)
353 ENDIF
354 ENDDO
355 ELSE
356 DO i = 1, nisky
357 IF(itagx(interfaces%PON%ISKY(i))==1)THEN
358 niskyf=niskyf+1
359 iskyf(niskyf) = interfaces%PON%ISKY(i)
360 fskyif(1,niskyf) =interfaces%PON%FSKYI(i,1)
361 fskyif(2,niskyf) =interfaces%PON%FSKYI(i,2)
362 fskyif(3,niskyf) =interfaces%PON%FSKYI(i,3)
363 fskyif(4,niskyf) =interfaces%PON%FSKYI(i,4)
364 fskyif(5,niskyf) =interfaces%PON%FSKYI(i,5)
365 ftheskyif(niskyf) = ftheskyi(i)
366 condnskyif(niskyf) = condnskyi(i)
367C
368 fskyif_pxfem(1,niskyf) = plyskyi%FSKYI(i,1)
369 fskyif_pxfem(2,niskyf) = plyskyi%FSKYI(i,2)
370 fskyif_pxfem(3,niskyf) = plyskyi%FSKYI(i,3)
371 fskyif_pxfem(4,niskyf) = plyskyi%FSKYI(i,4)
372 fskyif_pxfem(5,niskyf) = plyskyi%FSKYI(i,5)
373 ENDIF
374 ENDDO
375 ENDIF
376 ELSE
377 IF(nfskyi==4) THEN
378 DO i = 1, nisky
379 IF(itagx(interfaces%PON%ISKY(i))==1)THEN
380 niskyf=niskyf+1
381 iskyf(niskyf) = interfaces%PON%ISKY(i)
382 fskyif(1,niskyf) =interfaces%PON%FSKYI(i,1)
383 fskyif(2,niskyf) =interfaces%PON%FSKYI(i,2)
384 fskyif(3,niskyf) =interfaces%PON%FSKYI(i,3)
385 fskyif(4,niskyf) =interfaces%PON%FSKYI(i,4)
386 ftheskyif(niskyf) = ftheskyi(i)
387C
388 fskyif_pxfem(1,niskyf) = plyskyi%FSKYI(i,1)
389 fskyif_pxfem(2,niskyf) = plyskyi%FSKYI(i,2)
390 fskyif_pxfem(3,niskyf) = plyskyi%FSKYI(i,3)
391 fskyif_pxfem(4,niskyf) = plyskyi%FSKYI(i,4)
392 fskyif_pxfem(5,niskyf) = plyskyi%FSKYI(i,5)
393 ENDIF
394 ENDDO
395 ELSE
396 DO i = 1, nisky
397 IF(itagx(interfaces%PON%ISKY(i))==1)THEN
398 niskyf=niskyf+1
399 iskyf(niskyf) = interfaces%PON%ISKY(i)
400 fskyif(1,niskyf) = interfaces%PON%FSKYI(i,1)
401 fskyif(2,niskyf) = interfaces%PON%FSKYI(i,2)
402 fskyif(3,niskyf) = interfaces%PON%FSKYI(i,3)
403 fskyif(4,niskyf) = interfaces%PON%FSKYI(i,4)
404 fskyif(5,niskyf) = interfaces%PON%FSKYI(i,5)
405 ftheskyif(niskyf) = ftheskyi(i)
406C
407 fskyif_pxfem(1,niskyf) = plyskyi%FSKYI(i,1)
408 fskyif_pxfem(2,niskyf) = plyskyi%FSKYI(i,2)
409 fskyif_pxfem(3,niskyf) = plyskyi%FSKYI(i,3)
410 fskyif_pxfem(4,niskyf) = plyskyi%FSKYI(i,4)
411 fskyif_pxfem(5,niskyf) = plyskyi%FSKYI(i,5)
412 ENDIF
413 ENDDO
414 ENDIF
415 ENDIF
416 ENDIF ! INTHEAT
417 ENDIF
418C
419C tri suivant no noeud
420 DO n = 1, numnod+1
421 adskyi(n) = 0
422 ENDDO
423C
424 DO i=1,niskyf
425 n = iskyf(i)+1
426 adskyi(n) = adskyi(n)+1
427 ENDDO
428C
429 adskyi(0) = 1
430 adskyi(1) = 1
431 DO n = 1, numnod
432 nn = n+1
433 adskyi(nn) = adskyi(nn) + adskyi(n)
434 ENDDO
435C
436 DO i=1,niskyf
437 n = iskyf(i)
438 j = adskyi(n)
439 iskyft(j)=iskyf(i)
440 iskyf(i) = j
441 adskyi(n) = adskyi(n) + 1
442 ENDDO
443C
444 DO l = 1, nfskyi
445 DO i=1,niskyf
446 j = iskyf(i)
447 fskyt(j) = fskyif(l,i)
448 ENDDO
449 DO i=1,niskyf
450 fskyif(l,i) = fskyt(i)
451 ENDDO
452 ENDDO
453 IF(intplyxfem > 0) THEN
454 DO l = 1, 5
455 DO i=1,niskyf
456 j = iskyf(i)
457 fskyt(j) = fskyif_pxfem(l,i)
458 ENDDO
459 DO i=1,niskyf
460 fskyif_pxfem(l,i) = fskyt(i)
461 ENDDO
462 ENDDO
463 ENDIF
464C
465 IF(glob_therm%INTHEAT > 0 ) THEN
466 DO i=1,niskyf
467 j = iskyf(i)
468 fskyt(j) = ftheskyif(i)
469 ENDDO
470 DO i=1,niskyf
471 ftheskyif(i) = fskyt(i)
472 ENDDO
473 IF (glob_therm%NODADT_THERM == 1 )THEN
474 DO i=1,niskyf
475 j = iskyf(i)
476 fskyt(j) = condnskyif(i)
477 ENDDO
478 DO i=1,niskyf
479 condnskyif(i) = fskyt(i)
480 ENDDO
481 ENDIF
482 ENDIF
483C
484! DO L = 1, NFSKYI
485! DO I=1,NISKYF
486! J = ISKYF(I)
487! FSKYT(J) = FSKYIF(L,I)
488! ENDDO
489! DO I=1,NISKYF
490! FSKYIF(L,I) = FSKYT(I)
491! ENDDO
492! ENDDO
493!C
494C
495 DO i=1,niskyf
496 iskyf(i) = iskyft(i)
497 ENDDO
498 ELSE
499C tag a 0 de itagx sur noeud frontiere
500 DO i = 1, nspmd
501 IF(iad_elem(1,i+1)-iad_elem(1,i)>0) THEN
502 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
503 nod = fr_elem(j)
504 itagx(nod) = 0
505 ENDDO
506 ENDIF
507 ENDDO
508 ENDIF
509
510 DEALLOCATE(iskyf)
511 DEALLOCATE(fskyt)
512 DEALLOCATE(iskyft)
513 ALLOCATE(sbuf(size*lens + 4*nplymax*lens1 +
514 . (17*nlevmax+1)*lens1+ nspmd+ 3*nfacnit*lens+lenc))
515
516
517C
518 nbisdt = 0
519 l = 1
520
521 DO i=1,nspmd
522
523 IF(iad_elem(1,i+1)-iad_elem(1,i)>0) THEN
524 l0 = l
525C
526C a optimiser
527 IF(sol2sph_flag/=0)THEN
528#include "vectorize.inc"
529 DO j=iadsdp(i),iadsdp(i+1)-1
530 cc = isendp(j)
531 sbuf(l+size-1) = fskyd(cc)
532 l = l + SIZE
533 END DO
534 l = l0
535 END IF
536
537 IF(ialelag == 0) THEN
538 IF(glob_therm%ITHERM_FE == 0 .AND. glob_therm%INTHEAT == 0 ) THEN
539 IF(ifsubm==0)THEN
540C prepar ation envoi a proc I partie fixe (elem)
541 IF(ivector==1) THEN
542 ELSE
543C ivec tor = 0
544C cas 3D seul possible
545 IF(iroddl/=0) THEN
546#include "vectorize.inc"
547 DO j=iadsdp(i),iadsdp(i+1)-1
548 cc = isendp(j)
549 sbuf(l) = fsky(1,cc)
550 sbuf(l+1) = fsky(2,cc)
551 sbuf(l+2) = fsky(3,cc)
552 sbuf(l+3) = fsky(4,cc)
553 sbuf(l+4) = fsky(5,cc)
554 sbuf(l+5) = fsky(6,cc)
555 sbuf(l+6) = fsky(7,cc)
556 sbuf(l+7) = fsky(8,cc)
557 l = l + SIZE
558 END DO
559 ELSE
560#include "vectorize.inc"
561 DO j=iadsdp(i),iadsdp(i+1)-1
562 cc = isendp(j)
563 sbuf(l) = fsky(1,cc)
564 sbuf(l+1) = fsky(2,cc)
565 sbuf(l+2) = fsky(3,cc)
566 sbuf(l+3) = fsky(7,cc)
567 l = l + SIZE
568 END DO
569 ENDIF
570 ENDIF
571 ELSE
572C
573C code A LE-CFD Avec Parit/ON MASSE
574C
575C
576C prepar ation envoi partie fixe (elem) a proc I
577C
578 IF(ivector==1) THEN
579 ELSE
580C ivec tor = 0
581C cas 3D seul possible
582 IF(iroddl/=0) THEN
583#include "vectorize.inc"
584 DO j=iadsdp(i),iadsdp(i+1)-1
585 cc = isendp(j)
586 sbuf(l) = fsky(1,cc)
587 sbuf(l+1) = fsky(2,cc)
588 sbuf(l+2) = fsky(3,cc)
589 sbuf(l+3) = fsky(4,cc)
590 sbuf(l+4) = fsky(5,cc)
591 sbuf(l+5) = fsky(6,cc)
592 sbuf(l+6) = fsky(7,cc)
593 sbuf(l+7) = fsky(8,cc)
594 sbuf(l+8) = fskym(cc)
595 l = l + SIZE
596 END DO
597 ELSE
598#include "vectorize.inc"
599 DO j=iadsdp(i),iadsdp(i+1)-1
600 cc = isendp(j)
601 sbuf(l) = fsky(1,cc)
602 sbuf(l+1) = fsky(2,cc)
603 sbuf(l+2) = fsky(3,cc)
604 sbuf(l+3) = fsky(7,cc)
605 sbuf(l+4) = fskym(cc)
606 l = l + SIZE
607 END DO
608 ENDIF
609 ENDIF
610 ENDIF
611C
612C --- plus la thermque
613C
614 ELSE
615 IF(ifsubm==0)THEN
616C prepar ation envoi a proc I partie fixe (elem)
617 IF(ivector==1) THEN
618 ELSE
619 IF(glob_therm%NODADT_THERM == 1) THEN
620 IF(iroddl/=0) THEN
621#include "vectorize.inc"
622 DO j=iadsdp(i),iadsdp(i+1)-1
623 cc = isendp(j)
624 sbuf(l) = fsky(1,cc)
625 sbuf(l+1) = fsky(2,cc)
626 sbuf(l+2) = fsky(3,cc)
627 sbuf(l+3) = fsky(4,cc)
628 sbuf(l+4) = fsky(5,cc)
629 sbuf(l+5) = fsky(6,cc)
630 sbuf(l+6) = fsky(7,cc)
631 sbuf(l+7) = fsky(8,cc)
632 sbuf(l+8) = fthesky(cc)
633 sbuf(l+9) = condnsky(cc)
634 l = l + SIZE
635 END DO
636 ELSE
637#include "vectorize.inc"
638 DO j=iadsdp(i),iadsdp(i+1)-1
639 cc = isendp(j)
640 sbuf(l) = fsky(1,cc)
641 sbuf(l+1) = fsky(2,cc)
642 sbuf(l+2) = fsky(3,cc)
643 sbuf(l+3) = fsky(7,cc)
644 sbuf(l+4) = fthesky(cc)
645 sbuf(l+5) = condnsky(cc)
646 l = l + SIZE
647 END DO
648 ENDIF
649 ELSE
650 IF(iroddl/=0) THEN
651#include "vectorize.inc"
652 DO j=iadsdp(i),iadsdp(i+1)-1
653 cc = isendp(j)
654 sbuf(l) = fsky(1,cc)
655 sbuf(l+1) = fsky(2,cc)
656 sbuf(l+2) = fsky(3,cc)
657 sbuf(l+3) = fsky(4,cc)
658 sbuf(l+4) = fsky(5,cc)
659 sbuf(l+5) = fsky(6,cc)
660 sbuf(l+6) = fsky(7,cc)
661 sbuf(l+7) = fsky(8,cc)
662 sbuf(l+8) = fthesky(cc)
663 l = l + SIZE
664 END DO
665 ELSE
666#include "vectorize.inc"
667 DO j=iadsdp(i),iadsdp(i+1)-1
668 cc = isendp(j)
669 sbuf(l) = fsky(1,cc)
670 sbuf(l+1) = fsky(2,cc)
671 sbuf(l+2) = fsky(3,cc)
672 sbuf(l+3) = fsky(7,cc)
673 sbuf(l+4) = fthesky(cc)
674 l = l + SIZE
675 END DO
676 ENDIF
677 ENDIF
678 ENDIF
679 ELSE
680C
681C code A LE-CFD Avec Parit/ON MASSE
682C
683C
684C prepar ation envoi partie fixe (elem) a proc I
685C
686 IF(ivector==1) THEN
687 ELSE
688 IF(glob_therm%NODADT_THERM == 1) THEN
689 IF(iroddl/=0) THEN
690#include "vectorize.inc"
691 DO j=iadsdp(i),iadsdp(i+1)-1
692 cc = isendp(j)
693 sbuf(l) = fsky(1,cc)
694 sbuf(l+1) = fsky(2,cc)
695 sbuf(l+2) = fsky(3,cc)
696 sbuf(l+3) = fsky(4,cc)
697 sbuf(l+4) = fsky(5,cc)
698 sbuf(l+5) = fsky(6,cc)
699 sbuf(l+6) = fsky(7,cc)
700 sbuf(l+7) = fsky(8,cc)
701 sbuf(l+8) = fskym(cc)
702 sbuf(l+9) = fthesky(cc)
703 sbuf(l+10)= condnsky(cc)
704 l = l + SIZE
705 END DO
706 ELSE
707#include "vectorize.inc"
708 DO j=iadsdp(i),iadsdp(i+1)-1
709 cc = isendp(j)
710 sbuf(l) = fsky(1,cc)
711 sbuf(l+1) = fsky(2,cc)
712 sbuf(l+2) = fsky(3,cc)
713 sbuf(l+3) = fsky(7,cc)
714 sbuf(l+4) = fskym(cc)
715 sbuf(l+5) = fthesky(cc)
716 sbuf(l+6) = condnsky(cc)
717 l = l + SIZE
718 END DO
719 ENDIF
720 ELSE
721 IF(iroddl/=0) THEN
722#include "vectorize.inc"
723 DO j=iadsdp(i),iadsdp(i+1)-1
724 cc = isendp(j)
725 sbuf(l) = fsky(1,cc)
726 sbuf(l+1) = fsky(2,cc)
727 sbuf(l+2) = fsky(3,cc)
728 sbuf(l+3) = fsky(4,cc)
729 sbuf(l+4) = fsky(5,cc)
730 sbuf(l+5) = fsky(6,cc)
731 sbuf(l+6) = fsky(7,cc)
732 sbuf(l+7) = fsky(8,cc)
733 sbuf(l+8) = fskym(cc)
734 sbuf(l+9) = fthesky(cc)
735 l = l + SIZE
736 END DO
737 ELSE
738#include "vectorize.inc"
739 DO j=iadsdp(i),iadsdp(i+1)-1
740 cc = isendp(j)
741 sbuf(l) = fsky(1,cc)
742 sbuf(l+1) = fsky(2,cc)
743 sbuf(l+2) = fsky(3,cc)
744 sbuf(l+3) = fsky(7,cc)
745 sbuf(l+4) = fskym(cc)
746 sbuf(l+5) = fthesky(cc)
747 l = l + SIZE
748 END DO
749 ENDIF
750 ENDIF
751 ENDIF
752 ENDIF
753 ENDIF
754 ELSE
755C
756C + ale + lag
757C
758 IF(glob_therm%ITHERM_FE == 0 .AND. glob_therm%INTHEAT == 0 ) THEN
759 IF(ifsubm==0)THEN
760C prepar ation envoi a proc I partie fixe (elem)
761 IF(ivector==1) THEN
762 ELSE
763C ivec tor = 0
764C cas 3D seul possible
765 IF(iroddl/=0) THEN
766#include "vectorize.inc"
767 DO j=iadsdp(i),iadsdp(i+1)-1
768 cc = isendp(j)
769 sbuf(l) = fsky(1,cc)
770 sbuf(l+1) = fsky(2,cc)
771 sbuf(l+2) = fsky(3,cc)
772 sbuf(l+3) = fsky(4,cc)
773 sbuf(l+4) = fsky(5,cc)
774 sbuf(l+5) = fsky(6,cc)
775 sbuf(l+6) = fsky(7,cc)
776 sbuf(l+7) = fsky(8,cc)
777C
778 sbuf(l+8) = ffsky(1,cc)
779 sbuf(l+9) = ffsky(2,cc)
780 sbuf(l+10) = ffsky(3,cc)
781 sbuf(l+11) = fskym(cc)
782 l = l + SIZE
783 END DO
784 ELSE
785#include "vectorize.inc"
786 DO j=iadsdp(i),iadsdp(i+1)-1
787 cc = isendp(j)
788 sbuf(l) = fsky(1,cc)
789 sbuf(l+1) = fsky(2,cc)
790 sbuf(l+2) = fsky(3,cc)
791 sbuf(l+3) = fsky(7,cc)
792C
793 sbuf(l+4) = ffsky(1,cc)
794 sbuf(l+5) = ffsky(2,cc)
795 sbuf(l+6) = ffsky(3,cc)
796 sbuf(l+7) = fskym(cc)
797 l = l + SIZE
798 END DO
799 ENDIF
800 ENDIF
801 ELSE
802C
803C code A LE-CFD Avec Parit/ON MASSE
804C
805C
806C prepar ation envoi partie fixe (elem) a proc I
807C
808 IF(ivector==1) THEN
809 ELSE
810C ivec tor = 0
811C cas 3D seul possible
812 IF(iroddl/=0) THEN
813#include "vectorize.inc"
814 DO j=iadsdp(i),iadsdp(i+1)-1
815 cc = isendp(j)
816 sbuf(l) = fsky(1,cc)
817 sbuf(l+1) = fsky(2,cc)
818 sbuf(l+2) = fsky(3,cc)
819 sbuf(l+3) = fsky(4,cc)
820 sbuf(l+4) = fsky(5,cc)
821 sbuf(l+5) = fsky(6,cc)
822 sbuf(l+6) = fsky(7,cc)
823 sbuf(l+7) = fsky(8,cc)
824 sbuf(l+8) = fskym(cc)
825C
826 sbuf(l+9) = ffsky(1,cc)
827 sbuf(l+10) = ffsky(2,cc)
828 sbuf(l+11) = ffsky(3,cc)
829 l = l + SIZE
830 END DO
831 ELSE
832#include "vectorize.inc"
833 DO j=iadsdp(i),iadsdp(i+1)-1
834 cc = isendp(j)
835 sbuf(l) = fsky(1,cc)
836 sbuf(l+1) = fsky(2,cc)
837 sbuf(l+2) = fsky(3,cc)
838 sbuf(l+3) = fsky(7,cc)
839 sbuf(l+4) = fskym(cc)
840C
841 sbuf(l+5) = ffsky(1,cc)
842 sbuf(l+6) = ffsky(2,cc)
843 sbuf(l+7) = ffsky(3,cc)
844 l = l + SIZE
845 END DO
846 ENDIF
847 ENDIF
848 ENDIF
849C
850C --- plus la thermque
851C
852 ELSE
853 IF(ifsubm==0)THEN
854C prepar ation envoi a proc I partie fixe (elem)
855 IF(ivector==1) THEN
856 ELSE
857 IF(glob_therm%NODADT_THERM == 1) THEN
858 IF(iroddl/=0) THEN
859#include "vectorize.inc"
860 DO j=iadsdp(i),iadsdp(i+1)-1
861 cc = isendp(j)
862 sbuf(l) = fsky(1,cc)
863 sbuf(l+1) = fsky(2,cc)
864 sbuf(l+2) = fsky(3,cc)
865 sbuf(l+3) = fsky(4,cc)
866 sbuf(l+4) = fsky(5,cc)
867 sbuf(l+5) = fsky(6,cc)
868 sbuf(l+6) = fsky(7,cc)
869 sbuf(l+7) = fsky(8,cc)
870 sbuf(l+8) = fthesky(cc)
871C
872 sbuf(l+9) = ffsky(1,cc)
873 sbuf(l+10) = ffsky(2,cc)
874 sbuf(l+11) = ffsky(3,cc)
875 sbuf(l+12) = fskym(cc)
876C
877 sbuf(l+13) = condnsky(cc)
878 l = l + SIZE
879 END DO
880 ELSE
881#include "vectorize.inc"
882 DO j=iadsdp(i),iadsdp(i+1)-1
883 cc = isendp(j)
884 sbuf(l) = fsky(1,cc)
885 sbuf(l+1) = fsky(2,cc)
886 sbuf(l+2) = fsky(3,cc)
887 sbuf(l+3) = fsky(7,cc)
888 sbuf(l+4) = fthesky(cc)
889C
890 sbuf(l+5) = ffsky(1,cc)
891 sbuf(l+6) = ffsky(2,cc)
892 sbuf(l+7) = ffsky(3,cc)
893 sbuf(l+8) = fskym(cc)
894C
895 sbuf(l+9) = condnsky(cc)
896 l = l + SIZE
897 END DO
898 ENDIF
899 ELSE
900 IF(iroddl/=0) THEN
901#include "vectorize.inc"
902 DO j=iadsdp(i),iadsdp(i+1)-1
903 cc = isendp(j)
904 sbuf(l) = fsky(1,cc)
905 sbuf(l+1) = fsky(2,cc)
906 sbuf(l+2) = fsky(3,cc)
907 sbuf(l+3) = fsky(4,cc)
908 sbuf(l+4) = fsky(5,cc)
909 sbuf(l+5) = fsky(6,cc)
910 sbuf(l+6) = fsky(7,cc)
911 sbuf(l+7) = fsky(8,cc)
912 sbuf(l+8) = fthesky(cc)
913C
914 sbuf(l+9) = ffsky(1,cc)
915 sbuf(l+10) = ffsky(2,cc)
916 sbuf(l+11) = ffsky(3,cc)
917 sbuf(l+12) = fskym(cc)
918 l = l + SIZE
919 END DO
920 ELSE
921#include "vectorize.inc"
922 DO j=iadsdp(i),iadsdp(i+1)-1
923 cc = isendp(j)
924 sbuf(l) = fsky(1,cc)
925 sbuf(l+1) = fsky(2,cc)
926 sbuf(l+2) = fsky(3,cc)
927 sbuf(l+3) = fsky(7,cc)
928 sbuf(l+4) = fthesky(cc)
929C
930 sbuf(l+5) = ffsky(1,cc)
931 sbuf(l+6) = ffsky(2,cc)
932 sbuf(l+7) = ffsky(3,cc)
933 sbuf(l+8) = fskym(cc)
934 l = l + SIZE
935 END DO
936 ENDIF
937 ENDIF
938 ENDIF
939 ELSE
940C
941C code A LE-CFD Avec Parit/ON MASSE
942C
943C
944C prepar ation envoi partie fixe (elem) a proc I
945C
946 IF(ivector==1) THEN
947 ELSE
948 IF(glob_therm%NODADT_THERM == 1) THEN
949 IF(iroddl/=0) THEN
950#include "vectorize.inc"
951 DO j=iadsdp(i),iadsdp(i+1)-1
952 cc = isendp(j)
953 sbuf(l) = fsky(1,cc)
954 sbuf(l+1) = fsky(2,cc)
955 sbuf(l+2) = fsky(3,cc)
956 sbuf(l+3) = fsky(4,cc)
957 sbuf(l+4) = fsky(5,cc)
958 sbuf(l+5) = fsky(6,cc)
959 sbuf(l+6) = fsky(7,cc)
960 sbuf(l+7) = fsky(8,cc)
961 sbuf(l+8) = fskym(cc)
962 sbuf(l+9) = fthesky(cc)
963C
964 sbuf(l+10) = ffsky(1,cc)
965 sbuf(l+11) = ffsky(2,cc)
966 sbuf(l+12) = ffsky(3,cc)
967C
968 sbuf(l+13) = condnsky(cc)
969 l = l + SIZE
970 END DO
971 ELSE
972#include "vectorize.inc"
973 DO j=iadsdp(i),iadsdp(i+1)-1
974 cc = isendp(j)
975 sbuf(l) = fsky(1,cc)
976 sbuf(l+1) = fsky(2,cc)
977 sbuf(l+2) = fsky(3,cc)
978 sbuf(l+3) = fsky(7,cc)
979 sbuf(l+4) = fskym(cc)
980 sbuf(l+5) = fthesky(cc)
981C
982 sbuf(l+6) = ffsky(1,cc)
983 sbuf(l+7) = ffsky(2,cc)
984 sbuf(l+8) = ffsky(3,cc)
985C
986 sbuf(l+9) = condnsky(cc)
987 l = l + SIZE
988 END DO
989 ENDIF
990 ELSE
991 IF(iroddl/=0) THEN
992#include "vectorize.inc"
993 DO j=iadsdp(i),iadsdp(i+1)-1
994 cc = isendp(j)
995 sbuf(l) = fsky(1,cc)
996 sbuf(l+1) = fsky(2,cc)
997 sbuf(l+2) = fsky(3,cc)
998 sbuf(l+3) = fsky(4,cc)
999 sbuf(l+4) = fsky(5,cc)
1000 sbuf(l+5) = fsky(6,cc)
1001 sbuf(l+6) = fsky(7,cc)
1002 sbuf(l+7) = fsky(8,cc)
1003 sbuf(l+8) = fskym(cc)
1004 sbuf(l+9) = fthesky(cc)
1005C
1006 sbuf(l+10) = ffsky(1,cc)
1007 sbuf(l+11) = ffsky(2,cc)
1008 sbuf(l+12) = ffsky(3,cc)
1009 l = l + SIZE
1010 END DO
1011 ELSE
1012#include "vectorize.inc"
1013 DO j=iadsdp(i),iadsdp(i+1)-1
1014 cc = isendp(j)
1015 sbuf(l) = fsky(1,cc)
1016 sbuf(l+1) = fsky(2,cc)
1017 sbuf(l+2) = fsky(3,cc)
1018 sbuf(l+3) = fsky(7,cc)
1019 sbuf(l+4) = fskym(cc)
1020 sbuf(l+5) = fthesky(cc)
1021C
1022 sbuf(l+6) = ffsky(1,cc)
1023 sbuf(l+7) = ffsky(2,cc)
1024 sbuf(l+8) = ffsky(3,cc)
1025 l = l + SIZE
1026 END DO
1027 ENDIF
1028 ENDIF
1029 ENDIF
1030 ENDIF
1031 ENDIF
1032C
1033 ENDIF ! ialelag
1034C
1035 IF(iplyxfem > 0) THEN
1036#include "vectorize.inc"
1037 DO j=iadsdp_pxfem(i),iadsdp_pxfem(i+1)-1
1038 cc = isendp_pxfem(j)
1039 DO ipt = 1, nplymax
1040 sbuf(l) = plysky(ipt)% FSKY(1,cc)
1041 sbuf(l+1) = plysky(ipt)% FSKY(2,cc)
1042 sbuf(l+2) = plysky(ipt)% FSKY(3,cc)
1043 sbuf(l+3) = plysky(ipt)% FSKY(4,cc)
1044 l = l + 4
1045 END DO
1046 ENDDO
1047 ENDIF
1048C
1049 IF(icrack3d > 0)THEN
1050#include "vectorize.inc"
1051 DO j=iadsdp_crk(i),iadsdp_crk(i+1)-1
1052 cc = isendp_crk(j)
1053 DO ipt = 1, nlevmax
1054 sbuf(l) = crksky(ipt)% FSKY(1,cc)
1055 sbuf(l+1) = crksky(ipt)% FSKY(2,cc)
1056 sbuf(l+2) = crksky(ipt)% FSKY(3,cc)
1057 sbuf(l+3) = crksky(ipt)% FSKY(4,cc)
1058 sbuf(l+4) = crksky(ipt)% FSKY(5,cc)
1059 sbuf(l+5) = crksky(ipt)% FSKY(6,cc)
1060 sbuf(l+6) = crklvset(ipt)%ENR0(1,cc)
1061 sbuf(l+7) = crklvset(ipt)%ENR0(2,cc)
1062c
1063 sbuf(l+8) = crkavx(ipt)%X(1,cc)
1064 sbuf(l+9) = crkavx(ipt)%X(2,cc)
1065 sbuf(l+10) = crkavx(ipt)%X(3,cc)
1066 sbuf(l+11) = crkavx(ipt)%V(1,cc)
1067 sbuf(l+12) = crkavx(ipt)%V(2,cc)
1068 sbuf(l+13) = crkavx(ipt)%V(3,cc)
1069 sbuf(l+14) = crkavx(ipt)%VR(1,cc)
1070 sbuf(l+15) = crkavx(ipt)%VR(2,cc)
1071 sbuf(l+16) = crkavx(ipt)%VR(3,cc)
1072c
1073 l = l + 17
1074 END DO
1075 sbuf(l) = crknodiad(cc)
1076 l = l + 1
1077 ENDDO
1078 ENDIF
1079C
1080 IF (nitsche > 0 ) THEN
1081#include "vectorize.inc"
1082 DO j=iadsdp(i),iadsdp(i+1)-1
1083 cc = isendp(j)
1084 DO k=1,nfacnit
1085 sbuf(l+3*(k-1)) = forneqsky(3*(k-1)+1,cc)
1086 sbuf(l+3*(k-1)+1) = forneqsky(3*(k-1)+2,cc)
1087 sbuf(l+3*(k-1)+2) = forneqsky(3*(k-1)+3,cc)
1088 ENDDO
1089 l = l + 3*nfacnit
1090 END DO
1091 ENDIF
1092
1093C --- /CONT/MAX output
1094 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) THEN
1095#include "vectorize.inc"
1096 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1097 nod = fr_elem(j)
1098 sbuf(l ) = fcont(1,nod)
1099 sbuf(l+1) = fcont(2,nod)
1100 sbuf(l+2) = fcont(3,nod)
1101 l = l + 3
1102 END DO
1103
1104 ENDIF
1105
1106C --- /PCONT/MAX output
1107 IF(h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0) THEN
1108#include "vectorize.inc"
1109 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1110 nod = fr_elem(j)
1111 sbuf(l ) = fncont(1,nod)
1112 sbuf(l+1) = fncont(2,nod)
1113 sbuf(l+2) = fncont(3,nod)
1114 sbuf(l+3) = ftcont(1,nod)
1115 sbuf(l+4) = ftcont(2,nod)
1116 sbuf(l+5) = ftcont(3,nod)
1117 l = l + 6
1118 END DO
1119 ENDIF
1120
1121C partie interface : calcul et envoi du nb de noeuds a envoyer
1122 nbi = 0
1123 IF(niskyf/=0) THEN
1124#include "vectorize.inc"
1125 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1126 nod = fr_elem(j)
1127 IF(itagx(nod)==1)THEN
1128 nbi = nbi + adskyi(nod)-adskyi(nod-1)
1129 END IF
1130 END DO
1131 END IF
1132 sbuf(l)=nbi
1133 l = l + 1
1134 nbisdp(i)=nbi
1135 nbisdt = nbisdt + nbi
1136C
1137C echange messages
1138C
1139 IF(iplyxfem ==0 . and. icrack3d == 0)THEN
1140 siz = (iadsdp(i+1)-iadsdp(i))*size+1
1141 ELSE IF(iplyxfem > 0)THEN
1142 siz = (iadsdp(i+1)-iadsdp(i))*SIZE +
1143 . (iadsdp_pxfem(i+1)-iadsdp_pxfem(i))*4*nplymax + 1
1144 ELSE IF(icrack3d > 0)THEN
1145 siz = (iadsdp(i+1)-iadsdp(i))*SIZE +
1146 . (iadsdp_crk(i+1)-iadsdp_crk(i))*
1147 . (17*nlevmax+1) + 1
1148 ENDIF
1149 siz = siz + (iadsdp(i+1)-iadsdp(i))*3*nfacnit
1150 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0)
1151 . siz = siz + 3*(iad_elem(1,i+1)-iad_elem(1,i)) !Output max contact forces
1152 IF(h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0)
1153 . siz = siz + 6*(iad_elem(1,i+1)-iad_elem(1,i)) !Output max contact forces
1154C
1155 msgtyp = msgoff
1156 CALL mpi_isend(
1157 s sbuf(l0),siz,real,it_spmd(i),msgtyp,
1158 g spmd_comm_world,req_s(i),ierror)
1159 ENDIF
1160 ENDDO
1161C
1162C decompactage
1163C
1164 nbirct = 0
1165 DO ii=1,nbirecv
1166 CALL mpi_waitany(nbirecv,req_r,index,status,ierror)
1167 i = irindex(index)
1168 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
1169C
1170 l = iad_recv(i)
1171C
1172C a optimiser
1173 IF(sol2sph_flag/=0)THEN
1174#include "vectorize.inc"
1175 DO j=iadrcp(i),iadrcp(i+1)-1
1176 cc = irecvp(j)
1177 fskyd(cc) = rbuf(l+size-1)
1178 l = l + SIZE
1179 END DO
1180 l = iad_recv(i)
1181 END IF
1182C
1183 IF(ialelag == 0) THEN
1184 IF(glob_therm%ITHERM_FE == 0 .AND. glob_therm%INTHEAT == 0 ) THEN
1185 IF(ifsubm==0)THEN
1186 IF(ivector==1) THEN
1187 ELSE ! ivector = 0
1188C cas 3D seul possible
1189 IF(iroddl/=0) THEN
1190#include "vectorize.inc"
1191 DO j=iadrcp(i),iadrcp(i+1)-1
1192 cc = irecvp(j)
1193 fsky(1,cc) = rbuf(l)
1194 fsky(2,cc) = rbuf(l+1)
1195 fsky(3,cc) = rbuf(l+2)
1196 fsky(4,cc) = rbuf(l+3)
1197 fsky(5,cc) = rbuf(l+4)
1198 fsky(6,cc) = rbuf(l+5)
1199 fsky(7,cc) = rbuf(l+6)
1200 fsky(8,cc) = rbuf(l+7)
1201 l = l + SIZE
1202 END DO
1203 ELSE
1204#include "vectorize.inc"
1205 DO j=iadrcp(i),iadrcp(i+1)-1
1206 cc = irecvp(j)
1207 fsky(1,cc) = rbuf(l)
1208 fsky(2,cc) = rbuf(l+1)
1209 fsky(3,cc) = rbuf(l+2)
1210 fsky(7,cc) = rbuf(l+3)
1211 l = l + SIZE
1212 END DO
1213 ENDIF
1214 ENDIF
1215 ELSE
1216 IF(ivector==1) THEN
1217 ELSE ! ivector = 0
1218C cas 3D seul possible
1219 IF(iroddl/=0) THEN
1220#include "vectorize.inc"
1221 DO j=iadrcp(i),iadrcp(i+1)-1
1222 cc = irecvp(j)
1223 fsky(1,cc) = rbuf(l)
1224 fsky(2,cc) = rbuf(l+1)
1225 fsky(3,cc) = rbuf(l+2)
1226 fsky(4,cc) = rbuf(l+3)
1227 fsky(5,cc) = rbuf(l+4)
1228 fsky(6,cc) = rbuf(l+5)
1229 fsky(7,cc) = rbuf(l+6)
1230 fsky(8,cc) = rbuf(l+7)
1231 fskym(cc) = rbuf(l+8)
1232 l = l + SIZE
1233 END DO
1234 ELSE
1235#include "vectorize.inc"
1236 DO j=iadrcp(i),iadrcp(i+1)-1
1237 cc = irecvp(j)
1238 fsky(1,cc) = rbuf(l)
1239 fsky(2,cc) = rbuf(l+1)
1240 fsky(3,cc) = rbuf(l+2)
1241 fsky(7,cc) = rbuf(l+3)
1242 fskym(cc) = rbuf(l+4)
1243 l = l + SIZE
1244 END DO
1245 ENDIF
1246 ENDIF
1247 ENDIF
1248C
1249C--- plus la thermique
1250C
1251 ELSE
1252 IF(ifsubm==0)THEN
1253 IF(ivector==1) THEN
1254 ELSE ! ivector = 0
1255C cas 3D seul possible
1256 IF(glob_therm%NODADT_THERM == 1) THEN
1257 IF(iroddl/=0) THEN
1258#include "vectorize.inc"
1259 DO j=iadrcp(i),iadrcp(i+1)-1
1260 cc = irecvp(j)
1261 fsky(1,cc) = rbuf(l)
1262 fsky(2,cc) = rbuf(l+1)
1263 fsky(3,cc) = rbuf(l+2)
1264 fsky(4,cc) = rbuf(l+3)
1265 fsky(5,cc) = rbuf(l+4)
1266 fsky(6,cc) = rbuf(l+5)
1267 fsky(7,cc) = rbuf(l+6)
1268 fsky(8,cc) = rbuf(l+7)
1269 fthesky(cc) = rbuf(l+8)
1270 condnsky(cc)= rbuf(l+9)
1271 l = l + SIZE
1272 END DO
1273 ELSE
1274#include "vectorize.inc"
1275 DO j=iadrcp(i),iadrcp(i+1)-1
1276 cc = irecvp(j)
1277 fsky(1,cc) = rbuf(l)
1278 fsky(2,cc) = rbuf(l+1)
1279 fsky(3,cc) = rbuf(l+2)
1280 fsky(7,cc) = rbuf(l+3)
1281 fthesky(cc) = rbuf(l+4)
1282 condnsky(cc)= rbuf(l+5)
1283 l = l + SIZE
1284 END DO
1285 ENDIF
1286 ELSE
1287 IF(iroddl/=0) THEN
1288#include "vectorize.inc"
1289 DO j=iadrcp(i),iadrcp(i+1)-1
1290 cc = irecvp(j)
1291 fsky(1,cc) = rbuf(l)
1292 fsky(2,cc) = rbuf(l+1)
1293 fsky(3,cc) = rbuf(l+2)
1294 fsky(4,cc) = rbuf(l+3)
1295 fsky(5,cc) = rbuf(l+4)
1296 fsky(6,cc) = rbuf(l+5)
1297 fsky(7,cc) = rbuf(l+6)
1298 fsky(8,cc) = rbuf(l+7)
1299 fthesky(cc) = rbuf(l+8)
1300 l = l + SIZE
1301 END DO
1302 ELSE
1303#include "vectorize.inc"
1304 DO j=iadrcp(i),iadrcp(i+1)-1
1305 cc = irecvp(j)
1306 fsky(1,cc) = rbuf(l)
1307 fsky(2,cc) = rbuf(l+1)
1308 fsky(3,cc) = rbuf(l+2)
1309 fsky(7,cc) = rbuf(l+3)
1310 fthesky(cc) = rbuf(l+4)
1311 l = l + SIZE
1312 END DO
1313 ENDIF
1314 ENDIF
1315 ENDIF
1316 ELSE
1317 IF(ivector==1) THEN
1318 ELSE ! ivector = 0
1319C cas 3D seul possible
1320 IF(glob_therm%NODADT_THERM == 1) THEN
1321 IF(iroddl/=0) THEN
1322#include "vectorize.inc"
1323 DO j=iadrcp(i),iadrcp(i+1)-1
1324 cc = irecvp(j)
1325 fsky(1,cc) = rbuf(l)
1326 fsky(2,cc) = rbuf(l+1)
1327 fsky(3,cc) = rbuf(l+2)
1328 fsky(4,cc) = rbuf(l+3)
1329 fsky(5,cc) = rbuf(l+4)
1330 fsky(6,cc) = rbuf(l+5)
1331 fsky(7,cc) = rbuf(l+6)
1332 fsky(8,cc) = rbuf(l+7)
1333 fskym(cc) = rbuf(l+8)
1334 fthesky(cc) = rbuf(l+9)
1335 condnsky(cc)= rbuf(l+10)
1336 l = l + SIZE
1337 END DO
1338 ELSE
1339#include "vectorize.inc"
1340 DO j=iadrcp(i),iadrcp(i+1)-1
1341 cc = irecvp(j)
1342 fsky(1,cc) = rbuf(l)
1343 fsky(2,cc) = rbuf(l+1)
1344 fsky(3,cc) = rbuf(l+2)
1345 fsky(7,cc) = rbuf(l+3)
1346 fskym(cc) = rbuf(l+4)
1347 fthesky(cc) = rbuf(l+5)
1348 condnsky(cc)= rbuf(l+6)
1349 l = l + SIZE
1350 END DO
1351 ENDIF
1352 ELSE
1353 IF(iroddl/=0) THEN
1354#include "vectorize.inc"
1355 DO j=iadrcp(i),iadrcp(i+1)-1
1356 cc = irecvp(j)
1357 fsky(1,cc) = rbuf(l)
1358 fsky(2,cc) = rbuf(l+1)
1359 fsky(3,cc) = rbuf(l+2)
1360 fsky(4,cc) = rbuf(l+3)
1361 fsky(5,cc) = rbuf(l+4)
1362 fsky(6,cc) = rbuf(l+5)
1363 fsky(7,cc) = rbuf(l+6)
1364 fsky(8,cc) = rbuf(l+7)
1365 fskym(cc) = rbuf(l+8)
1366 fthesky(cc) = rbuf(l+9)
1367 l = l + SIZE
1368 END DO
1369 ELSE
1370#include "vectorize.inc"
1371 DO j=iadrcp(i),iadrcp(i+1)-1
1372 cc = irecvp(j)
1373 fsky(1,cc) = rbuf(l)
1374 fsky(2,cc) = rbuf(l+1)
1375 fsky(3,cc) = rbuf(l+2)
1376 fsky(7,cc) = rbuf(l+3)
1377 fskym(cc) = rbuf(l+4)
1378 fthesky(cc) = rbuf(l+5)
1379 l = l + SIZE
1380 END DO
1381 ENDIF
1382 ENDIF
1383 ENDIF
1384 ENDIF
1385 ENDIF
1386 ELSE
1387C
1388C ialelag > 0
1389C
1390 IF(glob_therm%ITHERM_FE == 0 .AND. glob_therm%INTHEAT == 0 ) THEN
1391 IF(ifsubm==0)THEN
1392 IF(ivector==1) THEN
1393 ELSE ! ivector = 0
1394C cas 3D seul possible
1395 IF(iroddl/=0) THEN
1396#include "vectorize.inc"
1397 DO j=iadrcp(i),iadrcp(i+1)-1
1398 cc = irecvp(j)
1399 fsky(1,cc) = rbuf(l)
1400 fsky(2,cc) = rbuf(l+1)
1401 fsky(3,cc) = rbuf(l+2)
1402 fsky(4,cc) = rbuf(l+3)
1403 fsky(5,cc) = rbuf(l+4)
1404 fsky(6,cc) = rbuf(l+5)
1405 fsky(7,cc) = rbuf(l+6)
1406 fsky(8,cc) = rbuf(l+7)
1407C
1408 ffsky(1,cc) = rbuf(l+8)
1409 ffsky(2,cc) = rbuf(l+9)
1410 ffsky(3,cc) = rbuf(l+10)
1411 fskym(cc) = rbuf(l+11)
1412 l = l + SIZE
1413 END DO
1414 ELSE
1415#include "vectorize.inc"
1416 DO j=iadrcp(i),iadrcp(i+1)-1
1417 cc = irecvp(j)
1418 fsky(1,cc) = rbuf(l)
1419 fsky(2,cc) = rbuf(l+1)
1420 fsky(3,cc) = rbuf(l+2)
1421 fsky(7,cc) = rbuf(l+3)
1422C
1423 ffsky(1,cc) = rbuf(l+4)
1424 ffsky(2,cc) = rbuf(l+5)
1425 ffsky(3,cc) = rbuf(l+6)
1426 fskym(cc) = rbuf(l+7)
1427 l = l + SIZE
1428 END DO
1429 ENDIF
1430 ENDIF
1431 ELSE
1432 IF(ivector==1) THEN
1433 ELSE ! ivector = 0
1434C cas 3D seul possible
1435 IF(iroddl/=0) THEN
1436#include "vectorize.inc"
1437 DO j=iadrcp(i),iadrcp(i+1)-1
1438 cc = irecvp(j)
1439 fsky(1,cc) = rbuf(l)
1440 fsky(2,cc) = rbuf(l+1)
1441 fsky(3,cc) = rbuf(l+2)
1442 fsky(4,cc) = rbuf(l+3)
1443 fsky(5,cc) = rbuf(l+4)
1444 fsky(6,cc) = rbuf(l+5)
1445 fsky(7,cc) = rbuf(l+6)
1446 fsky(8,cc) = rbuf(l+7)
1447 fskym(cc) = rbuf(l+8)
1448C
1449 ffsky(1,cc) = rbuf(l+9)
1450 ffsky(2,cc) = rbuf(l+10)
1451 ffsky(3,cc) = rbuf(l+11)
1452 l = l + SIZE
1453 END DO
1454 ELSE
1455#include "vectorize.inc"
1456 DO j=iadrcp(i),iadrcp(i+1)-1
1457 cc = irecvp(j)
1458 fsky(1,cc) = rbuf(l)
1459 fsky(2,cc) = rbuf(l+1)
1460 fsky(3,cc) = rbuf(l+2)
1461 fsky(7,cc) = rbuf(l+3)
1462 fskym(cc) = rbuf(l+4)
1463C
1464 ffsky(1,cc) = rbuf(l+5)
1465 ffsky(2,cc) = rbuf(l+6)
1466 ffsky(3,cc) = rbuf(l+7)
1467 l = l + SIZE
1468 END DO
1469 ENDIF
1470 ENDIF
1471 ENDIF
1472C
1473C--- plus la thermique
1474C
1475 ELSE
1476 IF(ifsubm==0)THEN
1477 IF(ivector==1) THEN
1478 ELSE ! ivector = 0
1479C cas 3D seul possible
1480 IF(glob_therm%NODADT_THERM == 1) THEN
1481 IF(iroddl/=0) THEN
1482#include "vectorize.inc"
1483 DO j=iadrcp(i),iadrcp(i+1)-1
1484 cc = irecvp(j)
1485 fsky(1,cc) = rbuf(l)
1486 fsky(2,cc) = rbuf(l+1)
1487 fsky(3,cc) = rbuf(l+2)
1488 fsky(4,cc) = rbuf(l+3)
1489 fsky(5,cc) = rbuf(l+4)
1490 fsky(6,cc) = rbuf(l+5)
1491 fsky(7,cc) = rbuf(l+6)
1492 fsky(8,cc) = rbuf(l+7)
1493 fthesky(cc) = rbuf(l+8)
1494C
1495 ffsky(1,cc) = rbuf(l+9)
1496 ffsky(2,cc) = rbuf(l+10)
1497 ffsky(3,cc) = rbuf(l+11)
1498 fskym(cc) = rbuf(l+12)
1499C
1500 condnsky(cc) = rbuf(l+13)
1501 l = l + SIZE
1502 END DO
1503 ELSE
1504#include "vectorize.inc"
1505 DO j=iadrcp(i),iadrcp(i+1)-1
1506 cc = irecvp(j)
1507 fsky(1,cc) = rbuf(l)
1508 fsky(2,cc) = rbuf(l+1)
1509 fsky(3,cc) = rbuf(l+2)
1510 fsky(7,cc) = rbuf(l+3)
1511 fthesky(cc) = rbuf(l+4)
1512C
1513 ffsky(1,cc) = rbuf(l+5)
1514 ffsky(2,cc) = rbuf(l+6)
1515 ffsky(3,cc) = rbuf(l+7)
1516 fskym(cc) = rbuf(l+8)
1517C
1518 condnsky(cc) = rbuf(l+9)
1519 l = l + SIZE
1520 END DO
1521 ENDIF
1522 ELSE
1523 IF(iroddl/=0) THEN
1524#include "vectorize.inc"
1525 DO j=iadrcp(i),iadrcp(i+1)-1
1526 cc = irecvp(j)
1527 fsky(1,cc) = rbuf(l)
1528 fsky(2,cc) = rbuf(l+1)
1529 fsky(3,cc) = rbuf(l+2)
1530 fsky(4,cc) = rbuf(l+3)
1531 fsky(5,cc) = rbuf(l+4)
1532 fsky(6,cc) = rbuf(l+5)
1533 fsky(7,cc) = rbuf(l+6)
1534 fsky(8,cc) = rbuf(l+7)
1535 fthesky(cc) = rbuf(l+8)
1536C
1537 ffsky(1,cc) = rbuf(l+9)
1538 ffsky(2,cc) = rbuf(l+10)
1539 ffsky(3,cc) = rbuf(l+11)
1540 fskym(cc) = rbuf(l+12)
1541 l = l + SIZE
1542 END DO
1543 ELSE
1544#include "vectorize.inc"
1545 DO j=iadrcp(i),iadrcp(i+1)-1
1546 cc = irecvp(j)
1547 fsky(1,cc) = rbuf(l)
1548 fsky(2,cc) = rbuf(l+1)
1549 fsky(3,cc) = rbuf(l+2)
1550 fsky(7,cc) = rbuf(l+3)
1551 fthesky(cc) = rbuf(l+4)
1552C
1553 ffsky(1,cc) = rbuf(l+5)
1554 ffsky(2,cc) = rbuf(l+6)
1555 ffsky(3,cc) = rbuf(l+7)
1556 fskym(cc) = rbuf(l+8)
1557 l = l + SIZE
1558 END DO
1559 ENDIF
1560 ENDIF
1561 ENDIF
1562 ELSE
1563 IF(ivector==1) THEN
1564 ELSE ! ivector = 0
1565C cas 3D seul possible
1566 IF(glob_therm%NODADT_THERM == 1) THEN
1567 IF(iroddl/=0) THEN
1568#include "vectorize.inc"
1569 DO j=iadrcp(i),iadrcp(i+1)-1
1570 cc = irecvp(j)
1571 fsky(1,cc) = rbuf(l)
1572 fsky(2,cc) = rbuf(l+1)
1573 fsky(3,cc) = rbuf(l+2)
1574 fsky(4,cc) = rbuf(l+3)
1575 fsky(5,cc) = rbuf(l+4)
1576 fsky(6,cc) = rbuf(l+5)
1577 fsky(7,cc) = rbuf(l+6)
1578 fsky(8,cc) = rbuf(l+7)
1579 fskym(cc) = rbuf(l+8)
1580 fthesky(cc) = rbuf(l+9)
1581C
1582 ffsky(1,cc) = rbuf(l+10)
1583 ffsky(2,cc) = rbuf(l+11)
1584 ffsky(3,cc) = rbuf(l+12)
1585C
1586 condnsky(cc)= rbuf(l+13)
1587 l = l + SIZE
1588 END DO
1589 ELSE
1590#include "vectorize.inc"
1591 DO j=iadrcp(i),iadrcp(i+1)-1
1592 cc = irecvp(j)
1593 fsky(1,cc) = rbuf(l)
1594 fsky(2,cc) = rbuf(l+1)
1595 fsky(3,cc) = rbuf(l+2)
1596 fsky(7,cc) = rbuf(l+3)
1597 fskym(cc) = rbuf(l+4)
1598 fthesky(cc) = rbuf(l+5)
1599C
1600 ffsky(1,cc) = rbuf(l+6)
1601 ffsky(2,cc) = rbuf(l+7)
1602 ffsky(3,cc) = rbuf(l+8)
1603 fskym(cc) = rbuf(l+9)
1604C
1605 condnsky(cc)= rbuf(l+10)
1606 l = l + SIZE
1607 END DO
1608 ENDIF
1609 ELSE
1610 IF(iroddl/=0) THEN
1611#include "vectorize.inc"
1612 DO j=iadrcp(i),iadrcp(i+1)-1
1613 cc = irecvp(j)
1614 fsky(1,cc) = rbuf(l)
1615 fsky(2,cc) = rbuf(l+1)
1616 fsky(3,cc) = rbuf(l+2)
1617 fsky(4,cc) = rbuf(l+3)
1618 fsky(5,cc) = rbuf(l+4)
1619 fsky(6,cc) = rbuf(l+5)
1620 fsky(7,cc) = rbuf(l+6)
1621 fsky(8,cc) = rbuf(l+7)
1622 fskym(cc) = rbuf(l+8)
1623 fthesky(cc) = rbuf(l+9)
1624C
1625 ffsky(1,cc) = rbuf(l+10)
1626 ffsky(2,cc) = rbuf(l+11)
1627 ffsky(3,cc) = rbuf(l+12)
1628 l = l + SIZE
1629 END DO
1630 ELSE
1631#include "vectorize.inc"
1632 DO j=iadrcp(i),iadrcp(i+1)-1
1633 cc = irecvp(j)
1634 fsky(1,cc) = rbuf(l)
1635 fsky(2,cc) = rbuf(l+1)
1636 fsky(3,cc) = rbuf(l+2)
1637 fsky(7,cc) = rbuf(l+3)
1638 fskym(cc) = rbuf(l+4)
1639 fthesky(cc) = rbuf(l+5)
1640C
1641 ffsky(1,cc) = rbuf(l+6)
1642 ffsky(2,cc) = rbuf(l+7)
1643 ffsky(3,cc) = rbuf(l+8)
1644 fskym(cc) = rbuf(l+9)
1645 l = l + SIZE
1646 END DO
1647 ENDIF
1648 ENDIF
1649 ENDIF
1650 ENDIF
1651 ENDIF
1652 ENDIF ! IALELAG
1653C
1654 IF(iplyxfem > 0) THEN
1655#include "vectorize.inc"
1656 DO j=iadrcp_pxfem(i),iadrcp_pxfem(i+1)-1
1657 cc = irecvp_pxfem(j)
1658 DO ipt = 1,nplymax
1659 plysky(ipt)% FSKY(1,cc) = rbuf(l)
1660 plysky(ipt)% FSKY(2,cc) = rbuf(l+1)
1661 plysky(ipt)% FSKY(3,cc) = rbuf(l+2)
1662 plysky(ipt)% FSKY(4,cc) = rbuf(l+3)
1663 l = l + 4
1664 END DO
1665 END DO
1666 ENDIF
1667C
1668 IF(icrack3d > 0)THEN
1669#include "vectorize.inc"
1670 DO j=iadrcp_crk(i),iadrcp_crk(i+1)-1
1671 cc = irecvp_crk(j)
1672 DO ipt = 1,nlevmax
1673 crksky(ipt)% FSKY(1,cc) = rbuf(l)
1674 crksky(ipt)% FSKY(2,cc) = rbuf(l+1)
1675 crksky(ipt)% FSKY(3,cc) = rbuf(l+2)
1676 crksky(ipt)% FSKY(4,cc) = rbuf(l+3)
1677 crksky(ipt)% FSKY(5,cc) = rbuf(l+4)
1678 crksky(ipt)% FSKY(6,cc) = rbuf(l+5)
1679 crklvset(ipt)%ENR0(1,cc) = rbuf(l+6)
1680 crklvset(ipt)%ENR0(2,cc) = rbuf(l+7)
1681
1682 crkavx(ipt)%X(1,cc) = rbuf(l+8)
1683 crkavx(ipt)%X(2,cc) = rbuf(l+9)
1684 crkavx(ipt)%X(3,cc) = rbuf(l+10)
1685 crkavx(ipt)%V(1,cc) = rbuf(l+11)
1686 crkavx(ipt)%V(2,cc) = rbuf(l+12)
1687 crkavx(ipt)%V(3,cc) = rbuf(l+13)
1688 crkavx(ipt)%VR(1,cc) = rbuf(l+14)
1689 crkavx(ipt)%VR(2,cc) = rbuf(l+15)
1690 crkavx(ipt)%VR(3,cc) = rbuf(l+16)
1691
1692 l = l + 17
1693 END DO
1694 crknodiad(cc) = rbuf(l)
1695 l = l + 1
1696 END DO
1697 ENDIF
1698C
1699 IF (nitsche > 0 ) THEN
1700#include "vectorize.inc"
1701 DO j=iadrcp(i),iadrcp(i+1)-1
1702 cc = irecvp(j)
1703 DO k=1,nfacnit
1704 forneqsky(3*(k-1)+1,cc) = rbuf(l+3*(k-1))
1705 forneqsky(3*(k-1)+2,cc) = rbuf(l+3*(k-1)+1)
1706 forneqsky(3*(k-1)+3,cc) = rbuf(l+3*(k-1)+2)
1707 ENDDO
1708 l = l + 3*nfacnit
1709 END DO
1710 ENDIF
1711
1712C --- /CONT/MAX output
1713 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) THEN
1714#include "vectorize.inc"
1715 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1716 nod = fr_elem(j)
1717 fcont(1,nod) = fcont(1,nod) + rbuf(l)
1718 fcont(2,nod) = fcont(2,nod) + rbuf(l+1)
1719 fcont(3,nod) = fcont(3,nod) + rbuf(l+2)
1720 l = l + 3
1721 END DO
1722 ENDIF
1723
1724C --- /PCONT/MAX output
1725 IF(h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0) THEN
1726#include "vectorize.inc"
1727 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
1728 nod = fr_elem(j)
1729 fncont(1,nod) = fncont(1,nod) + rbuf(l)
1730 fncont(2,nod) = fncont(2,nod) + rbuf(l+1)
1731 fncont(3,nod) = fncont(3,nod) + rbuf(l+2)
1732 ftcont(1,nod) = ftcont(1,nod) + rbuf(l+3)
1733 ftcont(2,nod) = ftcont(2,nod) + rbuf(l+4)
1734 ftcont(3,nod) = ftcont(3,nod) + rbuf(l+5)
1735 l = l + 6
1736 END DO
1737 ENDIF
1738
1739C partie interface : recupere le nb de noeuds a recevoir
1740 nbi = nint(rbuf(l))
1741C L = L + 1
1742 nbirct = nbirct + nbi
1743 nbircp(i) = nbi
1744 END DO
1745
1746
1747C ----------------------------------------------------
1748C Check if ISKY & FSKYI are sufficiently allocate
1749C If not reallocate them
1750C ----------------------------------------------------
1751C NISKY : current counter stored stuff in ISKY & FSKYI
1752C SISKY - LSKYI : ISKY Size
1753C SFSKYI : FSKYI size (LSKYI*NFSKYI)
1754
1755 IF ( nisky+nbirct > sisky) THEN
1756 CALL reallocate_i_skyline(nbirct,2,glob_therm%INTHEAT,glob_therm%NODADT_THERM,interfaces%PON)
1757 ENDIF
1758C
1759C Traitement interface si concerne le proc
1760C
1761 IF(nbirct>0.OR.nbisdt>0) THEN
1762 CALL spmd_exchi_a_pon(
1763 1 iad_elem,fr_elem,sizi ,interfaces%PON%ISKY ,interfaces%PON%FSKYI ,
1764 2 fskyif ,itagx ,adskyi(0),nbirct,nbisdt,
1765 3 nbircp ,nbisdp ,ftheskyi, ftheskyif,condnskyi,
1766 4 condnskyif,fskyif_pxfem,glob_therm%INTHEAT,glob_therm%NODADT_THERM)
1767 END IF
1768C
1769C wait terminaison isend
1770C
1771 DO i = 1, nspmd
1772 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)
1773 . CALL mpi_wait(req_s(i),status,ierror)
1774 ENDDO
1775
1776 DEALLOCATE(rbuf)
1777 DEALLOCATE(sbuf)
1778 DEALLOCATE(fskyif)
1779 DEALLOCATE(ftheskyif)
1780 DEALLOCATE(condnskyif)
1781 DEALLOCATE(fskyif_pxfem)
1782 DEALLOCATE(itagx)
1783 DEALLOCATE(adskyi)
1784
1785
1786C
1787#endif
1788 RETURN
1789 END
1790C
1791
my_real
#define my_real
Definition cppsort.cpp:32
mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525
mpi_waitany
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)
Definition mpi.f:549
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
crackxfem_mod
Definition crackxfem_mod.F:121
crackxfem_mod::crkavx
type(xfem_avx_), dimension(:), allocatable crkavx
Definition crackxfem_mod.F:163
crackxfem_mod::crklvset
type(xfem_lvset_), dimension(:), allocatable crklvset
Definition crackxfem_mod.F:146
h3d_mod
Definition h3d_mod.F:308
heat_mod
Definition heat_mod.F:31
plyxfem_mod
Definition plyxfem_mod.F:31
plyxfem_mod::plysky
type(ply_data), dimension(:), allocatable plysky
Definition plyxfem_mod.F:91
plyxfem_mod::plyskyi
type(ply_data), allocatable plyskyi
Definition plyxfem_mod.F:92
reallocate_i_skyline
subroutine reallocate_i_skyline(new_count, call_id, intheat, nodadt_therm, pon)
Definition reallocate_skyline.F:39
spmd_exch2_a_pon
subroutine spmd_exch2_a_pon(interfaces, iad_elem, fr_elem, addcne, procne, fr_nbcc, size, lenr, lens, fsky, fskyv, fskym, ifsubm, sizi, leni, iadsdp, iadrcp, isendp, irecvp, ffsky, procne_pxfem, fr_nbcc1, iadsdp_pxfem, iadrcp_pxfem, isendp_pxfem, irecvp_pxfem, lenr1, lens1, iadsdp_crk, iadrcp_crk, isendp_crk, irecvp_crk, fskyd, crknodiad, crksky, forneqsky, nfacnit, lenc, fcont, h3d_data, fncont, ftcont, glob_therm)
Definition spmd_exch2_a_pon.F:49
spmd_exchi_a_pon
subroutine spmd_exchi_a_pon(iad_elem, fr_elem, sizi, isky, fskyi, fskyif, itagx, adskyi, nbirct, nbisdt, nbircp, nbisdp, ftheskyi, ftheskyif, condnskyi, condnskyif, fskyif_pxfem, intheat, nodadt_therm)
Definition spmd_exchi_a_pon.F:38
crackxfem_mod::xfem_sky_
Definition crackxfem_mod.F:148