Updated broadcast of stars datatype

main/fleur_init.F90

@@ -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

mpi/CMakeLists.txt

@@ -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()

mpi/mpi_bc_all.F90

@@ -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,20 +192,8 @@ 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)
     CALL MPI_BCAST(input%zelec,1,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

mpi/mpi_bc_tool.F90

+!--------------------------------------------------------------------------------
+! 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