Commit 1fe28a01 authored by Daniel Wortmann's avatar Daniel Wortmann

Updated broadcast of stars datatype

parent 930c4c10
......@@ -278,6 +278,8 @@
END IF
END IF
ALLOCATE (stars%igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1))
ALLOCATE (stars%igq2_fft(0:stars%kq1_fft*stars%kq2_fft-1))
#ifdef CPP_MPI
CALL mpi_bc_all(&
& mpi,stars,sphhar,atoms,obsolete,&
......@@ -288,8 +290,6 @@
! Set up pointer for backtransformation from g-vector in positive
! domain of carge density fftibox into stars
ALLOCATE (stars%igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1))
ALLOCATE (stars%igq2_fft(0:stars%kq1_fft*stars%kq2_fft-1))
CALL prp_qfft_map(stars,sym,input,stars%igq2_fft,stars%igq_fft)
atoms%nlotot = 0
......
......@@ -14,5 +14,7 @@ if (${FLEUR_USE_MPI})
mpi/mpi_reduce_potden.F90
mpi/mpi_make_groups.F90
mpi/mpi_dist_forcetheorem.F90
mpi/mpi_bc_tool.F90
)
endif()
......@@ -46,6 +46,8 @@ CONTAINS
#ifdef CPP_MPI
EXTERNAL MPI_BCAST
call priv_mpi_bc_stars(mpi,stars)
IF (mpi%irank.EQ.0) THEN
i(1)=1 ; i(2)=input%coretail_lmax;i(3)=atoms%ntype ; i(5)=1 ; i(6)=input%isec1
i(7)=stars%ng2 ; i(8)=stars%ng3 ; i(9)=vacuum%nmz ; i(10)=vacuum%nmzxy ; i(11)=obsolete%lepr
......@@ -134,7 +136,7 @@ CONTAINS
CALL MPI_BCAST (field%efield%C2,n,MPI_REAL,0,mpi%mpi_comm,ierr)
END IF
CALL MPI_BCAST(stars%ustep,stars%ng3,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
n = sphhar%memd*(sphhar%nlhd+1)*sphhar%ntypsd
CALL MPI_BCAST(sphhar%clnu,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sphhar%mlh,n,MPI_INTEGER,0,mpi%mpi_comm,ierr)
......@@ -152,17 +154,14 @@ CONTAINS
CALL MPI_BCAST(sym%invsatnr,atoms%nat,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%ngopr,atoms%nat,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sym%mrot,9*sym%nop,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%ig2,stars%ng3,MPI_INTEGER,0,mpi%mpi_comm,ierr)
n = (2*stars%mx1+1)*(2*stars%mx2+1)*(2*stars%mx3+1)
CALL MPI_BCAST(stars%ig,n,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%rgphs,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%ellow,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%elup,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%rkmax,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%rmt,atoms%ntype,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%volmts,atoms%ntype,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%dx,atoms%ntype,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%sk3,stars%ng3,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(enpara%evac0,2*dimension%jspd*1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%amat,9,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%bmat,9,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
......@@ -193,19 +192,7 @@ CONTAINS
CALL MPI_BCAST(sym%invarind,atoms%nat,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sym%invtab,sym%nop,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sym%invsatnr,atoms%nat,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%kq2_fft,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%kq3_fft,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%kv2,2*stars%ng2,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%kv3,3*stars%ng3,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%ng3_fft,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(vacuum%izlay,vacuum%layerd*2,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%nstr,stars%ng3,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%nstr2,stars%ng2,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%igfft,size(stars%igfft),MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%kq1_fft,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%kmxq_fft,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%pgfft,size(stars%pgfft),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%igfft2,size(stars%igfft2),MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%zatom,atoms%ntype,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(field%efield%sig_b,2,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
......@@ -238,10 +225,8 @@ CONTAINS
n = 7*7*3*sym%nop
CALL MPI_BCAST(sym%d_wgn,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(oneD%nstr1,oneD%odd%n2d,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%sk2,stars%ng2,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(oneD%tau1,3*oneD%odd%nop,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
IF (oneD%odd%d1) THEN
CALL MPI_BCAST(stars%phi2,stars%ng2,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(oneD%tau1,3*oneD%odd%nop,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(oneD%mrot1,9*oneD%odd%nop,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(oneD%kv1,2*oneD%odd%n2d,MPI_INTEGER,0,mpi%mpi_comm,ierr)
......@@ -282,4 +267,50 @@ CONTAINS
RETURN
#endif
END SUBROUTINE mpi_bc_all
SUBROUTINE priv_mpi_bc_stars(mpi,stars)
USE m_types
USE m_mpi_bc_tool
IMPLICIT NONE
TYPE(t_mpi),INTENT(in)::mpi
TYPE(t_stars),INTENT(inout)::stars
include 'mpif.h'
INTEGER :: i(18),ierr,ft2_gf_dim
i(1)=stars%ng2 ; i(2)=stars%ng3 ; i(3)=stars%mx1 ; i(4)=stars%mx2 ; i(5)=stars%mx3
i(6) = stars%kimax ; i(7) = stars%kimax2 ; i(8)=size(stars%ft2_gfy)
i(9) = stars%kq1_fft;i(10) = stars%kq2_fft;i(11) = stars%kq3_fft;i(12)=stars%kmxq_fft
i(13)= stars%kxc1_fft;i(14)= stars%kxc2_fft;i(15)= stars%kxc3_fft
i(16)= stars%ng3_fft;i(17)= stars%kmxxc_fft;i(18)= stars%nxc3_fft
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,0,mpi%mpi_comm,ierr)
stars%ng2=i(1) ; stars%ng3=i(2) ; stars%mx1=i(3) ; stars%mx2=i(4) ; stars%mx3=i(5)
stars%kimax=i(6) ; stars%kimax2=i(7) ; ft2_gf_dim=i(8)
stars%kq1_fft=i(9);stars%kq2_fft=i(10); stars%kq3_fft=i(11);stars%kmxq_fft=i(12)
stars%kxc1_fft=i(13);stars%kxc2_fft=i(14);stars%kxc3_fft=i(15)
stars%ng3_fft=i(16);stars%kmxxc_fft=i(17);stars%nxc3_fft=i(18)
CALL mpi_bc(stars%ustep,0,mpi%mpi_comm)
CALL mpi_bc(stars%ig2,0,mpi%mpi_comm)
CALL mpi_bc(stars%ig,0,mpi%mpi_comm)
CALL mpi_bc(stars%rgphs,0,mpi%mpi_comm)
CALL mpi_bc(stars%sk3,0,mpi%mpi_comm)
CALL mpi_bc(stars%kv2,0,mpi%mpi_comm)
CALL mpi_bc(stars%kv3,0,mpi%mpi_comm)
CALL mpi_bc(stars%nstr,0,mpi%mpi_comm)
CALL mpi_bc(stars%nstr2,0,mpi%mpi_comm)
CALL mpi_bc(stars%igfft,0,mpi%mpi_comm)
CALL mpi_bc(stars%pgfft,0,mpi%mpi_comm)
CALL mpi_bc(stars%igfft2,0,mpi%mpi_comm)
CALL mpi_bc(stars%sk2,0,mpi%mpi_comm)
CALL mpi_bc(stars%phi2,0,mpi%mpi_comm)
CALL mpi_bc(stars%ufft,0,mpi%mpi_comm)
CALL mpi_bc(stars%igq2_fft,0,mpi%mpi_comm)
CALL mpi_bc(stars%igq_fft,0,mpi%mpi_comm)
CALL mpi_bc(stars%pgfft2,0,mpi%mpi_comm)
CALL mpi_bc(stars%ft2_gfx,0,mpi%mpi_comm)
CALL mpi_bc(stars%ft2_gfy,0,mpi%mpi_comm)
END SUBROUTINE priv_mpi_bc_stars
END MODULE m_mpi_bc_all
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_mpi_bc_tool
USE m_judft
IMPLICIT NONE
PRIVATE
INCLUDE 'mpif.h'
!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
MODULE PROCEDURE :: mpi_bc_int,mpi_bc_int1,mpi_bc_int2,mpi_bc_int3,mpi_bc_int4,mpi_bc_int5
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
PUBLIC :: mpi_bc
CONTAINS
SUBROUTINE mpi_bc_int(i,irank,mpi_comm)
IMPLICIT NONE
INTEGER,INTENT(INOUT):: i
INTEGER,INTENT(IN) :: mpi_comm,irank
INTEGER:: ierr
CALL MPI_BCAST(i,1,MPI_INTEGER,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int
SUBROUTINE mpi_bc_int1(i,irank,mpi_comm)
IMPLICIT NONE
INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(1),iup(1),myrank
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(i)
iup=UBOUND(i)
END IF
CALL MPI_BCAST(ilow,1,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,1,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(i)) DEALLOCATE(i)
ALLOCATE(i(ilow(1):iup(1)))
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int1
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
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(i)
iup=UBOUND(i)
END IF
CALL MPI_BCAST(ilow,2,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,2,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(i)) DEALLOCATE(i)
ALLOCATE(i(ilow(1):iup(1),ilow(2):iup(2)))
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int2
SUBROUTINE mpi_bc_int3(i,irank,mpi_comm)
IMPLICIT NONE
INTEGER,ALLOCATABLE,INTENT(INOUT) :: i(:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(3),iup(3),myrank
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(i)
iup=UBOUND(i)
END IF
CALL MPI_BCAST(ilow,3,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,3,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(i)) DEALLOCATE(i)
ALLOCATE(i(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3)))
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int3
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
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(i)
iup=UBOUND(i)
END IF
CALL MPI_BCAST(ilow,4,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,4,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(i)) DEALLOCATE(i)
ALLOCATE(i(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4)))
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int4
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
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(i)
iup=UBOUND(i)
END IF
CALL MPI_BCAST(ilow,5,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,5,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(i)) DEALLOCATE(i)
ALLOCATE(i(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4),ilow(5):iup(5)))
ENDIF
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_int5
!
! now the same for reals
!
SUBROUTINE mpi_bc_real(r,irank,mpi_comm)
IMPLICIT NONE
REAL,INTENT(INOUT) :: r
INTEGER,INTENT(IN) :: mpi_comm,irank
INTEGER:: ierr
CALL MPI_BCAST(r,1,MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real
SUBROUTINE mpi_bc_real1(r,irank,mpi_comm)
IMPLICIT NONE
REAL ,ALLOCATABLE,INTENT(INOUT) :: r(:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(1),iup(1),myrank
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(r)
iup=UBOUND(r)
END IF
CALL MPI_BCAST(ilow,1,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,1,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(r)) DEALLOCATE(r)
ALLOCATE(r(ilow(1):iup(1)))
ENDIF
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real1
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
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(r)
iup=UBOUND(r)
END IF
CALL MPI_BCAST(ilow,2,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,2,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(r)) DEALLOCATE(r)
ALLOCATE(r(ilow(1):iup(1),ilow(2):iup(2)))
ENDIF
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real2
SUBROUTINE mpi_bc_real3(r,irank,mpi_comm)
IMPLICIT NONE
REAL ,ALLOCATABLE,INTENT(INOUT) :: r(:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(3),iup(3),myrank
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(r)
iup=UBOUND(r)
END IF
CALL MPI_BCAST(ilow,3,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,3,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(r)) DEALLOCATE(r)
ALLOCATE(r(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3)))
ENDIF
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real3
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
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(r)
iup=UBOUND(r)
END IF
CALL MPI_BCAST(ilow,4,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,4,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(r)) DEALLOCATE(r)
ALLOCATE(r(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4)))
ENDIF
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real4
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
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(r)
iup=UBOUND(r)
END IF
CALL MPI_BCAST(ilow,5,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,5,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(r)) DEALLOCATE(r)
ALLOCATE(r(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4),ilow(5):iup(5)))
ENDIF
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_real5
!
! And Complex!!
!
SUBROUTINE mpi_bc_complex(c,irank,mpi_comm)
IMPLICIT NONE
COMPLEX,INTENT(INOUT) :: c
INTEGER,INTENT(IN) :: mpi_comm,irank
INTEGER:: ierr
CALL MPI_BCAST(c,1,MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex
SUBROUTINE mpi_bc_complex1(c,irank,mpi_comm)
IMPLICIT NONE
COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(1),iup(1),myrank
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(c)
iup=UBOUND(c)
END IF
CALL MPI_BCAST(ilow,1,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,1,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(c)) DEALLOCATE(c)
ALLOCATE(c(ilow(1):iup(1)))
ENDIF
CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex1
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
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(c)
iup=UBOUND(c)
END IF
CALL MPI_BCAST(ilow,2,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,2,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(c)) DEALLOCATE(c)
ALLOCATE(c(ilow(1):iup(1),ilow(2):iup(2)))
ENDIF
CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex2
SUBROUTINE mpi_bc_complex3(c,irank,mpi_comm)
IMPLICIT NONE
COMPLEX,ALLOCATABLE,INTENT(INOUT) :: c(:,:,:)
INTEGER,INTENT(IN) :: irank,mpi_comm
INTEGER:: ierr,ilow(3),iup(3),myrank
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(c)
iup=UBOUND(c)
END IF
CALL MPI_BCAST(ilow,3,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,3,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(c)) DEALLOCATE(c)
ALLOCATE(c(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3)))
ENDIF
CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex3
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
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(c)
iup=UBOUND(c)
END IF
CALL MPI_BCAST(ilow,4,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,4,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(c)) DEALLOCATE(c)
ALLOCATE(c(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4)))
ENDIF
CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex4
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
CALL MPI_COMM_RANK(mpi_comm,myrank,ierr)
IF (myrank==irank) THEN
ilow=LBOUND(c)
iup=UBOUND(c)
END IF
CALL MPI_BCAST(ilow,5,MPI_INTEGER,0,mpi_comm,ierr)
CALL MPI_BCAST(iup,5,MPI_INTEGER,0,mpi_comm,ierr)
IF (myrank.NE.irank) THEN
IF (ALLOCATED(c)) DEALLOCATE(c)
ALLOCATE(c(ilow(1):iup(1),ilow(2):iup(2),ilow(3):iup(3),ilow(4):iup(4),ilow(5):iup(5)))
ENDIF
CALL MPI_BCAST(c,SIZE(c),MPI_DOUBLE_COMPLEX,irank,mpi_comm,ierr)
IF (ierr.NE.0) CALL judft_error("MPI_BCAST failed")
END SUBROUTINE mpi_bc_complex5
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