Commit ed4ba9aa authored by Daniel Wortmann's avatar Daniel Wortmann

Fixed code for parallel calculations of spin-spirals (test MPI:Fe_fcc)

parent 7b829fe0
......@@ -127,12 +127,12 @@ CONTAINS
INTEGER:: nn,na,ab_size,l,ll,m,i,ii
COMPLEX,ALLOCATABLE:: ab(:,:),ab1(:,:),ab_select1(:,:),ab_select(:,:)
COMPLEX,ALLOCATABLE:: ab(:,:),ab1(:,:),ab_select(:,:)
real :: rchi
ALLOCATE(ab(MAXVAL(lapw%nv),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2),ab1(lapw%nv(iintsp),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2),ab_select(lapw%num_local_cols(jintsp),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2))
IF (iintsp.NE.jintsp) ALLOCATE(ab_select1(lapw%num_local_cols(jintsp),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2))
!IF (iintsp.NE.jintsp) ALLOCATE(ab_select1(lapw%num_local_cols(jintsp),2*atoms%lnonsph(n)*(atoms%lnonsph(n)+2)+2))
IF (hmat%l_real) THEN
IF (ANY(SHAPE(hmat%data_c)/=SHAPE(hmat%data_r))) THEN
......@@ -151,17 +151,16 @@ CONTAINS
!Calculate Hamiltonian
CALL zgemm("N","N",lapw%nv(iintsp),ab_size,ab_size,CMPLX(1.0,0.0),ab,SIZE(ab,1),td%h_loc(0:,0:,n,isp),SIZE(td%h_loc,1),CMPLX(0.,0.),ab1,SIZE(ab1,1))
!Cut out of ab1 only the needed elements here
ab_select=ab1(mpi%n_rank+1:lapw%nv(iintsp):mpi%n_size,:)
IF (iintsp==jintsp) THEN
!Cut out of ab1 only the needed elements here
ab_select=ab1(mpi%n_rank+1:lapw%nv(iintsp):mpi%n_size,:)
CALL zgemm("N","T",lapw%nv(iintsp),lapw%num_local_cols(jintsp),ab_size,CMPLX(rchi,0.0),CONJG(ab1),SIZE(ab1,1),ab_select,lapw%num_local_cols(jintsp),CMPLX(1.,0.0),hmat%data_c,SIZE(hmat%data_c,1))
CALL zgemm("N","T",lapw%nv(iintsp),lapw%num_local_cols(iintsp),ab_size,CMPLX(rchi,0.0),CONJG(ab1),SIZE(ab1,1),ab_select,lapw%num_local_cols(iintsp),CMPLX(1.,0.0),hmat%data_c,SIZE(hmat%data_c,1))
ELSE
!Second set of ab is needed
CALL hsmt_ab(sym,atoms,noco,isp,jintsp,n,na,cell,lapw,fj,gj,ab,ab_size,.TRUE.)
ab_select1=ab(mpi%n_rank+1:lapw%nv(jintsp):mpi%n_size,:)
CALL zgemm("N","N",lapw%num_local_cols(jintsp),ab_size,ab_size,CMPLX(1.0,0.0),ab_select1,SIZE(ab_select1,1),td%h_loc(:,:,n,isp),SIZE(td%h_loc,1),CMPLX(0.,0.),ab_select,SIZE(ab_select,1))
CALL zgemm("N","N",lapw%nv(iintsp),ab_size,ab_size,CMPLX(1.0,0.0),ab,SIZE(ab,1),td%h_loc(:,:,n,isp),SIZE(td%h_loc,1),CMPLX(0.,0.),ab1,SIZE(ab1,1))
!Multiply for Hamiltonian
CALL zgemm("N","t",lapw%nv(iintsp),lapw%num_local_cols(jintsp),ab_size,CMPLX(rchi,0.0),CONJG(ab1),SIZE(ab1,1),ab_select,SIZE(ab_select,1)*mpi%n_size,CMPLX(1.,0.0),hmat%data_c,SIZE(hmat%data_c,1))
CALL zgemm("N","t",lapw%nv(iintsp),lapw%num_local_cols(iintsp),ab_size,chi,conjg(ab1),SIZE(ab1,1),ab_select,lapw%num_local_cols(iintsp),CMPLX(1.,0.0),hmat%data_c,SIZE(hmat%data_c,1))
ENDIF
ENDIF
END DO
......
......@@ -43,7 +43,22 @@ CONTAINS
SELECT TYPE(mat1)
TYPE IS (t_mpimat)
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mat%mpi_com,n_rank,i)
CALL MPI_COMM_SIZE(mat%mpi_com,n_size,i)
#endif
!Set lower part of matrix to zero...
ii=0
DO i=n_rank+1,MIN(mat%global_size1,mat%global_size2),n_size
ii=ii+1
IF (mat%l_real) THEN
mat%data_r(i+1:,ii)=0.0
mat1%data_r(i+1:,ii)=0.0
ELSE
mat%data_c(i+1:,ii)=0.0
mat1%data_c(i+1:,ii)=0.0
ENDIF
ENDDO
IF (mat%l_real) THEN
#ifdef CPP_SCALAPACK
......@@ -53,10 +68,7 @@ CONTAINS
#endif
END IF
!Now multiply the diagonal of the matrix by 1/2
#ifdef CPP_MPI
CALL MPI_COMM_RANK(mat%mpi_com,n_rank,i)
CALL MPI_COMM_SIZE(mat%mpi_com,n_size,i)
#endif
ii=0
DO i=n_rank+1,MIN(mat%global_size1,mat%global_size2),n_size
ii=ii+1
......
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