Commit 481c614d authored by Henning Janssen's avatar Henning Janssen

Fix for input%ldaulinmix with MPI

parent aacbd539
......@@ -20,7 +20,7 @@ MODULE m_types_mixvector
TYPE(t_sphhar),POINTER :: sphhar
TYPE(t_atoms),POINTER :: atoms =>null()
INTEGER :: jspins,nvac
LOGICAL :: l_noco,invs,invs2,l_mtnocopot
LOGICAL :: l_noco,invs,invs2,l_mtnocopot,l_mperp
INTEGER :: pw_length !The shape of the local arrays
INTEGER :: pw_start(3)=0,pw_stop(3) !First and last index for spin
INTEGER :: mt_length,mt_length_g
......@@ -172,8 +172,7 @@ CONTAINS
ENDDO
ENDIF
ENDIF
IF (js>2) RETURN
IF (misc_here) THEN
IF (misc_here.AND.(js<3.OR.l_mperp)) THEN
vec%vec_misc(misc_start(js):misc_start(js)+SIZE(den%mmpMat(:,:,1:atoms%n_u,j))-1)=RESHAPE(REAL(den%mmpMat(:,:,1:atoms%n_u,j)),(/SIZE(den%mmpMat(:,:,1:atoms%n_u,j))/))
vec%vec_misc(misc_start(js)+SIZE(den%mmpMat(:,:,1:atoms%n_u,j)):misc_start(js)+2*SIZE(den%mmpMat(:,:,1:atoms%n_u,j))-1)=RESHAPE(AIMAG(den%mmpMat(:,:,1:atoms%n_u,j)),(/SIZE(den%mmpMat(:,:,1:atoms%n_u,j))/))
END IF
......@@ -238,12 +237,12 @@ CONTAINS
ENDIF
ENDDO
ENDIF
IF (misc_here.AND.js<3) THEN
IF (misc_here.AND.(js<3.OR.l_mperp)) THEN
den%mmpMat(:,:,1:atoms%n_u,js)=RESHAPE(CMPLX(vec%vec_misc(misc_start(js):misc_start(js)+SIZE(den%mmpMat(:,:,1:atoms%n_u,js))-1),vec%vec_misc(misc_start(js)+SIZE(den%mmpMat(:,:,1:atoms%n_u,js)):misc_start(js)+2*SIZE(den%mmpMat(:,:,1:atoms%n_u,js))-1)),SHAPE(den%mmpMat(:,:,1:atoms%n_u,js)))
END IF
END IF
ENDDO
call den%collect(mix_mpi_comm)
call den%collect(mix_mpi_comm,misc_here)
END SUBROUTINE mixvector_to_density
......@@ -291,7 +290,7 @@ CONTAINS
mvec%vec_vac(vac_start(js)+SIZE(g_vac):vac_stop(js))=g_vac(:vac_stop(js)-vac_start(js)-SIZE(g_vac)+1)*vec%vec_vac(vac_start(js)+SIZE(g_vac):vac_stop(js))
ENDIF
ENDIF
IF (misc_here.AND.(js<3)) THEN
IF (misc_here.AND.(js<3.OR.l_mperp)) THEN
mvec%vec_misc(misc_start(js):misc_stop(js))=g_misc*vec%vec_misc(misc_start(js):misc_stop(js))
END IF
ENDIF
......@@ -470,6 +469,7 @@ CONTAINS
jspins=input%jspins
nvac=vacuum%nvac
l_noco=noco%l_noco
l_mperp=noco%l_mperp
l_mtnocopot=noco%l_mtnocopot
invs=sym%invs
invs2=sym%invs2
......@@ -524,7 +524,7 @@ CONTAINS
vac_length=vac_length+len
vac_stop(js)=vac_length
ENDIF
IF (misc_here.AND.(js<3)) THEN
IF (misc_here.AND.(js<3.OR.l_mperp)) THEN
len = 7*7*2*atoms%n_u
misc_start(js)=misc_length+1
misc_length = misc_length + len
......
......@@ -48,10 +48,11 @@ MODULE m_types_potden
END TYPE t_potden
CONTAINS
subroutine collect(this,mpi_comm)
subroutine collect(this,mpi_comm,l_collmmp)
use m_mpi_bc_tool
implicit none
class(t_potden),INTENT(INOUT) :: this
LOGICAL, OPTIONAL, INTENT(IN) :: l_collmmp
integer :: mpi_comm
#ifdef CPP_MPI
include 'mpif.h'
......@@ -82,10 +83,19 @@ CONTAINS
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)
IF(PRESENT(l_collmmp)) THEN
IF(l_collmmp) 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
ELSE
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
#endif
end subroutine collect
......
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