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