Commit 7cff86cd authored by Daniel Wortmann's avatar Daniel Wortmann

First fixes for MPI

parent 1e255f28
......@@ -92,6 +92,7 @@ contains
IF (ALL(inDen%mmpMat==0.0)) THEN
l_densitymatrix=.FALSE.
inDen%mmpMat=outDen%mmpMat
if (mpi%irank.ne.0) inden%mmpmat=0.0
ENDIF
ENDIF
CALL mixvector_init(mpi%mpi_comm,l_densitymatrix,oneD,input,vacuum,noco,sym,stars,cell,sphhar,atoms)
......
......@@ -83,10 +83,10 @@ CONTAINS
USE m_types
IMPLICIT NONE
CLASS(t_mixvector),INTENT(INOUT) :: vec
TYPE(t_potden), INTENT(in) :: Den
TYPE(t_potden), INTENT(inout) :: Den
LOGICAL,INTENT(IN),OPTIONAL :: swapspin
INTEGER:: js,ii,n,l,iv,j
PRINT *,"TODO MPI distribute density"
call den%distribute(mix_mpi_comm)
DO js=1,MERGE(jspins,3,.NOT.l_noco)
j=js
IF (PRESENT(swapspin)) THEN
......@@ -208,7 +208,7 @@ CONTAINS
END IF
END IF
ENDDO
PRINT *,"TODO MPI collect density"
call den%collect(mix_mpi_comm)
END SUBROUTINE mixvector_to_density
......@@ -562,13 +562,14 @@ CONTAINS
FUNCTION multiply_dot(vec1,vec2)RESULT(dprod)
TYPE(t_mixvector),INTENT(IN)::vec1,vec2
REAL ::dprod
REAL ::dprod,dprod_tmp
dprod=dot_PRODUCT(vec1%vec_pw,vec2%vec_pw)
dprod=dprod+dot_PRODUCT(vec1%vec_mt,vec2%vec_mt)
dprod=dprod+dot_PRODUCT(vec1%vec_vac,vec2%vec_vac)
dprod=dprod+dot_PRODUCT(vec1%vec_misc,vec2%vec_misc)
#ifdef CPP_MPI
CALL MPI_REDUCE_ALL()
CALL MPI_ALLREDUCE_ALL(dprod,dprod_tmp,1,MPI_DOUBLE_PRECISION,MPI_SUM,mix_mpi_comm)
dprod=dprod_tmp
#endif
END FUNCTION multiply_dot
......@@ -577,7 +578,7 @@ CONTAINS
TYPE(t_mixvector),INTENT(IN)::vec2
LOGICAL,INTENT(IN) ::mask(4)
INTEGER,INTENT(IN) ::spin
REAL ::dprod
REAL ::dprod,dprod_tmp
INTEGER:: js
......@@ -597,9 +598,10 @@ CONTAINS
dprod=dprod+dot_PRODUCT(vec1%vec_misc(misc_start(js):misc_stop(js)),&
vec2%vec_misc(misc_start(js):misc_stop(js)))
enddo
#ifdef CPP_MPI
CALL MPI_REDUCE_ALL()
#endif
CALL MPI_ALLREDUCE_ALL(dprod,dprod_tmp,1,MPI_DOUBLE_PRECISION,MPI_SUM,mix_mpi_comm)
dprod=dprod_tmp
#endif
END FUNCTION multiply_dot_mask
end MODULE m_types_mixvector
......@@ -41,10 +41,76 @@ MODULE m_types_potden
procedure :: ChargeAndMagnetisationToSpins
procedure :: addPotDen
procedure :: subPotDen
procedure :: distribute
procedure :: collect
END TYPE t_potden
CONTAINS
subroutine collect(this,mpi_comm)
use m_mpi_bc_tool
implicit none
class(t_potden),INTENT(INOUT) :: this
integer :: mpi_comm
#ifdef CPP_MPI
include 'mpif.h'
real,ALLOCATABLE::rtmp(:)
complex,ALLOCATABLE::ctmp(:)
!pw
ALLOCATE(ctmp(size(this%pw)))
CALL MPI_REDUCE(this%pw,ctmp,size(this%pw),MPI_DOUBLE_COMPLEX,MPI_SUM,0,mpi_comm,ierr)
if (irank==0) this%pw=reshape(ctmp,shape(this%pw))
deallocate(ctmp)
!mt
ALLOCATE(rtmp(size(this%mt)))
CALL MPI_REDUCE(this%mt,rtmp,size(this%mt),MPI_DOUBLE_PRECISION,MPI_SUM,0,mpi_comm,ierr)
if (irank==0) this%mt=reshape(rtmp,shape(this%mt))
deallocate(rtmp)
!vac
if (allocated(this%vacz)) THEN
ALLOCATE(rtmp(size(this%vacz)))
CALL MPI_REDUCE(this%vacz,rtmp,size(this%vacz),MPI_DOUBLE_PRECISION,MPI_SUM,0,mpi_comm,ierr)
if (irank==0) this%vacz=reshape(rtmp,shape(this%vacz))
deallocate(rtmp)
ALLOCATE(ctmp(size(this%vacxy)))
CALL MPI_REDUCE(this%vacxy,ctmp,size(this%vacxy),MPI_DOUBLE_COMPLEX,MPI_SUM,0,mpi_comm,ierr)
if (irank==0) this%vacxy=reshape(ctmp,shape(this%vacxy))
deallocate(ctmp)
endif
!density matrix
if (allocated(this%mmpMat)) then
ALLOCATE(ctmp(size(this%mmpMat)))
CALL MPI_REDUCE(this%mmpMat,ctmp,size(this%mmpMat),MPI_DOUBLE_COMPLEX,MPI_SUM,0,mpi_comm,ierr)
if (irank==0) this%mmpMat=reshape(ctmp,shape(this%mmpMat))
deallocate(ctmp)
endif
#endif
end subroutine collect
subroutine distribute(this,mpi_comm)
use m_mpi_bc_tool
implicit none
class(t_potden),INTENT(INOUT) :: this
integer :: mpi_comm
#ifdef CPP_MPI
include 'mpif.h'
call mpi_bc(this%iter,0,mpi_comm)
call mpi_bc(this%potdentype,0,mpi_comm)
call mpi_bc(this%pw,0,mpi_comm)
call mpi_bc(this%pw_w ,0,mpi_comm)
call mpi_bc(this%mt ,0,mpi_comm)
call mpi_bc(this%vacz,0,mpi_comm)
call mpi_bc(this%vacxy,0,mpi_comm)
call mpi_bc(this%theta_pw,0,mpi_comm)
call mpi_bc(this%phi_pw,0,mpi_comm)
call mpi_bc(this%theta_vacz,0,mpi_comm)
call mpi_bc(this%phi_vacz,0,mpi_comm)
call mpi_bc(this%theta_vacxy,0,mpi_comm)
call mpi_bc(this%phi_vacxy,0,mpi_comm)
call mpi_bc(this%theta_mt,0,mpi_comm)
call mpi_bc(this%phi_mt,0,mpi_comm)
#endif
end subroutine distribute
SUBROUTINE sum_both_spin(this,that)
IMPLICIT NONE
CLASS(t_potden),INTENT(INOUT) :: this
......
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