Commit 73bbd502 authored by Daniel Wortmann's avatar Daniel Wortmann

Bugfix in mpi_bc_tool

parent 57bbef98
......@@ -10,6 +10,7 @@ MODULE m_mpi_bc_tool
PRIVATE
#ifdef CPP_MPI
INCLUDE 'mpif.h'
#endif
!This interface is used to broadcast data. On the recieving PE the data-array is first allocated to
!have the same shape as the one on irank
INTERFACE mpi_bc
......@@ -17,11 +18,7 @@ MODULE m_mpi_bc_tool
MODULE PROCEDURE mpi_bc_real,mpi_bc_real1,mpi_bc_real2,mpi_bc_real3,mpi_bc_real4,mpi_bc_real5
MODULE PROCEDURE mpi_bc_complex,mpi_bc_complex1,mpi_bc_complex2,mpi_bc_complex3,mpi_bc_complex4,mpi_bc_complex5
END INTERFACE mpi_bc
#else
INTEGER,PARAMETER :: mpi_bc=0 !dummy in serial case
#endif
PUBLIC :: mpi_bc
#ifdef CPP_MPI
CONTAINS
SUBROUTINE mpi_bc_int(i,irank,mpi_comm)
IMPLICIT NONE
......@@ -30,8 +27,9 @@ CONTAINS
INTEGER:: ierr
#ifdef CPP_MPI
CALL MPI_BCAST(i,1,MPI_INTEGER,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int
......@@ -39,9 +37,10 @@ CONTAINS
IMPLICIT NONE
INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(1),iup(1),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -58,15 +57,17 @@ CONTAINS
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
#endif
END SUBROUTINE mpi_bc_int1
SUBROUTINE mpi_bc_int2(i,irank,mpi_comm)
SUBROUTINE mpi_bc_int2(i,irank,mpi_comm)
IMPLICIT NONE
INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(2),iup(2),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -81,7 +82,7 @@ CONTAINS
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int2
......@@ -89,9 +90,10 @@ CONTAINS
IMPLICIT NONE
INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(3),iup(3),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -106,17 +108,18 @@ CONTAINS
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int3
SUBROUTINE mpi_bc_int4(i,irank,mpi_comm)
SUBROUTINE mpi_bc_int4(i,irank,mpi_comm)
IMPLICIT NONE
INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(4),iup(4),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -131,17 +134,18 @@ CONTAINS
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int4
SUBROUTINE mpi_bc_int5(i,irank,mpi_comm)
SUBROUTINE mpi_bc_int5(i,irank,mpi_comm)
IMPLICIT NONE
INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(5),iup(5),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -156,7 +160,7 @@ CONTAINS
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int5
......@@ -164,16 +168,17 @@ CONTAINS
! now the same for reals
!
SUBROUTINE mpi_bc_real(r,irank,mpi_comm)
SUBROUTINE mpi_bc_real(r,irank,mpi_comm)
IMPLICIT NONE
REAL,INTENT(INOUT) :: r
INTEGER,INTENT(IN) :: mpi_comm,irank
INTEGER:: ierr
#ifdef CPP_MPI
CALL MPI_BCAST(r,1,MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real
......@@ -181,10 +186,10 @@ CONTAINS
IMPLICIT NONE
REAL ,ALLOCATABLE,INTENT(INOUT) :: r(:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(1),iup(1),myrank
INTEGER:: ierr,ilow(1),iup(1),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(r)
......@@ -198,17 +203,18 @@ CONTAINS
ENDIF
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real1
SUBROUTINE mpi_bc_real2(r,irank,mpi_comm)
SUBROUTINE mpi_bc_real2(r,irank,mpi_comm)
IMPLICIT NONE
REAL ,ALLOCATABLE,INTENT(INOUT) :: r(:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(2),iup(2),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -223,6 +229,7 @@ CONTAINS
ENDIF
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real2
......@@ -231,9 +238,10 @@ CONTAINS
IMPLICIT NONE
REAL ,ALLOCATABLE,INTENT(INOUT) :: r(:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(3),iup(3),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -248,16 +256,18 @@ CONTAINS
ENDIF
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real3
SUBROUTINE mpi_bc_real4(r,irank,mpi_comm)
SUBROUTINE mpi_bc_real4(r,irank,mpi_comm)
IMPLICIT NONE
REAL ,ALLOCATABLE,INTENT(INOUT) :: r(:,:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(4),iup(4),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
......@@ -274,15 +284,17 @@ CONTAINS
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real4
SUBROUTINE mpi_bc_real5(r,irank,mpi_comm)
SUBROUTINE mpi_bc_real5(r,irank,mpi_comm)
IMPLICIT NONE
REAL ,ALLOCATABLE,INTENT(INOUT) :: r(:,:,:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(5),iup(5),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
......@@ -298,6 +310,7 @@ CONTAINS
ENDIF
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real5
......@@ -312,8 +325,10 @@ CONTAINS
INTEGER,INTENT(IN) :: mpi_comm,irank
INTEGER:: ierr
#ifdef CPP_MPI
CALL MPI_BCAST(c,1,MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex
......@@ -322,9 +337,10 @@ CONTAINS
IMPLICIT NONE
COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(1),iup(1),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
......@@ -339,16 +355,18 @@ CONTAINS
ENDIF
CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex1
SUBROUTINE mpi_bc_complex2(c,irank,mpi_comm)
SUBROUTINE mpi_bc_complex2(c,irank,mpi_comm)
IMPLICIT NONE
COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(2),iup(2),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
......@@ -364,6 +382,7 @@ CONTAINS
ENDIF
CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex2
......@@ -372,8 +391,9 @@ CONTAINS
IMPLICIT NONE
COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(3),iup(3),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
......@@ -389,16 +409,18 @@ CONTAINS
ENDIF
CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex3
SUBROUTINE mpi_bc_complex4(c,irank,mpi_comm)
SUBROUTINE mpi_bc_complex4(c,irank,mpi_comm)
IMPLICIT NONE
COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:,:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(4),iup(4),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
......@@ -414,16 +436,18 @@ CONTAINS
ENDIF
CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex4
SUBROUTINE mpi_bc_complex5(c,irank,mpi_comm)
SUBROUTINE mpi_bc_complex5(c,irank,mpi_comm)
IMPLICIT NONE
COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:,:,:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(5),iup(5),myrank
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
......@@ -440,7 +464,7 @@ CONTAINS
CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
#endif
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex5
#endif
END MODULE m_mpi_bc_tool
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment