mirror of
https://code.it4i.cz/sccs/easyconfigs-it4i.git
synced 2025-04-17 20:20:49 +01:00
83 lines
1.8 KiB
Fortran
Executable File
83 lines
1.8 KiB
Fortran
Executable File
SUBROUTINE DCOMMUNICATE3(A,LEN,scr,b)
|
|
C MEH JUNE 2005
|
|
C this routine communicates an array of double precisions
|
|
C
|
|
C A: array that will be updated on all processors
|
|
C SCR: array of same length that is used as scratch
|
|
C LEN: length of a and scr
|
|
C
|
|
C Before this routine every node has a different version of
|
|
C the array A. During its run rank0 (the master node) will
|
|
C accumulate all these versions to give the complete array A.
|
|
C After the routine all nodes will have the complete version
|
|
C of a by broadcast.
|
|
|
|
C*****PARALLEL CODE: MPI*****BEGIN
|
|
#if defined (MPI)
|
|
#include "MRCCCOMMON"
|
|
C
|
|
INTEGER LEN,j,nleft,ioff
|
|
real*8 SCR(mpibfl),B(mpibfl),A(LEN)
|
|
C
|
|
nleft=len
|
|
C
|
|
if (nleft.le.mpibfl) then
|
|
C
|
|
do j=1,nleft
|
|
scr(j)=0.d0
|
|
B(j)=A(j)
|
|
end do
|
|
C
|
|
call mpi_allreduce(B,SCR,LEN,MPI_DOUBLE_PRECISION,MPI_SUM,
|
|
& MPI_COMM_WORLD,MPIERR)
|
|
do j=1,nleft
|
|
a(j)=scr(j)
|
|
end do
|
|
|
|
else
|
|
ioff=0
|
|
|
|
100 do j=1,mpibfl
|
|
scr(j)=0.d0
|
|
b(j)=a(j+ioff)
|
|
end do
|
|
|
|
call mpi_allreduce(B,SCR,mpibfl,
|
|
& MPI_DOUBLE_PRECISION,MPI_SUM,
|
|
& MPI_COMM_WORLD,MPIERR)
|
|
|
|
do j=1,mpibfl
|
|
a(j+ioff)=scr(j)
|
|
end do
|
|
|
|
ioff=ioff+mpibfl
|
|
nleft=nleft-mpibfl
|
|
if (nleft.ge.mpibfl) then
|
|
goto 100
|
|
end if
|
|
|
|
if (nleft.gt.0) then
|
|
|
|
do j=1,nleft
|
|
scr(j)=0.d0
|
|
b(j)=a(j+ioff)
|
|
end do
|
|
|
|
call mpi_allreduce(B,SCR,nleft,MPI_DOUBLE_PRECISION,
|
|
& MPI_SUM,
|
|
& MPI_COMM_WORLD,MPIERR)
|
|
|
|
do j=1,nleft
|
|
a(j+ioff)=scr(j)
|
|
end do
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
#endif
|
|
C*****PARALLEL CODE: MPI*****END
|
|
RETURN
|
|
END
|
|
|