OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_xfem.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/.
23c
24!||====================================================================
25!|| spmd_exch_crkvel ../engine/source/mpi/elements/spmd_xfem.F
26!||--- called by ------------------------------------------------------
27!|| resol ../engine/source/engine/resol.F
28!||--- calls -----------------------------------------------------
29!||--- uses -----------------------------------------------------
30!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
31!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.f90
32!||====================================================================
33 SUBROUTINE spmd_exch_crkvel(IAD_ELEM ,FR_ELEM ,INOD_CRK ,ITAB ,
34 . X ,V ,VR )
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE crackxfem_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42 USE spmd_comm_world_mod, ONLY : spmd_comm_world
43#include "implicit_f.inc"
44C-----------------------------------------------
45C M e s s a g e P a s s i n g
46C-----------------------------------------------
47#include "spmd.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com01_c.inc"
52#include "com_xfem1.inc"
53#include "task_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER IAD_ELEM(2,*),FR_ELEM(*),INOD_CRK(*),ITAB(*)
58 my_real x(*),v(*),vr(*)
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62#ifdef MPI
63 INTEGER MSGTYP,I,J,L1,L2,ILEV,ILAY,IXEL,IAD,KK,IL,IENR,EN0,ENR,
64 . nenr,siz,len1,len2,lenr,nnodx,nn,nsx,nct,nc,count,
65 . loc_proc,ierror,msgtyp1,msgtyp2,msgoff1,msgoff2
66 INTEGER STATUS(MPI_STATUS_SIZE),NODXSAV(NSPMD),
67 . req_r1(nspmd),req_r2(nspmd),req_s1(nspmd),req_s2(nspmd),
68 . iad_send1(nspmd+1),iad_send2(nspmd+1),
69 . iad_recv1(nspmd+1),iad_recv2(nspmd+1),nbsend
70 INTEGER, DIMENSION(:,:), ALLOCATABLE :: RBUFI,SBUFI
71 my_real, DIMENSION(:,:), ALLOCATABLE :: rbufr,sbufr
72c----
73 DATA msgoff1/241/
74 DATA msgoff2/242/
75C=======================================================================
76 loc_proc = ispmd + 1
77c
78! NENR = INT(IENRNOD/NLEVMAX)
79 nenr = ienrnod
80 lenr = iad_elem(1,nspmd+1) - iad_elem(1,1)
81 lenr = lenr * nxlaymax * nenr
82 ALLOCATE(rbufi(3,lenr))
83 ALLOCATE(sbufi(3,lenr))
84 ALLOCATE(rbufr(9,lenr))
85 ALLOCATE(sbufr(9,lenr))
86 rbufi = 0
87 sbufi = 0
88 rbufr = zero
89 sbufr = zero
90c
91 DO i=1,nspmd
92 nnodx = 0
93 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
94 IF (inod_crk(fr_elem(j)) > 0) THEN
95 nnodx = nnodx + 1
96 END IF
97 END DO
98 nodxsav(i) = nnodx ! number of Xfem nodes on the frontier
99 END DO
100c
101c--- receive
102c
103 l1 = 1
104 l2 = 1
105 iad_recv1(1) = l1
106 iad_recv2(1) = l2
107c
108 DO i=1,nspmd
109 nbsend = iad_elem(1,i+1)-iad_elem(1,i)
110 nnodx = nodxsav(i)
111 IF (nbsend > 0) THEN
112
113 siz = nbsend*nenr*nxlaymax
114c---
115 len1 = siz*3
116 msgtyp1 = msgoff1
117 CALL mpi_irecv(
118 s rbufi(1,l1),len1,mpi_integer,it_spmd(i),msgtyp1,
119 g spmd_comm_world,req_r1(i),ierror)
120 l1 = l1 + siz
121c---
122 len2 = siz*9
123 msgtyp2 = msgoff2
124 CALL mpi_irecv(
125 s rbufr(1,l2),len2,real,it_spmd(i),msgtyp2,
126 g spmd_comm_world,req_r2(i),ierror)
127 l2 = l2 + siz
128c---
129 ENDIF
130 iad_recv1(i+1) = l1
131 iad_recv2(i+1) = l2
132 END DO
133c
134c--- send
135c
136 l1 = 1
137 l2 = 1
138 iad_send1(1) = l1
139 iad_send2(1) = l2
140c
141 DO i=1,nspmd
142ccccc IF (NODXSAV(I) > 0) THEN
143 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
144 nn = fr_elem(j)
145 nsx = inod_crk(nn)
146 IF (nsx > 0) THEN
147 DO ilay=1,nxlaymax
148 DO ienr=1,nenr
149 iad = xfem_phantom(ilay)%TAGXP(1,nsx,ienr) ! sender IAD
150 ilev = xfem_phantom(ilay)%TAGXP(2,nsx,ienr) ! sender ILEV
151 count = xfem_phantom(ilay)%TAGXP(3,nsx,ienr)
152 enr = 0
153 IF (iad > 0) enr = crklvset(ilev)%ENR0(1,iad) ! sender ENR
154 IF (enr > 0 .and. ilev > 0 .and. count > 0) THEN
155c IF (IAD > 0 .and. ILEV > 0 .and. COUNT > 0) THEN
156 sbufi(1,l1) = iad
157 sbufi(2,l1) = ilev
158 sbufi(3,l1) = count
159 sbufr(1,l2) = crkavx(ilev)%X(1,iad)
160 sbufr(2,l2) = crkavx(ilev)%X(2,iad)
161 sbufr(3,l2) = crkavx(ilev)%X(3,iad)
162 sbufr(4,l2) = crkavx(ilev)%V(1,iad)
163 sbufr(5,l2) = crkavx(ilev)%V(2,iad)
164 sbufr(6,l2) = crkavx(ilev)%V(3,iad)
165 sbufr(7,l2) = crkavx(ilev)%VR(1,iad)
166 sbufr(8,l2) = crkavx(ilev)%VR(2,iad)
167 sbufr(9,l2) = crkavx(ilev)%VR(3,iad)
168c if(ilay==1.and. (nsx==51.or.nsx==26))then
169c write(*,'(A,3I5,3Z)')'SBUF,NSX,IAD,ILEV,V=',NSX,IAD,ILEV,SBUFR(1,L2),SBUFR(2,L2),SBUFR(3,L2)
170c write(*,'(A,I)')'SBUF_sender: COUNT=',count
171c endif
172
173 ENDIF
174 l1 = l1 + 1
175 l2 = l2 + 1
176 END DO
177 END DO
178 ELSE
179C on envoie des zeros (initialise plus haut)
180 l1 = l1+nenr*nxlaymax
181 l2 = l2+nenr*nxlaymax
182 ENDIF
183 END DO
184cccc ENDIF
185 iad_send1(i+1) = l1
186 iad_send2(i+1) = l2
187 ENDDO
188c---
189 DO i=1,nspmd
190 IF( iad_send1(i+1)-iad_send1(i) > 0)THEN
191c IF (NODXSAV(I) > 0) THEN
192 msgtyp1 = msgoff1
193 l1 = iad_send1(i)
194 siz = iad_send1(i+1)-iad_send1(i)
195 len1 = siz*3
196 CALL mpi_isend(
197 s sbufi(1,l1),len1,mpi_integer,it_spmd(i),msgtyp1,
198 g spmd_comm_world,req_s1(i),ierror)
199c ----------------------------------
200 msgtyp2 = msgoff2
201 siz = iad_send2(i+1)-iad_send2(i)
202 l2 = iad_send2(i)
203 len2 = siz*9
204 CALL mpi_isend(
205 s sbufr(1,l2),len2,real,it_spmd(i),msgtyp2,
206 g spmd_comm_world,req_s2(i),ierror)
207 ENDIF
208 ENDDO
209c
210c--- uncompact received buffers
211c
212 DO i = 1,nspmd
213c IF (NODXSAV(I) > 0) THEN
214 IF(iad_recv1(i+1)-iad_recv1(i) > 0)THEN
215 CALL mpi_wait(req_r1(i),status,ierror)
216 CALL mpi_wait(req_r2(i),status,ierror)
217c
218 l1 = iad_recv1(i)
219 l2 = iad_recv2(i)
220 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
221 nn = fr_elem(j)
222 nsx = inod_crk(nn)
223 IF (nsx > 0) THEN
224 DO ilay=1,nxlaymax
225 DO ienr=1,nenr
226 iad = rbufi(1,l1) ! sender IAD
227 il = rbufi(2,l1) ! sender ILEV
228 count = rbufi(3,l1)
229 kk = xfem_phantom(ilay)%TAGXP(4,nsx,ienr) ! receiver IAD
230 ilev = xfem_phantom(ilay)%TAGXP(5,nsx,ienr) ! receiver ILEV
231 IF (kk > 0) THEN
232 en0 = crklvset(ilev)%ENR0(2,kk) ! receiver enr
233 enr = crklvset(ilev)%ENR0(1,kk) ! receiver ENR
234 ELSE
235 en0 = 0
236 enr = 0
237 ENDIF
238c---
239c IF (EN0 > 0 .and. COUNT > 0 .and. IL > 0 .and. IAD > 0 .and.
240 IF (en0 <= 0 .and. enr > 0 .and. count > 0 .and. il > 0 .and. iad > 0 .and.
241 . ilev > 0 .and. kk > 0) THEN
242
243c write(*,'(A,4I5,3Z)') 'RCV_SPMD:ILEV,KK,ILS,IADS,VIT=',
244c . RBUFR(5,L2), RBUFR(6,L2) , RBUFR(7,L2)
245
246 crkavx(ilev)%X(1,kk) = rbufr(1,l2)
247 crkavx(ilev)%X(2,kk) = rbufr(2,l2)
248 crkavx(ilev)%X(3,kk) = rbufr(3,l2)
249 crkavx(ilev)%V(1,kk) = rbufr(4,l2)
250 crkavx(ilev)%V(2,kk) = rbufr(5,l2)
251 crkavx(ilev)%V(3,kk) = rbufr(6,l2)
252 crkavx(ilev)%VR(1,kk) = rbufr(7,l2)
253 crkavx(ilev)%VR(2,kk) = rbufr(8,l2)
254 crkavx(ilev)%VR(3,kk) = rbufr(9,l2)
255 xfem_phantom(ilay)%TAGXP(4,nsx,ienr) = 0
256 xfem_phantom(ilay)%TAGXP(5,nsx,ienr) = 0
257 ENDIF
258 l1 = l1 + 1
259 l2 = l2 + 1
260c---
261 ENDDO ! IENR=1,NENR
262 ENDDO ! ILAY=1,NXLAYMAX
263C si noeud n'est pas XFEM skipper la comm
264 ELSE
265 l1 = l1+nenr*nxlaymax
266 l2 = l2+nenr*nxlaymax
267 ENDIF ! NSX > 0
268 ENDDO ! J=IAD_ELEM(1,I),IAD_ELEM(1,I+1)-1
269 ENDIF
270 ENDDO
271c-----------
272 DO i = 1,nspmd
273 IF (iad_send1(i+1)-iad_send1(i) > 0) THEN
274 CALL mpi_wait(req_s1(i),status,ierror)
275 ENDIF
276 ENDDO
277c
278 DO i = 1, nspmd
279 IF (iad_send2(i+1)-iad_send2(i) > 0) THEN
280 CALL mpi_wait(req_s2(i),status,ierror)
281 ENDIF
282 ENDDO
283c-----------
284 DEALLOCATE(rbufi)
285 DEALLOCATE(sbufi)
286 DEALLOCATE(rbufr)
287 DEALLOCATE(sbufr)
288c-----------
289#endif
290 RETURN
291 END SUBROUTINE spmd_exch_crkvel
292c-----------
293
294!||====================================================================
295!|| spmd_exch_tagxp ../engine/source/mpi/elements/spmd_xfem.f
296!||--- calls -----------------------------------------------------
297!||--- uses -----------------------------------------------------
298!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
299!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
300!||====================================================================
301 SUBROUTINE spmd_exch_tagxp(IAD_ELEM ,FR_ELEM ,INOD_CRK ,ITAB )
302C-----------------------------------------------
303C M o d u l e s
304C-----------------------------------------------
305 USE crackxfem_mod
306C-----------------------------------------------
307C I m p l i c i t T y p e s
308C-----------------------------------------------
309 USE spmd_comm_world_mod, ONLY : spmd_comm_world
310#include "implicit_f.inc"
311C-----------------------------------------------
312C M e s s a g e P a s s i n g
313C-----------------------------------------------
314#include "spmd.inc"
315C-----------------------------------------------
316C C o m m o n B l o c k s
317C-----------------------------------------------
318#include "com01_c.inc"
319#include "com_xfem1.inc"
320#include "task_c.inc"
321C-----------------------------------------------
322C D u m m y A r g u m e n t s
323C-----------------------------------------------
324 INTEGER IAD_ELEM(2,*),FR_ELEM(*),INOD_CRK(*),ITAB(*)
325C-----------------------------------------------
326C L o c a l V a r i a b l e s
327C-----------------------------------------------
328#ifdef MPI
329 INTEGER I,J,L,ILAY,IAD,ILEV,KK,IL,EN1,IENR,ENR,SIZ,
330 . len,lenr,nnodx,nn,nsx,nct,nc,
331 . loc_proc,ierror,msgtyp,msgoff,
332 . enrl,enrr,flags,flagr,nenr
333 INTEGER STATUS(MPI_STATUS_SIZE),NODXSAV(NSPMD),
334 . req_r(nspmd),req_s(nspmd),iad_send(nspmd+1),iad_recv(nspmd+1)
335 INTEGER, DIMENSION(:,:), ALLOCATABLE :: RBUF,SBUF
336c----
337 DATA msgoff/241/
338C=======================================================================
339 loc_proc = ispmd + 1
340c
341! NENR = INT(IENRNOD/NLEVMAX)
342 nenr = ienrnod
343 lenr = iad_elem(1,nspmd+1) - iad_elem(1,1)
344 lenr = lenr * nxlaymax * nenr
345 ALLOCATE(rbuf(3,lenr))
346 ALLOCATE(sbuf(3,lenr))
347 rbuf = 0
348 sbuf = 0
349c
350 DO i=1,nspmd
351 nnodx = 0
352 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
353 IF (inod_crk(fr_elem(j)) > 0) THEN
354 nnodx = nnodx + 1
355 END IF
356 END DO
357 nodxsav(i) = nnodx
358 END DO
359c
360c--- receive
361c
362 l = 1
363 iad_recv(1) = l
364c
365 DO i=1,nspmd
366 nnodx = nodxsav(i)
367 siz = nnodx*nenr*nxlaymax
368c
369 IF (nnodx > 0) THEN
370 msgtyp = msgoff
371 len = siz*3
372 CALL mpi_irecv(
373 s rbuf(1,l),len,mpi_integer,it_spmd(i),msgtyp,
374 g spmd_comm_world,req_r(i),ierror)
375c
376 l = l + siz
377 ENDIF
378 iad_recv(i+1) = l
379 END DO
380c
381c--- send
382c
383 l = 1
384 iad_send(1) = l
385 DO i=1,nspmd
386 IF (nodxsav(i) > 0) THEN
387 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
388 nn = fr_elem(j)
389 nsx = inod_crk(nn)
390 IF (nsx > 0) THEN
391#include "vectorize.inc"
392 DO ilay=1,nxlaymax
393 DO ienr=1,nenr
394 iad = xfem_phantom(ilay)%TAGXP(1,nsx,ienr)
395 ilev = xfem_phantom(ilay)%TAGXP(2,nsx,ienr)
396 enrl = xfem_phantom(ilay)%TAGXP(3,nsx,ienr)
397 IF (iad > 0 .and. ilev > 0 .and. enrl == ienr) THEN
398 sbuf(1,l) = iad
399 sbuf(2,l) = ilev
400 sbuf(3,l) = enrl
401 ELSE
402 sbuf(1,l) = 0
403 sbuf(2,l) = 0
404 sbuf(3,l) = 0
405 ENDIF
406 l = l + 1
407 END DO
408 END DO
409 ENDIF
410 END DO
411 ENDIF
412 iad_send(i+1) = l
413 ENDDO
414c---
415 DO i=1,nspmd
416 IF (nodxsav(i) > 0) THEN
417 msgtyp = msgoff
418 siz = iad_send(i+1)-iad_send(i)
419 l = iad_send(i)
420 len = siz*3
421 CALL mpi_isend(
422 s sbuf(1,l),len,mpi_integer,it_spmd(i),msgtyp,
423 g spmd_comm_world,req_s(i),ierror)
424 ENDIF
425 ENDDO
426c
427c--- uncompact received buffers
428c
429 DO i = 1,nspmd
430 IF (nodxsav(i) > 0) THEN
431 CALL mpi_wait(req_r(i),status,ierror)
432c
433 l = iad_recv(i)
434 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
435 nn = fr_elem(j)
436 nsx = inod_crk(nn)
437 IF (nsx > 0) THEN
438 DO ilay=1,nxlaymax
439 DO ienr=1,nenr
440 iad = rbuf(1,l)
441 il = rbuf(2,l)
442 enr = rbuf(3,l)
443 IF (enr > 0) THEN
444 xfem_phantom(ilay)%TAGXP(1,nsx,enr) = iad
445 xfem_phantom(ilay)%TAGXP(2,nsx,enr) = ilev
446 xfem_phantom(ilay)%TAGXP(3,nsx,enr) = enr
447 ENDIF
448 l = l + 1
449c---
450 ENDDO ! IENR=1,NENR
451 ENDDO ! ILAY=1,NXLAYMAX
452 ENDIF ! NSX > 0
453 ENDDO ! J=IAD_ELEM(1,I),IAD_ELEM(1,I+1)-1
454 ENDIF
455 ENDDO
456c-----------
457 DO i = 1,nspmd
458 siz = iad_send(i+1)-iad_send(i)
459 IF (siz > 0) THEN
460 CALL mpi_wait(req_s(i),status,ierror)
461 ENDIF
462 ENDDO
463c-----------
464 DEALLOCATE(rbuf)
465 DEALLOCATE(sbuf)
466c-----------
467#endif
468 RETURN
469 END
470c
471!||====================================================================
472!|| spmd_exch_nodenr ../engine/source/mpi/elements/spmd_xfem.F
473!||--- called by ------------------------------------------------------
474!|| spmd_crk_adv ../engine/source/elements/xfem/xfemfsky.F
475!|| upxfem2 ../engine/source/elements/xfem/upxfem2.F
476!||--- calls -----------------------------------------------------
477!||--- uses -----------------------------------------------------
478!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
479!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
480!||====================================================================
481 SUBROUTINE spmd_exch_nodenr(IAD_ELEM,FR_ELEM,SIZE,LENR,INOD_CRK,
482 . ENRTAG,FLAG)
483C-----------------------------------------------
484C M o d u l e s
485C-----------------------------------------------
486 USE crackxfem_mod
487C-----------------------------------------------
488C I m p l i c i t T y p e s
489C-----------------------------------------------
490 USE spmd_comm_world_mod, ONLY : spmd_comm_world
491#include "implicit_f.inc"
492C-----------------------------------------------
493C M e s s a g e P a s s i n g
494C-----------------------------------------------
495#include "spmd.inc"
496C-----------------------------------------------
497C C o m m o n B l o c k s
498C-----------------------------------------------
499#include "com01_c.inc"
500#include "com04_c.inc"
501#include "task_c.inc"
502C-----------------------------------------------
503C D u m m y A r g u m e n t s
504C-----------------------------------------------
505 INTEGER IAD_ELEM(2,*),FR_ELEM(*),SIZE,LENR,INOD_CRK(*),FLAG,
506 . ENRTAG(NUMNOD,*)
507C-----------------------------------------------
508C L o c a l V a r i a b l e s
509C-----------------------------------------------
510#ifdef MPI
511 INTEGER MSGTYP,I,NOD,LOC_PROC,IERROR,MSGOFF,
512 . SIZ,J,L,NB_NOD,NNOD,IENR,ENR,SIZN,
513 . status(mpi_status_size),
514 . iad_send(nspmd+1),iad_recv(nspmd+1),
515 . req_r(nspmd),req_s(nspmd)
516 INTEGER RBUF(SIZE*LENR),SBUF(SIZE*LENR)
517 DATA MSGOFF/229/
518C-----------------------------------------------
519C S o u r c e L i n e s
520C-----------------------------------------------
521 loc_proc = ispmd + 1
522 l = 1
523 iad_recv(1) = 1
524 DO i=1,nspmd
525 siz = size*(iad_elem(1,i+1)-iad_elem(1,i))
526 IF(siz/=0)THEN
527 msgtyp = msgoff
528 CALL mpi_irecv(
529 s rbuf(l),siz,mpi_integer,it_spmd(i),msgtyp,
530 g spmd_comm_world,req_r(i),ierror)
531 l = l + siz
532 ENDIF
533 iad_recv(i+1) = l
534 END DO
535 l = 1
536 iad_send(1) = 1
537 DO i=1,nspmd
538#include "vectorize.inc"
539 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
540 nod = fr_elem(j)
541cc NNOD = INOD_CRK(NOD)
542 DO ienr=1,SIZE
543cc SBUF(L+IENR-1) = 0
544 IF(flag == 1)THEN
545cc IF(NNOD > 0)SBUF(L+IENR-1) = CRKENR(IENR)%NODENR(NNOD)
546 sbuf(l+ienr-1) = enrtag(nod,ienr)
547 ELSE IF(flag == 2)THEN
548 sbuf(l+ienr-1) = 0
549 ENDIF
550 END DO
551 l = l + SIZE
552 END DO
553 iad_send(i+1) = l
554 ENDDO
555C
556C echange messages
557C
558 DO i=1,nspmd
559C--------------------------------------------------------------------
560 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
561 msgtyp = msgoff
562 siz = iad_send(i+1)-iad_send(i)
563 l = iad_send(i)
564 CALL mpi_isend(
565 s sbuf(l),siz,mpi_integer,it_spmd(i),msgtyp,
566 g spmd_comm_world,req_s(i),ierror)
567 ENDIF
568C--------------------------------------------------------------------
569 ENDDO
570C
571 DO i = 1, nspmd
572 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
573 IF(nb_nod>0)THEN
574 CALL mpi_wait(req_r(i),status,ierror)
575 l = iad_recv(i)
576#include "vectorize.inc"
577 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
578 nod = fr_elem(j)
579cc NNOD = INOD_CRK(NOD)
580 DO ienr=1,SIZE
581 IF(flag==1)THEN
582 enr = enrtag(nod,ienr)
583 enrtag(nod,ienr) = max(enr,rbuf(l+ienr-1))
584 ELSEIF(flag==2)THEN
585cc ENR = 0
586cc ENRTAG(NOD,IENR) = MIN(ENR,RBUF(L+IENR-1))
587 enrtag(nod,ienr) = 0
588 END IF
589 END DO
590 l = l + SIZE
591 END DO
592 ENDIF
593 END DO
594C
595 DO i = 1, nspmd
596 IF(iad_elem(1,i+1)-iad_elem(1,i)>0)THEN
597 CALL mpi_wait(req_s(i),status,ierror)
598 ENDIF
599 ENDDO
600c-----------
601#endif
602 RETURN
603 END SUBROUTINE spmd_exch_nodenr
604c-----------
605C
606!||====================================================================
607!|| spmd_exch_iedge ../engine/source/mpi/elements/spmd_xfem.F
608!||--- called by ------------------------------------------------------
609!|| inixfem ../engine/source/elements/xfem/inixfem.F
610!|| upxfem2 ../engine/source/elements/xfem/upxfem2.F
611!|| xfeoff ../engine/source/elements/xfem/xfeoff.F
612!||--- calls -----------------------------------------------------
613!||--- uses -----------------------------------------------------
614!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
615!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
616!||====================================================================
617 SUBROUTINE spmd_exch_iedge(IAD_EDGE,FR_EDGE,SIZE ,LSDRC,FR_NBEDGE,
618 . FLAG ,CRKEDGE)
619C-----------------------------------------------
620 USE crackxfem_mod
621C-----------------------------------------------
622C I m p l i c i t T y p e s
623C-----------------------------------------------
624 USE spmd_comm_world_mod, ONLY : spmd_comm_world
625#include "implicit_f.inc"
626C-----------------------------------------------------------------
627C M e s s a g e P a s s i n g
628C-----------------------------------------------
629#include "spmd.inc"
630C-----------------------------------------------
631C C o m m o n B l o c k s
632C-----------------------------------------------
633#include "com01_c.inc"
634#include "com_xfem1.inc"
635#include "task_c.inc"
636C-----------------------------------------------
637C D u m m y A r g u m e n t s
638C-----------------------------------------------
639 INTEGER IAD_EDGE(*),FR_EDGE(*),
640 . SIZE,LSDRC,FR_NBEDGE(*),FLAG
641 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
642C-----------------------------------------------
643C L o c a l V a r i a b l e s
644C-----------------------------------------------
645#ifdef MPI
646 INTEGER I,II,J,JJ,L0,L,CC,MSGTYP,LOC_PROC,IERROR,
647 . INDEX,SIZ,NBIRECV,IAD_RECV(NSPMD+1),
648 . STATUS(MPI_STATUS_SIZE),REQ_R(NSPMD),
649 . req_s(nspmd),irindex(nspmd),ied,icut,
650 . iboundedge,nxlay,ilay,en10,en20,msgoff
651 INTEGER RBUF(SIZE*LSDRC),
652 . SBUF(SIZE*LSDRC)
653 DATA MSGOFF/228/
654C=======================================================================
655 loc_proc = ispmd + 1
656C
657 nxlay = int(nlevmax/nxel)
658 nbirecv = 0
659 l = 1
660 iad_recv(1) = 1
661 DO i = 1, nspmd
662 IF(iad_edge(i+1)-iad_edge(i) > 0)THEN
663 siz = size*fr_nbedge(i)
664 msgtyp = msgoff
665 nbirecv = nbirecv + 1
666 irindex(nbirecv) = i
667 CALL mpi_irecv(
668 . rbuf(l),siz,mpi_integer,it_spmd(i),msgtyp,
669 . spmd_comm_world,req_r(nbirecv),ierror)
670 l = l + siz
671 ENDIF
672 iad_recv(i+1) = l
673 ENDDO
674c-----------------------------------------------------
675 l = 1
676c---
677 IF (flag == 0) THEN
678c---
679 DO i=1,nspmd
680 IF (iad_edge(i+1) > iad_edge(i)) THEN
681 l0 = l
682#include "vectorize.inc"
683 DO j=iad_edge(i),iad_edge(i+1)-1
684 ied = fr_edge(j)
685 IF(ied == 0)THEN
686 DO ilay=1,nxlay
687 sbuf(l+ilay-1) = 0
688 ENDDO
689 ELSE
690 DO ilay=1,nxlay
691 sbuf(l+ilay-1) = crkedge(ilay)%IBORDEDGE(ied)
692 ENDDO
693 ENDIF
694 l = l + SIZE
695 END DO
696 siz = (iad_edge(i+1)-iad_edge(i))*SIZE
697 msgtyp = msgoff
698 CALL mpi_isend(sbuf(l0),siz,mpi_integer,it_spmd(i),msgtyp,
699 . spmd_comm_world,req_s(i),ierror)
700 ENDIF
701 ENDDO ! I=1,NSPMD
702c---
703 ELSE IF (flag == 1) THEN
704c---
705 DO i=1,nspmd
706 IF (iad_edge(i+1) > iad_edge(i)) THEN
707 l0 = l
708#include "vectorize.inc"
709 DO j=iad_edge(i),iad_edge(i+1)-1
710 ied = fr_edge(j)
711 IF(ied == 0)THEN
712 DO ilay=1,nxlay
713 sbuf(l+ilay-1) = 0
714 ENDDO
715 ELSE
716 DO ilay=1,nxlay
717 sbuf(l+ilay-1) = crkedge(ilay)%ICUTEDGE(ied)
718 ENDDO
719 ENDIF
720 l = l + SIZE
721 END DO
722 siz = (iad_edge(i+1)-iad_edge(i))*SIZE
723 msgtyp = msgoff
724 CALL mpi_isend(sbuf(l0),siz,mpi_integer,it_spmd(i),msgtyp,
725 . spmd_comm_world,req_s(i),ierror)
726 ENDIF
727 ENDDO ! I=1,NSPMD
728c---
729 ELSE IF (flag == 2) THEN
730c---
731 DO i=1,nspmd
732 IF (iad_edge(i+1) > iad_edge(i)) THEN
733 l0 = l
734#include "vectorize.inc"
735 DO j=iad_edge(i),iad_edge(i+1)-1
736 ied = fr_edge(j)
737 IF(ied==0)THEN
738 DO ilay=1,nxlay
739 sbuf(l+ilay-1) = 0
740 ENDDO
741 ELSE
742 DO ilay=1,nxlay
743 sbuf(l+ilay-1) = crkedge(ilay)%ICUTEDGE(ied)
744 ENDDO
745 ENDIF
746 l = l + SIZE
747 END DO
748 siz = (iad_edge(i+1)-iad_edge(i))*SIZE
749 msgtyp = msgoff
750 CALL mpi_isend(sbuf(l0),siz,mpi_integer,it_spmd(i),msgtyp,
751 . spmd_comm_world,req_s(i),ierror)
752 ENDIF
753 ENDDO ! I=1,NSPMD
754c---
755 ELSE IF (flag == 3) THEN
756c---
757 DO i=1,nspmd
758 IF (iad_edge(i+1) > iad_edge(i)) THEN
759 l0 = l
760#include "vectorize.inc"
761 DO j=iad_edge(i),iad_edge(i+1)-1
762 ied = fr_edge(j)
763 IF(ied==0)THEN
764 DO ilay=1,nxlay
765 sbuf(l+ilay-1) = 0
766 sbuf(l+ilay-1+nxlay) = 0
767 sbuf(l+ilay-1+nxlay*2) = 0
768 sbuf(l+ilay-1+nxlay*3) = 0
769 sbuf(l+ilay-1+nxlay*4) = 0
770 sbuf(l+ilay-1+nxlay*5) = 0
771 ENDDO
772
773 ELSE
774 DO ilay=1,nxlay
775 sbuf(l+ilay-1) = crkedge(ilay)%ICUTEDGE(ied)
776 sbuf(l+ilay-1+nxlay) = crkedge(ilay)%EDGEENR(1,ied)
777 sbuf(l+ilay-1+nxlay*2) = crkedge(ilay)%EDGEENR(2,ied)
778 sbuf(l+ilay-1+nxlay*3) = crkedge(ilay)%EDGEICRK(ied)
779 sbuf(l+ilay-1+nxlay*4) = crkedge(ilay)%EDGETIP(1,ied)
780 sbuf(l+ilay-1+nxlay*5) = crkedge(ilay)%EDGETIP(2,ied)
781 ENDDO
782 ENDIF
783 l = l + SIZE
784 END DO
785 siz = (iad_edge(i+1)-iad_edge(i))*SIZE
786 msgtyp = msgoff
787 CALL mpi_isend(sbuf(l0),siz,mpi_integer,it_spmd(i),msgtyp,
788 . spmd_comm_world,req_s(i),ierror)
789 ENDIF
790 ENDDO ! I=1,NSPMD
791c---
792 END IF ! FLAG
793c---
794c--------------------
795c decompactage IRECV
796c--------------------
797 DO ii=1,nbirecv
798 CALL mpi_waitany(nbirecv,req_r,index,status,ierror)
799 i = irindex(index)
800 l = iad_recv(i)
801#include "vectorize.inc"
802 DO j=iad_edge(i),iad_edge(i+1)-1
803 ied = fr_edge(j)
804 IF(ied/=0)THEN
805 IF (flag == 0) THEN
806 DO ilay=1,nxlay
807 iboundedge = crkedge(ilay)%IBORDEDGE(ied)
808 crkedge(ilay)%IBORDEDGE(ied) =
809 . max(rbuf(l+ilay-1),iboundedge)
810 ENDDO
811 ELSE IF (flag == 1) THEN
812 DO ilay=1,nxlay
813 icut = crkedge(ilay)%ICUTEDGE(ied)
814 IF (icut + rbuf(l+ilay-1) /= 4) THEN
815 crkedge(ilay)%ICUTEDGE(ied) = max(rbuf(l+ilay-1),icut)
816 ELSE
817 crkedge(ilay)%ICUTEDGE(ied) = 3
818 END IF
819 ENDDO
820 ELSE IF (flag == 2) THEN
821 DO ilay=1,nxlay
822 icut = crkedge(ilay)%ICUTEDGE(ied)
823 IF (icut > 0) crkedge(ilay)%ICUTEDGE(ied) = min(1,icut)
824 ENDDO
825 ELSE IF (flag == 3) THEN
826 DO ilay=1,nxlay
827 icut = crkedge(ilay)%ICUTEDGE(ied)
828 en10 = crkedge(ilay)%EDGEENR(1,ied)
829 en20 = crkedge(ilay)%EDGEENR(2,ied)
830 IF (icut > 0) THEN
831 crkedge(ilay)%EDGEENR(1,ied)
832 . = max(en10,rbuf(l+ilay-1+nxlay))
833 crkedge(ilay)%EDGEENR(2,ied)
834 . = max(en20,rbuf(l+ilay-1+2*nxlay))
835
836 crkedge(ilay)%EDGEICRK(ied) =
837 . max(crkedge(ilay)%EDGEICRK(ied),rbuf(l+ilay-1+3*nxlay))
838 crkedge(ilay)%EDGETIP(1,ied) = max(
839 . crkedge(ilay)%EDGETIP(1,ied),rbuf(l+ilay-1+4*nxlay))
840 crkedge(ilay)%EDGETIP(2,ied) = max(
841 . crkedge(ilay)%EDGETIP(2,ied),rbuf(l+ilay-1+5*nxlay))
842 ENDIF
843 ENDDO
844 END IF
845 ENDIF
846 l = l + SIZE
847 END DO
848 END DO
849c-----------
850c wait terminaison isend
851c-----------
852 DO i = 1, nspmd
853 IF(iad_edge(i+1)-iad_edge(i) > 0)
854 . CALL mpi_wait(req_s(i),status,ierror)
855 ENDDO
856c-----------
857#endif
858 RETURN
859 END SUBROUTINE spmd_exch_iedge
860c-----------
861c
862!||====================================================================
863!|| spmd_exch_redge ../engine/source/mpi/elements/spmd_xfem.F
864!||--- called by ------------------------------------------------------
865!|| upxfem2 ../engine/source/elements/xfem/upxfem2.F
866!||--- calls -----------------------------------------------------
867!||--- uses -----------------------------------------------------
868!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
869!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.f90
870!||====================================================================
871 SUBROUTINE spmd_exch_redge(IAD_EDGE,FR_EDGE,SIZE ,LSDRC,FR_NBEDGE,CRKEDGE)
872C-----------------------------------------------
873 USE crackxfem_mod
874C-----------------------------------------------
875C I m p l i c i t T y p e s
876C-----------------------------------------------
877 USE spmd_comm_world_mod, ONLY : spmd_comm_world
878#include "implicit_f.inc"
879C-----------------------------------------------------------------
880C M e s s a g e P a s s i n g
881C-----------------------------------------------
882#include "spmd.inc"
883C-----------------------------------------------
884C C o m m o n B l o c k s
885C-----------------------------------------------
886#include "com01_c.inc"
887#include "com_xfem1.inc"
888#include "task_c.inc"
889C-----------------------------------------------
890C D u m m y A r g u m e n t s
891C-----------------------------------------------
892 INTEGER IAD_EDGE(*),FR_EDGE(*),
893 . SIZE,LSDRC,FR_NBEDGE(*),FLAG
894 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
895C-----------------------------------------------
896C L o c a l V a r i a b l e s
897C-----------------------------------------------
898#ifdef MPI
899 INTEGER I,II,J,JJ,L0,L,CC,MSGTYP,LOC_PROC,IERROR,
900 . INDEX,SIZ,NBIRECV,IAD_RECV(NSPMD+1),
901 . STATUS(MPI_STATUS_SIZE),REQ_R(NSPMD),
902 . req_s(nspmd),irindex(nspmd),nxlay,ilay,ied,msgoff
903 my_real
904 . rbuf(size*lsdrc+nspmd),sbuf(size*lsdrc+nspmd)
905 DATA msgoff/230/
906C=======================================================================
907 loc_proc = ispmd + 1
908C
909 nxlay = int(nlevmax/nxel)
910 nbirecv = 0
911 l = 1
912 iad_recv(1) = 1
913 DO i = 1, nspmd
914 IF(iad_edge(i+1)-iad_edge(i) > 0)THEN
915 siz = size*fr_nbedge(i)
916 msgtyp = msgoff
917 nbirecv = nbirecv + 1
918 irindex(nbirecv) = i
919 CALL mpi_irecv(
920 . rbuf(l),siz,real,it_spmd(i),msgtyp,
921 . spmd_comm_world,req_r(nbirecv),ierror)
922 l = l + siz
923 ENDIF
924 iad_recv(i+1) = l
925 ENDDO
926C
927 l = 1
928C
929 DO i=1,nspmd
930 IF(iad_edge(i+1)-iad_edge(i) > 0)THEN
931 l0 = l
932#include "vectorize.inc"
933 DO j=iad_edge(i),iad_edge(i+1)-1
934 ied = fr_edge(j)
935 IF(ied > 0)THEN
936 DO ilay=1,nxlay
937 sbuf(l+ilay-1) = crkedge(ilay)%RATIO(ied)
938 ENDDO
939 ENDIF
940 l = l + SIZE
941 END DO
942C
943C echange messages
944C
945 siz = (iad_edge(i+1)-iad_edge(i))*SIZE
946 msgtyp = msgoff
947 CALL mpi_isend(
948 . sbuf(l0),siz,real,it_spmd(i),msgtyp,
949 . spmd_comm_world,req_s(i),ierror)
950 ENDIF
951 ENDDO
952C
953C decompactage
954C
955 DO ii=1,nbirecv
956 CALL mpi_waitany(nbirecv,req_r,index,status,ierror)
957 i = irindex(index)
958 l = iad_recv(i)
959#include "vectorize.inc"
960 DO j=iad_edge(i),iad_edge(i+1)-1
961 ied = fr_edge(j)
962 IF(ied >0)THEN
963 DO ilay=1,nxlay
964 IF (crkedge(ilay)%RATIO(ied) == zero)
965 . crkedge(ilay)%RATIO(ied) = rbuf(l+ilay-1)
966 ENDDO
967 ENDIF
968 l = l + SIZE
969 END DO
970 END DO
971C
972C wait terminaison isend
973C
974 DO i = 1, nspmd
975 IF(iad_edge(i+1)-iad_edge(i) > 0)
976 . CALL mpi_wait(req_s(i),status,ierror)
977 ENDDO
978c-----------
979#endif
980 RETURN
981 END SUBROUTINE spmd_exch_redge
982c-----------
983
984!||====================================================================
985!|| spmd_exch_crkavx ../engine/source/mpi/elements/spmd_xfem.F
986!||--- calls -----------------------------------------------------
987!||--- uses -----------------------------------------------------
988!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
989!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
990!||====================================================================
991 SUBROUTINE spmd_exch_crkavx(
992 . IAD_ELEM,FR_ELEM,FR_NBCC1,LENS1 ,LENR1 ,
993 . IADSDP_CRK,IADRCP_CRK,ISENDP_CRK,IRECVP_CRK)
994C--------------------------------------
995 USE crackxfem_mod
996C-----------------------------------------------
997C I m p l i c i t T y p e s
998C-----------------------------------------------
999 USE spmd_comm_world_mod, ONLY : spmd_comm_world
1000#include "implicit_f.inc"
1001C-----------------------------------------------------------------
1002C M e s s a g e P a s s i n g
1003C-----------------------------------------------
1004#include "spmd.inc"
1005C-----------------------------------------------
1006C C o m m o n B l o c k s
1007C-----------------------------------------------
1008#include "com01_c.inc"
1009#include "com_xfem1.inc"
1010#include "task_c.inc"
1011C-----------------------------------------------
1012C D u m m y A r g u m e n t s
1013C-----------------------------------------------
1014 INTEGER LENS1,LENR1,IAD_ELEM(2,*),FR_ELEM(*),FR_NBCC1(2,*),
1015 . IADSDP_CRK(*),IADRCP_CRK(*),ISENDP_CRK(*),IRECVP_CRK(*)
1016C-----------------------------------------------
1017C L o c a l V a r i a b l e s
1018C-----------------------------------------------
1019#ifdef MPI
1020 INTEGER I,J,II,L,L0,CC,IPT,SIZ,INDEX,LOC_PROC,IERROR,
1021 . NB_NOD,NBIRECV,MSGTYP,MSGOFF,
1022 . IAD_RECV(NSPMD+1),STATUS(MPI_STATUS_SIZE),
1023 . REQ_R(NSPMD),REQ_S(NSPMD)
1024c
1025 my_real rbuf(9*nlevmax*lenr1),sbuf(9*nlevmax*lens1)
1026 DATA msgoff/243/
1027C=======================================================================
1028 loc_proc = ispmd + 1
1029C
1030 nbirecv = 0
1031 l = 1
1032 iad_recv(1) = 1
1033 DO i = 1, nspmd
1034 IF (iad_elem(1,i+1) - iad_elem(1,i) > 0) THEN
1035 siz = 9*nlevmax*fr_nbcc1(2,i)
1036 msgtyp = msgoff
1037 CALL mpi_irecv(
1038 s rbuf(l),siz,real,it_spmd(i),msgtyp,
1039 g spmd_comm_world,req_r(i),ierror)
1040 l = l + siz
1041 ENDIF
1042 iad_recv(i+1) = l
1043 ENDDO
1044 l = 1
1045c-----------------------------------------------------------------------
1046 DO i=1,nspmd
1047 IF (iad_elem(1,i+1)-iad_elem(1,i) > 0) THEN
1048 l0 = l
1049C
1050 DO j=iadsdp_crk(i),iadsdp_crk(i+1)-1
1051 cc = isendp_crk(j)
1052 DO ipt = 1, nlevmax
1053 sbuf(l ) = crkavx(ipt)%X(1,cc)
1054 sbuf(l+1) = crkavx(ipt)%X(2,cc)
1055 sbuf(l+2) = crkavx(ipt)%X(3,cc)
1056 sbuf(l+3) = crkavx(ipt)%V(1,cc)
1057 sbuf(l+4) = crkavx(ipt)%V(2,cc)
1058 sbuf(l+5) = crkavx(ipt)%V(3,cc)
1059 sbuf(l+6) = crkavx(ipt)%VR(1,cc)
1060 sbuf(l+7) = crkavx(ipt)%VR(2,cc)
1061 sbuf(l+8) = crkavx(ipt)%VR(3,cc)
1062c
1063 l = l + 9
1064 END DO
1065 ENDDO
1066c--------------------------------------------------------
1067c echange messages
1068c--------------------------------------------------------
1069 siz = (iadsdp_crk(i+1)-iadsdp_crk(i))*nlevmax*9
1070 msgtyp = msgoff
1071 CALL mpi_isend(
1072 s sbuf(l0),siz,real,it_spmd(i),msgtyp,
1073 g spmd_comm_world,req_s(i),ierror)
1074c
1075 ENDIF
1076 ENDDO
1077c--------------------------------------------------------
1078c decompactage
1079c--------------------------------------------------------
1080 DO i=1,nspmd
1081 IF (iad_elem(1,i+1)-iad_elem(1,i) > 0) THEN
1082
1083 CALL mpi_wait(req_r(i),status,ierror)
1084 nb_nod = iad_elem(1,i+1)-iad_elem(1,i)
1085C
1086 l = iad_recv(i)
1087 DO j=iadrcp_crk(i),iadrcp_crk(i+1)-1
1088 cc = irecvp_crk(j)
1089 DO ipt = 1,nlevmax
1090 crkavx(ipt)%X(1,cc) = rbuf(l)
1091 crkavx(ipt)%X(2,cc) = rbuf(l+1)
1092 crkavx(ipt)%X(3,cc) = rbuf(l+2)
1093 crkavx(ipt)%V(1,cc) = rbuf(l+3)
1094 crkavx(ipt)%V(2,cc) = rbuf(l+4)
1095 crkavx(ipt)%V(3,cc) = rbuf(l+5)
1096 crkavx(ipt)%VR(1,cc) = rbuf(l+6)
1097 crkavx(ipt)%VR(2,cc) = rbuf(l+7)
1098 crkavx(ipt)%VR(3,cc) = rbuf(l+8)
1099c
1100 l = l + 9
1101 END DO
1102 END DO
1103 ENDIF
1104 END DO
1105c---------------------------
1106c wait terminaison isend
1107c---------------------------
1108 DO i = 1, nspmd
1109 IF (iad_elem(1,i+1) - iad_elem(1,i) > 0)
1110 . CALL mpi_wait(req_s(i),status,ierror)
1111 ENDDO
1112c-----------
1113#endif
1114 RETURN
1115 END
1116c
1117!||====================================================================
1118!|| spmd_max_xfe_i ../engine/source/mpi/elements/spmd_xfem.F
1119!||--- called by ------------------------------------------------------
1120!|| delnumbc_crk ../engine/source/output/anim/generate/delnumbc_crk.f
1121!|| genani ../engine/source/output/anim/generate/genani.F
1122!|| resol ../engine/source/engine/resol.F
1123!|| upxfem2 ../engine/source/elements/xfem/upxfem2.F
1124!|| xfeoff ../engine/source/elements/xfem/xfeoff.F
1125!||--- calls -----------------------------------------------------
1126!||--- uses -----------------------------------------------------
1127!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
1128!||====================================================================
1129 SUBROUTINE spmd_max_xfe_i(INT)
1130C-----------------------------------------------
1131C I m p l i c i t T y p e s
1132C-----------------------------------------------
1133 USE spmd_comm_world_mod, ONLY : spmd_comm_world
1134#include "implicit_f.inc"
1135C-----------------------------------------------------------------
1136C M e s s a g e P a s s i n g
1137C-----------------------------------------------
1138#include "spmd.inc"
1139C-----------------------------------------------
1140C C o m m o n B l o c k s
1141C-----------------------------------------------
1142#include "com01_c.inc"
1143#include "task_c.inc"
1144C-----------------------------------------------
1145C D u m m y A r g u m e n t s
1146C-----------------------------------------------
1147 INTEGER INT
1148C-----------------------------------------------
1149C L o c a l V a r i a b l e s
1150C-----------------------------------------------
1151#ifdef MPI
1152 INTEGER I, N, MSGOFF, MSGOFF2, MSGTYP, IERROR, LOC_PROC,
1153 . INDEX, SIZ,
1154 . STATUS(MPI_STATUS_SIZE), REQ_R(NSPMD)
1155 INTEGER RBUF(NSPMD)
1156 DATA MSGOFF/225/,MSGOFF2/226/
1157C=======================================================================
1158 loc_proc = ispmd + 1
1159 siz=1
1160 IF (ispmd == 0) THEN
1161 DO i = 2, nspmd
1162 msgtyp=msgoff
1163 CALL mpi_irecv(rbuf(i),siz,mpi_integer,it_spmd(i),msgtyp,
1164 . spmd_comm_world,req_r(i-1),ierror)
1165 END DO
1166C
1167 DO n = 1, nspmd-1
1168 CALL mpi_waitany(nspmd-1,req_r,index,status,ierror)
1169 i = index+1
1170 int = max(int,rbuf(i))
1171 END DO
1172C
1173 DO i = 2, nspmd
1174 msgtyp=msgoff2
1175 CALL mpi_send(int,siz,mpi_integer,it_spmd(i),
1176 . msgtyp,spmd_comm_world,ierror)
1177 END DO
1178 ELSE
1179 msgtyp = msgoff
1180 CALL mpi_send(int,siz,mpi_integer,it_spmd(1),
1181 . msgtyp,spmd_comm_world,ierror)
1182
1183 msgtyp = msgoff2
1184 CALL mpi_recv(int,siz,mpi_integer,it_spmd(1),msgtyp,
1185 . spmd_comm_world,status,ierror)
1186 END IF
1187C-----------
1188#endif
1189 RETURN
1190 END
1191
1192
1193
my_real
#define my_real
Definition cppsort.cpp:32
delnumbc_crk
subroutine delnumbc_crk(iparg, iel_crk, inum, idcmax, el2fa, iad_crkg, nbf_l, nbf, indx_crk)
Definition delnumbc_crk.F:36
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
mpi_recv
subroutine mpi_recv(buf, cnt, datatype, source, tag, comm, status, ierr)
Definition mpi.f:461
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_send
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
Definition mpi.f:480
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::xfem_phantom
type(xfem_phantom_), dimension(:), allocatable xfem_phantom
Definition crackxfem_mod.F:139
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
spmd_max_xfe_i
subroutine spmd_max_xfe_i(int)
Definition spmd_xfem.F:1130
spmd_exch_crkvel
subroutine spmd_exch_crkvel(iad_elem, fr_elem, inod_crk, itab, x, v, vr)
Definition spmd_xfem.F:35
spmd_exch_crkavx
subroutine spmd_exch_crkavx(iad_elem, fr_elem, fr_nbcc1, lens1, lenr1, iadsdp_crk, iadrcp_crk, isendp_crk, irecvp_crk)
Definition spmd_xfem.F:994
spmd_exch_tagxp
subroutine spmd_exch_tagxp(iad_elem, fr_elem, inod_crk, itab)
Definition spmd_xfem.F:302
spmd_exch_nodenr
subroutine spmd_exch_nodenr(iad_elem, fr_elem, size, lenr, inod_crk, enrtag, flag)
Definition spmd_xfem.F:483
spmd_exch_iedge
subroutine spmd_exch_iedge(iad_edge, fr_edge, size, lsdrc, fr_nbedge, flag, crkedge)
Definition spmd_xfem.F:619
spmd_exch_redge
subroutine spmd_exch_redge(iad_edge, fr_edge, size, lsdrc, fr_nbedge, crkedge)
Definition spmd_xfem.F:872