在Fortran90,MPI_Gather中收集2D数组

时间:2017-11-19 15:56:59

标签: fortran mpi fortran90

我在使用Fortran中的MPI将几个2D数组合并到一个大的2D数组中时遇到了问题。

我有相同大小的2D数组包含实数,每个数组都包含在不同的过程中:

numerical(subdsize,nt)

我想将它们组合成一个大数组

numerical_final(nx,nt)

我正在使用以下命令

CALL MPI_Gather(numerical(1:subdsize,nt),subdsize*nt,MPI_DOUBLE_PRECISION,numerical_final,subdsize*nt,MPI_DOUBLE_PRECISION,0, MPI_COMM_WORLD, mpierror) 

不幸的是,numeric_final数组包含的数据完全混乱。我到处寻找解决方案。我读了这个主题,但它没有帮助我:

sending blocks of 2D array in C using MPI

我正在使用英特尔Fortran 2018编译器和Ubuntu 16.04。

以下完整代码。

我将非常感谢你的帮助。

    PROGRAM Advection

IMPLICIT NONE
INCLUDE 'mpif.h'

INTEGER :: nt,nx,i,steptime,tag,j
DOUBLE PRECISION :: R_dx, R_dt, R_c, R_cfl, R_t
DOUBLE PRECISION, DIMENSION(3) :: R_input
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: xcoord
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: numerical, numerical_final
DOUBLE PRECISION :: time_begin,time_end,time_elapsed
INTEGER:: myrank,nproc,mpierror,xdomains,subdsize
INTEGER:: status(MPI_STATUS_SIZE) 

CALL MPI_Init(mpierror)
CALL MPI_Comm_size(MPI_COMM_WORLD,nproc,mpierror)
CALL MPI_Comm_rank(MPI_COMM_WORLD,myrank,mpierror)

IF (nproc<2) THEN
    PRINT*, "Error, only more than 1"
    CALL MPI_ABORT
END IF

IF (myrank .EQ. 0) THEN
    OPEN(UNIT = 1, FILE = 'inputdata.dat')
    READ(1,*) R_input(1)
    READ(1,*) R_input(2)
    READ(1,*) R_input(3)
    READ(1,*) nx
    CLOSE(1)
END IF

CALL MPI_Bcast(R_input, 3, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, mpierror)
CALL MPI_Bcast(nx, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, mpierror)

R_c=R_input(1)
R_cfl=R_input(2)
R_t=R_input(3)    

R_dx=80./(nx-1)
nt=15
R_dt=R_t/(nt-1)
IF (myrank .EQ. 0) THEN
    PRINT*, R_c*R_dt/R_dx
END IF

xdomains = nproc
IF ((MOD(nx,xdomains))==0) THEN
    subdsize =nx/xdomains
    ELSE
    DO
        nx=nx+1
        IF ((MOD(nx,xdomains)) .EQ. 0) THEN
            subdsize=nx/xdomains
            EXIT
        END IF
    END DO
END IF
RAYS
ALLOCATE(xcoord(0:subdsize+1))
ALLOCATE(numerical(0:subdsize+1,nt))

DO i=0,subdsize+1
    xcoord(i) = -40.-R_dx+i*R_dx+myrank*R_dx*subdsize
END DO

DO i = 0,subdsize+1
    numerical(i,1)=0.5*(sign(1.,xcoord(i))+1.0)
END DO

IF (myrank .EQ. 0) THEN
    DO i=1,nt
        numerical(0:1,i)=0.
    END DO
END IF    

IF (myrank .EQ. nproc-1) THEN
    DO i=1,nt
        numerical(subdsize:subdsize+1,i)=1.
    END DO    
END IF

DO steptime=1, nt-1 

    tag = 1
    IF (myrank .LT. nproc-1) THEN
        CALL MPI_Send (numerical(subdsize,steptime),1,MPI_DOUBLE_PRECISION,myrank+1,tag,MPI_COMM_WORLD,mpierror)
    END IF
    IF (myrank .GT. 0) THEN
        CALL MPI_Recv (numerical(0,steptime),1,MPI_DOUBLE_PRECISION,myrank-1,tag,MPI_COMM_WORLD,status,mpierror )
    END IF

IF (myrank .EQ. 0) THEN
    DO i = 2, subdsize+1
        numerical(i,steptime+1)=numerical(i,steptime)-R_c*R_dt/R_dx*(numerical(i,steptime)-numerical(i-1,steptime))
    END DO
ELSE
    DO i = 1, subdsize+1
        numerical(i,steptime+1)=numerical(i,steptime)-R_c*R_dt/R_dx*(numerical(i,steptime)-numerical(i-1,steptime))
    END DO
END IF

END DO

ALLOCATE(numerical_final(nx,nt))

CALL MPI_Gather(numerical(1:subdsize,nt),subdsize*nt,MPI_DOUBLE_PRECISION,numerical_final,subdsize*nt,MPI_DOUBLE_PRECISION,0, MPI_COMM_WORLD, mpierror)    

CALL MPI_Finalize(mpierror) 
DEALLOCATE (numerical,numerical_final)
END PROGRAM

和inputfile

1.5         !c
0.5         !Courant
5.0         !time
100         !x points

0 个答案:

没有答案