OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_dsreso.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_ds_isend ../engine/source/mpi/implicit/spmd_dsreso.F
25!||--- calls -----------------------------------------------------
26!||--- uses -----------------------------------------------------
27!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
28!||====================================================================
29 SUBROUTINE spmd_ds_isend(BUF, SIZE, ITAG, IDEST)
30C-----------------------------------------------
31C I m p l i c i t T y p e s
32C-----------------------------------------------
33 USE spmd_comm_world_mod, ONLY : spmd_comm_world
34#include "implicit_f.inc"
35C-----------------------------------------------
36C M e s s a g e P a s s i n g
37C-----------------------------------------------
38#include "spmd.inc"
39C-----------------------------------------------
40C C o m m o n B l o c k s
41C-----------------------------------------------
42#include "task_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER BUF(*), SIZE, ITAG, IDEST
47C-----------------------------------------------
48C L o c a l V a r i a b l e s
49C-----------------------------------------------
50#ifdef MPI
51 INTEGER IERR
52C
53 CALL mpi_send(buf, SIZE, mpi_integer, it_spmd(idest), itag,
54 . spmd_comm_world, ierr)
55* WRITE(*,*) 'Requete I envoyee - ITAG ',ITAG,' IERR ',IERR
56C
57#endif
58 RETURN
59 END
60!||====================================================================
61!|| spmd_ds_rsend ../engine/source/mpi/implicit/spmd_dsreso.F
62!||--- called by ------------------------------------------------------
63!|| imp_buck ../engine/source/implicit/imp_buck.F
64!||--- calls -----------------------------------------------------
65!||--- uses -----------------------------------------------------
66!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
67!||====================================================================
68 SUBROUTINE spmd_ds_rsend(BUF, SIZE, ITAG, IDEST)
69C-----------------------------------------------
70C I m p l i c i t T y p e s
71C-----------------------------------------------
72 USE spmd_comm_world_mod, ONLY : spmd_comm_world
73#include "implicit_f.inc"
74C-----------------------------------------------
75C M e s s a g e P a s s i n g
76C-----------------------------------------------
77#include "spmd.inc"
78C-----------------------------------------------
79C C o m m o n B l o c k s
80C-----------------------------------------------
81#include "task_c.inc"
82C-----------------------------------------------
83C D u m m y A r g u m e n t s
84C-----------------------------------------------
85 INTEGER SIZE, ITAG, IDEST
86 my_real
87 . buf(*)
88C-----------------------------------------------
89C L o c a l V a r i a b l e s
90C-----------------------------------------------
91#ifdef MPI
92 INTEGER IERR
93C
94 CALL mpi_send(buf, SIZE, real, it_spmd(idest), itag,
95 . spmd_comm_world, ierr)
96C
97#endif
98 RETURN
99 END
100!||====================================================================
101!|| spmd_ds_irecv ../engine/source/mpi/implicit/spmd_dsreso.F
102!||--- calls -----------------------------------------------------
103!||--- uses -----------------------------------------------------
104!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
105!||====================================================================
106 SUBROUTINE spmd_ds_irecv(BUF, SIZE, ITAG, IPROV)
107C-----------------------------------------------
108C I m p l i c i t T y p e s
109C-----------------------------------------------
110 USE spmd_comm_world_mod, ONLY : spmd_comm_world
111#include "implicit_f.inc"
112C-----------------------------------------------
113C M e s s a g e P a s s i n g
114C-----------------------------------------------
115#include "spmd.inc"
116C-----------------------------------------------
117C C o m m o n B l o c k s
118C-----------------------------------------------
119#include "task_c.inc"
120C-----------------------------------------------
121C D u m m y A r g u m e n t s
122C-----------------------------------------------
123 INTEGER BUF(*), SIZE, ITAG, IPROV
124C-----------------------------------------------
125C L o c a l V a r i a b l e s
126C-----------------------------------------------
127#ifdef MPI
128 INTEGER IERR, ISTAT(MPI_STATUS_SIZE), LEN_STR, IERR_STR
129 CHARACTER STR_ERROR*(MPI_MAX_ERROR_STRING)
130C
131 CALL mpi_recv(buf, SIZE, mpi_integer, it_spmd(iprov), itag,
132 . spmd_comm_world, istat, ierr)
133C
134#endif
135 RETURN
136 END
137!||====================================================================
138!|| spmd_ds_rrecv ../engine/source/mpi/implicit/spmd_dsreso.F
139!||--- called by ------------------------------------------------------
140!|| imp_buck ../engine/source/implicit/imp_buck.F
141!||--- calls -----------------------------------------------------
142!||--- uses -----------------------------------------------------
143!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
144!||====================================================================
145 SUBROUTINE spmd_ds_rrecv(BUF, SIZE, ITAG, IPROV)
146C-----------------------------------------------
147C I m p l i c i t T y p e s
148C-----------------------------------------------
149 USE spmd_comm_world_mod, ONLY : spmd_comm_world
150#include "implicit_f.inc"
151C-----------------------------------------------
152C M e s s a g e P a s s i n g
153C-----------------------------------------------
154#include "spmd.inc"
155C-----------------------------------------------
156C C o m m o n B l o c k s
157C-----------------------------------------------
158#include "task_c.inc"
159C-----------------------------------------------
160C D u m m y A r g u m e n t s
161C-----------------------------------------------
162 INTEGER SIZE, ITAG, IPROV
163 my_real
164 . buf(*)
165C-----------------------------------------------
166C L o c a l V a r i a b l e s
167C-----------------------------------------------
168#ifdef MPI
169 INTEGER IERR, ISTAT(MPI_STATUS_SIZE)
170C
171 CALL mpi_recv(buf, SIZE, real, it_spmd(iprov), itag,
172 . spmd_comm_world, istat, ierr)
173C
174#endif
175 RETURN
176 END
177!||====================================================================
178!|| spmd_ds_iexch ../engine/source/mpi/implicit/spmd_dsreso.F
179!||--- calls -----------------------------------------------------
180!||--- uses -----------------------------------------------------
181!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
182!||====================================================================
183 SUBROUTINE spmd_ds_iexch(SBUF, RBUF, SIZE, MSGOFF)
184C-----------------------------------------------
185C I m p l i c i t T y p e s
186C-----------------------------------------------
187 USE spmd_comm_world_mod, ONLY : spmd_comm_world
188#include "implicit_f.inc"
189C-----------------------------------------------
190C M e s s a g e P a s s i n g
191C-----------------------------------------------
192#include "spmd.inc"
193C-----------------------------------------------
194C C o m m o n B l o c k s
195C-----------------------------------------------
196#include "com01_c.inc"
197#include "task_c.inc"
198C-----------------------------------------------
199C D u m m y A r g u m e n t s
200C-----------------------------------------------
201 INTEGER SIZE, SBUF(SIZE,*), RBUF(SIZE,*), MSGOFF
202C-----------------------------------------------
203C L o c a l V a r i a b l e s
204C-----------------------------------------------
205#ifdef MPI
206 INTEGER I, ITAG, REQ(2), IERR,
207 . TSTAT(MPI_STATUS_SIZE,2)
208C
209 DO i=1,nspmd
210 IF (ispmd==i-1) THEN
211 rbuf(1,i)=sbuf(1,i)
212 rbuf(2,i)=sbuf(2,i)
213 ELSE
214 itag=msgoff + nspmd*ispmd + i
215 CALL mpi_isend(sbuf(1,i), SIZE, mpi_integer, it_spmd(i),
216 . itag, spmd_comm_world, req(1), ierr)
217C
218 itag=msgoff + nspmd*(i-1) + ispmd+1
219 CALL mpi_irecv(rbuf(1,i), SIZE, mpi_integer, it_spmd(i),
220 . itag, spmd_comm_world, req(2), ierr)
221C
222 CALL mpi_waitall(2, req, tstat, ierr)
223 ENDIF
224 ENDDO
225C
226#endif
227 RETURN
228 END
229!||====================================================================
230!|| spmd_ds_mexch ../engine/source/mpi/implicit/spmd_dsreso.F
231!||--- calls -----------------------------------------------------
232!||--- uses -----------------------------------------------------
233!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
234!||====================================================================
235 SUBROUTINE spmd_ds_mexch(MATR, N , IEXCH, REXCH, MSGOFF,
236 . IADS, IADR, NN )
237C-----------------------------------------------
238C I m p l i c i t T y p e s
239C-----------------------------------------------
240 USE spmd_comm_world_mod, ONLY : spmd_comm_world
241#include "implicit_f.inc"
242C-----------------------------------------------
243C M e s s a g e P a s s i n g
244C-----------------------------------------------
245#include "spmd.inc"
246C-----------------------------------------------
247C C o m m o n B l o c k s
248C-----------------------------------------------
249#include "com01_c.inc"
250#include "task_c.inc"
251C-----------------------------------------------
252C D u m m y A r g u m e n t s
253C-----------------------------------------------
254 INTEGER N, NN, IEXCH(NN,*), MSGOFF, IADS(*), IADR(*)
255 my_real
256 . matr(n,*), rexch(*)
257C-----------------------------------------------
258C L o c a l V a r i a b l e s
259C-----------------------------------------------
260#ifdef MPI
261 INTEGER I, IADC, LEN, ITAG(3), J, IR, IC, REQ(6),
262 . tstat(mpi_status_size,6), ierr, lenr
263 INTEGER, DIMENSION(:), ALLOCATABLE :: IROW, ICOL
264 my_real
265 . , DIMENSION(:), ALLOCATABLE :: val
266C
267 DO i=1,nspmd
268 IF (ispmd==i-1) THEN
269 iadc=iads(i)
270 len=iads(i+1)-iads(i)
271 DO j=1,len
272 ir=iexch(iadc+j-1,1)
273 ic=iexch(iadc+j-1,2)
274 matr(ir,ic)=matr(ir,ic)+rexch(iadc+j-1)
275 ENDDO
276 ELSE
277C Reception
278 len=iadr(i+1)-iadr(i)
279 lenr=len
280 ALLOCATE(irow(len), icol(len), val(len))
281 itag(1)=msgoff + nspmd*3*(i-1) + ispmd+1
282 itag(2)=msgoff + nspmd*3*(i-1) + nspmd+ispmd+1
283 itag(3)=msgoff + nspmd*3*(i-1) + 2*nspmd+ispmd+1
284 CALL mpi_irecv(irow, len, mpi_integer, it_spmd(i),
285 . itag(1), spmd_comm_world, req(1), ierr)
286 CALL mpi_irecv(icol, len, mpi_integer, it_spmd(i),
287 . itag(2), spmd_comm_world, req(2), ierr)
288 CALL mpi_irecv(val, len, real, it_spmd(i),
289 . itag(3), spmd_comm_world, req(3), ierr)
290C Envoi
291 iadc=iads(i)
292 len=iads(i+1)-iads(i)
293 itag(1)=msgoff + nspmd*3*ispmd + i
294 itag(2)=msgoff + nspmd*3*ispmd + nspmd+i
295 itag(3)=msgoff + nspmd*3*ispmd + 2*nspmd+i
296 CALL mpi_isend(iexch(iadc,1), len, mpi_integer, it_spmd(i),
297 . itag(1), spmd_comm_world, req(4), ierr)
298 CALL mpi_isend(iexch(iadc,2), len, mpi_integer, it_spmd(i),
299 . itag(2), spmd_comm_world, req(5), ierr)
300 CALL mpi_isend(rexch(iadc), len, real, it_spmd(i),
301 . itag(3), spmd_comm_world, req(6), ierr)
302C
303 CALL mpi_waitall(6, req, tstat, ierr)
304C
305 DO j=1,lenr
306 ir=irow(j)
307 ic=icol(j)
308 matr(ir,ic)=matr(ir,ic)+val(j)
309 ENDDO
310 DEALLOCATE(irow, icol, val)
311 ENDIF
312 ENDDO
313C
314#endif
315 RETURN
316 END
317!||====================================================================
318!|| spmd_ds_vexch ../engine/source/mpi/implicit/spmd_dsreso.F
319!||--- calls -----------------------------------------------------
320!||--- uses -----------------------------------------------------
321!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
322!||====================================================================
323 SUBROUTINE spmd_ds_vexch(VECT, N , IEXCH, REXCH, MSGOFF,
324 . IADS, IADR, NN , NV )
325C-----------------------------------------------
326C I m p l i c i t T y p e s
327C-----------------------------------------------
328 USE spmd_comm_world_mod, ONLY : spmd_comm_world
329#include "implicit_f.inc"
330C-----------------------------------------------
331C M e s s a g e P a s s i n g
332C-----------------------------------------------
333#include "spmd.inc"
334C-----------------------------------------------
335C C o m m o n B l o c k s
336C-----------------------------------------------
337#include "com01_c.inc"
338#include "task_c.inc"
339C-----------------------------------------------
340C D u m m y A r g u m e n t s
341C-----------------------------------------------
342 INTEGER N, IEXCH(*), MSGOFF, IADS(*), IADR(*), NN, NV
343 my_real
344 . vect(n,*), rexch(nn,*)
345C-----------------------------------------------
346C L o c a l V a r i a b l e s
347C-----------------------------------------------
348#ifdef MPI
349 INTEGER I, IADC, LEN, ITAG, J, K, IR, REQ(4),
350 . TSTAT(MPI_STATUS_SIZE, 4), IERR, II, LEN2, LENR
351 INTEGER, DIMENSION(:), ALLOCATABLE :: IROW
352 my_real
353 . , DIMENSION(:,:), ALLOCATABLE :: val, vals
354C
355 DO i=1,nspmd
356 IF (ispmd==i-1) THEN
357 iadc=iads(i)
358 len=iads(i+1)-iads(i)
359 DO j=1,nv
360 DO k=1,len
361 ir=iexch(iadc+k-1)
362 vect(ir,j)=vect(ir,j)+rexch(iadc+k-1,j)
363 ENDDO
364 ENDDO
365 ELSE
366C Reception
367 len=iadr(i+1)-iadr(i)
368 lenr=len
369 ii=0
370 IF (len>0) THEN
371 ALLOCATE(irow(len), val(len,nv))
372 itag=msgoff + nspmd*2*(i-1) + ispmd+1
373 ii=ii+1
374 CALL mpi_irecv(irow, len, mpi_integer, it_spmd(i),
375 . itag, spmd_comm_world, req(ii), ierr)
376 itag=msgoff + nspmd*2*(i-1) + nspmd + ispmd+1
377 len2=len*nv
378 ii=ii+1
379 CALL mpi_irecv(val, len2, real, it_spmd(i),
380 . itag, spmd_comm_world, req(ii), ierr)
381 ENDIF
382C Envoi
383 iadc=iads(i)
384 len=iads(i+1)-iads(i)
385 IF (len>0) THEN
386 itag=msgoff + nspmd*2*ispmd + i
387 ii=ii+1
388 CALL mpi_isend(iexch(iadc), len, mpi_integer, it_spmd(i),
389 . itag, spmd_comm_world, req(ii), ierr)
390 ALLOCATE(vals(len,nv))
391 DO j=1,nv
392 DO k=1,len
393 vals(k,j)=rexch(iadc+k-1,j)
394 ENDDO
395 ENDDO
396 itag=msgoff + nspmd*2*ispmd + nspmd + i
397 len2=len*nv
398 ii=ii+1
399 CALL mpi_isend(vals, len2, real, it_spmd(i),
400 . itag, spmd_comm_world, req(ii), ierr)
401 ENDIF
402C
403 IF (ii>0) CALL mpi_waitall(ii, req, tstat, ierr)
404C
405 DO j=1,nv
406 DO k=1,lenr
407 ir=irow(k)
408 vect(ir,j)=vect(ir,j)+val(k,j)
409 ENDDO
410 ENDDO
411 IF (len>0) DEALLOCATE(vals)
412 IF (lenr>0) DEALLOCATE(irow, val)
413 ENDIF
414 ENDDO
415C
416#endif
417 RETURN
418 END
419!||====================================================================
420!|| spmd_ds_vdesc ../engine/source/mpi/implicit/spmd_dsreso.F
421!||--- calls -----------------------------------------------------
422!||--- uses -----------------------------------------------------
423!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.f90
424!||====================================================================
425 SUBROUTINE spmd_ds_vdesc(V , NDEPL, VV, NDDLC, NLOC,
426 . MSGOFF)
427C-----------------------------------------------
428C I m p l i c i t T y p e s
429C-----------------------------------------------
430 USE spmd_comm_world_mod, ONLY : spmd_comm_world
431#include "implicit_f.inc"
432C-----------------------------------------------
433C M e s s a g e P a s s i n g
434C-----------------------------------------------
435#include "spmd.inc"
436C-----------------------------------------------
437C C o m m o n B l o c k s
438C-----------------------------------------------
439#include "com01_c.inc"
440#include "task_c.inc"
441C-----------------------------------------------
442C D u m m y A r g u m e n t s
443C-----------------------------------------------
444 INTEGER NDEPL, NDDLC, NLOC, MSGOFF
445 my_real
446 . V(NLOC,*), VV(NDDLC,*)
447C-----------------------------------------------
448C L o c a l V a r i a b l e s
449C-----------------------------------------------
450#ifdef MPI
451 INTEGER ITAG, LEN, IERR, I, NPLOC, IPROV,
452 . ISTAT(MPI_STATUS_SIZE), J, KK, IAD1, K
453 my_real
454 . , DIMENSION(:,:), ALLOCATABLE :: vp
455C
456 IF (ispmd/=0.AND.mod(ispmd,dsncol)==0) THEN
457 itag=msgoff + ispmd
458 CALL mpi_send(nloc, 1, mpi_integer, it_spmd(1), itag,
459 . spmd_comm_world, ierr)
460C
461 itag=msgoff + nspmd + ispmd
462 len=nloc*ndepl
463 CALL mpi_send(v, len, real, it_spmd(1), itag,
464 . spmd_comm_world, ierr)
465 ENDIF
466C
467 IF (ispmd==0) THEN
468 DO i=1,dsnrow
469 IF (i==1) THEN
470 nploc=nloc
471 ALLOCATE(vp(nploc,ndepl))
472 DO j=1,ndepl
473 DO k=1,nploc
474 vp(k,j)=v(k,j)
475 ENDDO
476 ENDDO
477 ELSE
478 iprov=(i-1)*dsncol+1
479 itag=msgoff + iprov-1
480 CALL mpi_recv(nploc, 1, mpi_integer, it_spmd(iprov),
481 . itag, spmd_comm_world, istat, ierr)
482C
483 itag=msgoff + nspmd + iprov-1
484 ALLOCATE(vp(nploc,ndepl))
485 len=nploc*ndepl
486 CALL mpi_recv(vp, len, real, it_spmd(iprov), itag,
487 . spmd_comm_world, istat, ierr)
488 ENDIF
489C
490 DO j=1,ndepl
491 kk=0
492 iad1=(i-1)*dsnbloc
493 DO k=1,nploc
494 iad1=iad1+1
495 kk=kk+1
496 IF (kk>dsnbloc) THEN
497 iad1=iad1+dsnbloc*(dsnrow-1)
498 kk=1
499 ENDIF
500 vv(iad1,j)=vp(k,j)
501 ENDDO
502 ENDDO
503 DEALLOCATE(vp)
504 ENDDO
505C
506 DO i=2,nspmd
507 itag=msgoff + 2*nspmd + i-1
508 len=nddlc*ndepl
509 CALL mpi_send(vv, len, real, it_spmd(i), itag,
510 . spmd_comm_world, ierr)
511 ENDDO
512 ELSE
513 itag=msgoff + 2*nspmd + ispmd
514 len=nddlc*ndepl
515 CALL mpi_recv(vv, len, real, it_spmd(1), itag,
516 . spmd_comm_world, istat, ierr)
517 ENDIF
518C
519#endif
520 RETURN
521 END
522!||====================================================================
523!|| spmd_iwlg ../engine/source/mpi/implicit/spmd_dsreso.F
524!||--- calls -----------------------------------------------------
525!||--- uses -----------------------------------------------------
526!|| spmd_comm_world_mod ../engine/source/mpi/spmd_comm_world.F90
527!||====================================================================
528 SUBROUTINE spmd_iwlg(NDDLT , NDDLG, NDDL, LSDDL, IW,
529 . MSGOFF)
530C-----------------------------------------------
531C I m p l i c i t T y p e s
532C-----------------------------------------------
533 USE spmd_comm_world_mod, ONLY : spmd_comm_world
534#include "implicit_f.inc"
535C-----------------------------------------------
536C M e s s a g e P a s s i n g
537C-----------------------------------------------
538#include "spmd.inc"
539C-----------------------------------------------
540C C o m m o n B l o c k s
541C-----------------------------------------------
542#include "com01_c.inc"
543#include "task_c.inc"
544C-----------------------------------------------
545C D u m m y A r g u m e n t s
546C-----------------------------------------------
547 INTEGER NDDLT, NDDLG, NDDL, LSDDL(*), IW(*), MSGOFF
548C-----------------------------------------------
549C L o c a l V a r i a b l e s
550C-----------------------------------------------
551#ifdef MPI
552 INTEGER I, ITAG(2,NDDLT), II, NDDLPM, IRQTAG, NDDLP(NSPMD-1),
553 . ISTAT(MPI_STATUS_SIZE), IERR, J, JJ, N
554 INTEGER, DIMENSION(:,:), ALLOCATABLE :: LDDLP
555C
556 IF (ispmd==0) THEN
557 DO i=1,nddlt
558 itag(1,i)=0
559 ENDDO
560C
561 DO i=1,nddl
562 ii=lsddl(i)
563 itag(1,ii)=1
564 ENDDO
565C
566 nddlpm=0
567 DO i=1,nspmd-1
568 irqtag=msgoff + i
569 CALL mpi_recv(nddlp(i), 1, mpi_integer, it_spmd(i+1),
570 . irqtag, spmd_comm_world, istat, ierr)
571 nddlpm=max(nddlpm,nddlp(i))
572 ENDDO
573 ALLOCATE(lddlp(nddlpm,nspmd-1))
574 DO i=1,nspmd-1
575 irqtag=msgoff + nspmd + i
576 CALL mpi_recv(
577 . lddlp(1,i), nddlp(i), mpi_integer, it_spmd(i+1),
578 . irqtag, spmd_comm_world, istat, ierr)
579 DO j=1,nddlp(i)
580 jj=lddlp(j,i)
581 itag(1,jj)=1
582 ENDDO
583 ENDDO
584C
585 n=0
586 DO i=1,nddlt
587 IF (itag(1,i)==1) THEN
588 n=n+1
589 itag(2,i)=n
590 ENDIF
591 ENDDO
592 nddlg=n
593C
594 DO i=1,nddl
595 ii=lsddl(i)
596 iw(i)=itag(2,ii)
597 ENDDO
598C
599 DO i=1,nspmd-1
600 DO j=1,nddlp(i)
601 jj=lddlp(j,i)
602 lddlp(j,i)=itag(2,jj)
603 ENDDO
604 irqtag=msgoff + 2*nspmd + i
605 CALL mpi_send(nddlg, 1, mpi_integer, it_spmd(i+1),
606 . irqtag, spmd_comm_world, ierr)
607 irqtag=msgoff + 3*nspmd + i
608 CALL mpi_send(
609 . lddlp(1,i), nddlp(i), mpi_integer, it_spmd(i+1),
610 . irqtag, spmd_comm_world, ierr)
611 ENDDO
612 DEALLOCATE(lddlp)
613 ELSE
614 irqtag=msgoff + ispmd
615 CALL mpi_send(nddl, 1, mpi_integer, it_spmd(1),
616 . irqtag, spmd_comm_world, ierr)
617 irqtag=msgoff + nspmd + ispmd
618 CALL mpi_send(lsddl, nddl, mpi_integer, it_spmd(1),
619 . irqtag, spmd_comm_world, ierr)
620 irqtag=msgoff + 2*nspmd + ispmd
621 CALL mpi_recv(nddlg, 1, mpi_integer, it_spmd(1),
622 . irqtag, spmd_comm_world, istat, ierr)
623 irqtag=msgoff + 3*nspmd + ispmd
624 CALL mpi_recv(iw, nddl, mpi_integer, it_spmd(1),
625 . irqtag, spmd_comm_world, istat, ierr)
626 ENDIF
627C
628#endif
629 RETURN
630 END
631
my_real
#define my_real
Definition cppsort.cpp:32
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_waitall
subroutine mpi_waitall(cnt, array_of_requests, status, ierr)
Definition mpi.f:536
mpi_send
subroutine mpi_send(buf, cnt, datatype, dest, tag, comm, ierr)
Definition mpi.f:480
mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372
spmd_ds_iexch
subroutine spmd_ds_iexch(sbuf, rbuf, size, msgoff)
Definition spmd_dsreso.F:184
spmd_ds_vexch
subroutine spmd_ds_vexch(vect, n, iexch, rexch, msgoff, iads, iadr, nn, nv)
Definition spmd_dsreso.F:325
spmd_ds_mexch
subroutine spmd_ds_mexch(matr, n, iexch, rexch, msgoff, iads, iadr, nn)
Definition spmd_dsreso.F:237
spmd_ds_irecv
subroutine spmd_ds_irecv(buf, size, itag, iprov)
Definition spmd_dsreso.F:107
spmd_ds_vdesc
subroutine spmd_ds_vdesc(v, ndepl, vv, nddlc, nloc, msgoff)
Definition spmd_dsreso.F:427
spmd_ds_rsend
subroutine spmd_ds_rsend(buf, size, itag, idest)
Definition spmd_dsreso.F:69
spmd_ds_rrecv
subroutine spmd_ds_rrecv(buf, size, itag, iprov)
Definition spmd_dsreso.F:146
spmd_iwlg
subroutine spmd_iwlg(nddlt, nddlg, nddl, lsddl, iw, msgoff)
Definition spmd_dsreso.F:530
spmd_ds_isend
subroutine spmd_ds_isend(buf, size, itag, idest)
Definition spmd_dsreso.F:30