Commit 3c90dc6c authored by S.Rost's avatar S.Rost

kpoint parallel unfolding of band works - with debug output

parent 5c27041c
......@@ -21,6 +21,7 @@ CONTAINS
SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,sym,kpts,DIMENSION,vacuum,input,&
cell,enpara,banddos,noco,oneD,hybrid,iter,eig_id,results,inden,v,vx)
#include"cpp_double.h"
USE m_constants, ONLY : pi_const,sfp_const
USE m_types
USE m_apws
......@@ -60,7 +61,7 @@ CONTAINS
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_kpts),INTENT(INOUT) :: kpts
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: inden,vx
......@@ -70,6 +71,8 @@ CONTAINS
INCLUDE 'mpif.h'
#endif
! EXTERNAL MPI_BCAST !only used by band_unfolding to broadcast the gvec
! Scalar Arguments
INTEGER,INTENT(IN) :: iter
INTEGER,INTENT(IN) :: eig_id
......@@ -83,11 +86,16 @@ CONTAINS
! Local Arrays
INTEGER :: ierr(3)
INTEGER :: neigBuffer(kpts%nkpt,input%jspins)
COMPLEX :: unfoldingBuffer(SIZE(results%unfolding_weights,1),kpts%nkpt,input%jspins) ! needed for unfolding bandstructure mpi case
INTEGER, PARAMETER :: lmaxb = 3
REAL, ALLOCATABLE :: bkpt(:)
REAL, ALLOCATABLE :: eig(:)
COMPLEX, ALLOCATABLE :: vs_mmp(:,:,:,:)
INTEGER :: jsp_m, i_kpt_m, i_m
TYPE(t_tlmplm) :: td
TYPE(t_usdus) :: ud
TYPE(t_lapw) :: lapw
......@@ -123,6 +131,7 @@ CONTAINS
neigBuffer = 0
results%neig = 0
results%eig = 1.0e300
unfoldingBuffer = CMPLX(0.0,0.0)
DO jsp = 1,MERGE(1,input%jspins,noco%l_noco)
k_loop:DO nk = mpi%n_start,kpts%nkpt,mpi%n_stride
......@@ -137,14 +146,14 @@ CONTAINS
IF(hybrid%l_hybrid) THEN
DO i = 1, hmat%matsize1
DO j = 1, i
IF (hmat%l_real) THEN
IF ((i.LE.5).AND.(j.LE.5)) THEN
WRITE(1233,'(2i7,2f15.8)') i, j, hmat%data_r(i,j), hmat%data_r(j,i)
END IF
ELSE
ENDIF
END DO
DO j = 1, i
IF (hmat%l_real) THEN
IF ((i.LE.5).AND.(j.LE.5)) THEN
WRITE(1233,'(2i7,2f15.8)') i, j, hmat%data_r(i,j), hmat%data_r(j,i)
END IF
ELSE
ENDIF
END DO
END DO
! Write overlap matrix smat to direct access file olap
......@@ -218,7 +227,7 @@ CONTAINS
CALL timestop("EV output")
IF (banddos%unfoldband) THEN
CALL calculate_plot_w_n(banddos,cell,kpts,smat_unfold,zMat,lapw,nk,jsp,eig,results,input,atoms)
CALL calculate_plot_w_n(banddos,cell,kpts,smat_unfold,zMat,lapw,nk,jsp,eig,results,input,atoms,unfoldingBuffer,mpi)
DEALLOCATE(smat_unfold, stat=dealloc_stat, errmsg=errmsg)
if(dealloc_stat /= 0) call juDFT_error("deallocate failed for smat_unfold",&
hint=errmsg, calledby="eigen.F90")
......@@ -228,10 +237,34 @@ CONTAINS
END DO ! spin loop ends
#ifdef CPP_MPI
IF (banddos%unfoldband) THEN
write(1230+mpi%irank,*) SHAPE(results%unfolding_weights)
write(1230+mpi%irank,*) SHAPE(unfoldingBuffer)
DO jsp_m = 1, SIZE(unfoldingBuffer,3)
DO i_kpt_m = 1, SIZE(unfoldingBuffer,2)
DO i_m = 1, SIZE(unfoldingBuffer,1)
write(1230+mpi%irank,'(2f15.8)') unfoldingBuffer(i_m, i_kpt_m,jsp_m)
END DO
END DO
END DO
write(*,*) SHAPE(results%unfolding_weights)
! FLUSH(1230+mpi%irank)
results%unfolding_weights = CMPLX(0.0,0.0)
CALL MPI_ALLREDUCE(unfoldingBuffer,results%unfolding_weights,SIZE(results%unfolding_weights,1)*SIZE(results%unfolding_weights,2)*SIZE(results%unfolding_weights,3),CPP_MPI_COMPLEX,MPI_SUM,mpi%mpi_comm,ierr)
write(1240+mpi%irank,*) SHAPE(results%unfolding_weights)
DO jsp_m = 1, SIZE(results%unfolding_weights,3)
DO i_kpt_m = 1, SIZE(results%unfolding_weights,2)
DO i_m = 1, SIZE(results%unfolding_weights,1)
write(1240+mpi%irank,'(2f15.8)') results%unfolding_weights(i_m, i_kpt_m,jsp_m)
END DO
END DO
END DO
END IF
CALL MPI_ALLREDUCE(neigBuffer,results%neig,kpts%nkpt*input%jspins,MPI_INTEGER,MPI_SUM,mpi%sub_comm,ierr)
CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#else
results%neig(:,:) = neigBuffer(:,:)
results%unfolding_weights(:,:,:) = unfoldingBuffer(:,:,:)
#endif
! Sorry for the following strange workaround to fill the results%eig array.
......
......@@ -52,6 +52,7 @@ contains
ELSE
IF (banddos%unfoldband) THEN
CALL unfold_band_kpts(banddos,p_cell,cell,p_kpts,kpts)
CALL julia(sym,cell,input,noco,banddos,kpts,.FALSE.,.TRUE.)
CALL julia(sym,p_cell,input,noco,banddos,p_kpts,.FALSE.,.TRUE.)
CALL find_supercell_kpts(banddos,p_cell,cell,p_kpts,kpts)
ELSE
......
......@@ -84,7 +84,7 @@ CONTAINS
INTEGER :: i,m1,m2,m3
REAL :: rez_inv_to_internal(3,3)
REAL :: rez_inv_det
REAL :: list(10,p_kpts%nkpt) !cartesion coordinates for k,K,m
REAL :: list(13,p_kpts%nkpt) !cartesion coordinates for k,K,m
REAL :: pc_kpoint_i(3) !primitive cell kpoint internal
REAL :: sc_kpoint_i(3) !super cell kpoint internal
REAL :: pc_kpoint_c(3) !primitive cell kpoint cartesian
......@@ -160,6 +160,9 @@ CONTAINS
list(9,i)=m3 !this whole block is to move kpoints into first BZ within -0.5 to 0.5
! kpts%bk(:,i)=matmul(rez_inv_to_internal,pc_kpoint_c)
!-------------saving old kpts----------
list(11:13,i)=kpts%bk(:,i)
!------finished---------
kpts%bk(:,i)=list(4:6,i)
IF (i>1) THEN
......@@ -169,12 +172,12 @@ CONTAINS
END DO
write(91,'(3f15.8)') kpts%bk
write(92,*) kpts%wtkpt
ALLOCATE (kpts%sc_list(10,p_kpts%nkpt))
ALLOCATE (kpts%sc_list(13,p_kpts%nkpt))
kpts%sc_list=list
write(90,'(10f15.8)') kpts%sc_list
END SUBROUTINE find_supercell_kpts
SUBROUTINE calculate_plot_w_n(banddos,cell,kpts,smat_unfold,zMat,lapw,i_kpt,jsp,eig,results,input,atoms)
SUBROUTINE calculate_plot_w_n(banddos,cell,kpts,smat_unfold,zMat,lapw,i_kpt,jsp,eig,results,input,atoms,unfoldingBuffer,mpi)
USE m_types
USE m_juDFT
USE m_inv3
......@@ -185,15 +188,17 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_results),INTENT(IN) :: results
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_kpts),INTENT(INOUT) :: kpts
CLASS(t_mat),INTENT(INOUT) :: smat_unfold
CLASS(t_mat),INTENT(IN) :: zMat
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_cell) :: p_cell
INTEGER, INTENT(IN) :: i_kpt,jsp
REAL, INTENT(IN) :: eig(:)
COMPLEX, INTENT(INOUT) :: unfoldingBuffer(:,:,:)
INTEGER :: i,j,k,l,n
INTEGER :: na,n_i,nn,nk,nki,gi,lo
REAL, ALLOCATABLE ::w_n(:)
......@@ -201,6 +206,8 @@ CONTAINS
REAL, ALLOCATABLE ::w_n_sum(:)
COMPLEX, ALLOCATABLE ::w_n_c_sum(:)
LOGICAL :: method_rubel=.false.
LOGICAL :: write_to_file=.false.
CLASS(t_mat), ALLOCATABLE :: zMat_s
CALL build_primitive_cell(banddos,p_cell,cell)
......@@ -214,8 +221,8 @@ CONTAINS
END DO
END DO
IF (i_kpt==1) THEN
IF (jsp==1) OPEN (679,file='bands_sc.1',status='unknown') !This is kind of my birthday 6 july 1992 (S.R.)
IF (jsp==2) OPEN (680,file='bands_sc.2',status='unknown')
IF (jsp==1) OPEN (679,file='bands_sc_old.1',status='unknown') !This is kind of my birthday 6 july 1992 (S.R.)
IF (jsp==2) OPEN (680,file='bands_sc_old.2',status='unknown')
END IF
! write(*,*) 'real zmat size dim 1:', size(zMat%data_r,1), 'dim2:', size(zMat%data_r,2)
......@@ -239,7 +246,23 @@ CONTAINS
ALLOCATE(w_n_c_sum(zMat%matsize2))
w_n_c_sum=0
! END IF
END IF
END IF
!---------create zmat_s--- smat*zmat---------------------
select type(zMat)
type is (t_mat)
allocate(t_mat::zMat_s)
select type(zMat_s)
type is (t_mat)
zMat_s=zMat
end select
type is (t_mpimat)
allocate(t_mpimat::zMat_s)
select type(zMat_s)
type is (t_mpimat)
zMat_s=zMat
end select
end select
!---------------------------------------------------------
! write(345,'(3I6)') lapw%gvec(:,:,jsp)
write (*,*)results%ef
write (*,*) i_kpt
......@@ -295,26 +318,32 @@ CONTAINS
END DO
!--------------------------LO's finished----------------
ELSE
call smat_unfold%multiply(zMat,zMat_s)
DO j=1,lapw%nv(jsp)
DO k=1,zMat%matsize1
! DO k=1,zMat%matsize1
IF (zmat%l_real) THEN
w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat%data_r(k,i)*smat_unfold%data_r(j,k)
! w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat%data_r(k,i)*smat_unfold%data_r(j,k)
w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat_s%data_r(j,i)
ELSE
w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(k,i)*smat_unfold%data_c(j,k)
! w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(k,i)*smat_unfold%data_c(j,k)
w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat_s%data_c(j,i)
END IF
END DO
! END DO
IF ((modulo(lapw%gvec(1,j,jsp)+NINT(kpts%sc_list(7,i_kpt)),banddos%s_cell_x)==0).AND.&
&(modulo(lapw%gvec(2,j,jsp)+NINT(kpts%sc_list(8,i_kpt)),banddos%s_cell_y)==0).AND.&
&(modulo(lapw%gvec(3,j,jsp)+NINT(kpts%sc_list(9,i_kpt)),banddos%s_cell_z)==0)) THEN
DO k=1,zMat%matsize1
! DO k=1,zMat%matsize1
IF (zmat%l_real) THEN
w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat%data_r(k,i)*smat_unfold%data_r(j,k)
! w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat%data_r(k,i)*smat_unfold%data_r(j,k)
w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat_s%data_r(j,i)
ELSE
w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(k,i)*smat_unfold%data_c(j,k)
! w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(k,i)*smat_unfold%data_c(j,k)
w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat_s%data_c(j,i)
END IF
END DO
! END DO
END IF
END DO
write(1250+mpi%irank,'(4f15.8)') w_n_c(i),w_n_c_sum(i)
!------------------LO's------------------------
na=0
DO n_i=1,atoms%ntype
......@@ -325,23 +354,27 @@ CONTAINS
DO nki=1,nk
gi=lapw%kvec(nki,lo,na)
j=lapw%nv(jsp)+lapw%index_lo(lo,na)+nki
DO k=1,zMat%matsize1
! DO k=1,zMat%matsize1
IF (zmat%l_real) THEN
w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat%data_r(k,i)*smat_unfold%data_r(j,k)
! w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat%data_r(k,i)*smat_unfold%data_r(j,k)
w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat_s%data_r(j,i)
ELSE
w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(k,i)*smat_unfold%data_c(j,k)
! w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(k,i)*smat_unfold%data_c(j,k)
w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat_s%data_c(j,i)
END IF
END DO
! END DO
IF ((modulo(lapw%gvec(1,gi,jsp)+NINT(kpts%sc_list(7,i_kpt)),banddos%s_cell_x)==0).AND.&
&(modulo(lapw%gvec(2,gi,jsp)+NINT(kpts%sc_list(8,i_kpt)),banddos%s_cell_y)==0).AND.&
&(modulo(lapw%gvec(3,gi,jsp)+NINT(kpts%sc_list(9,i_kpt)),banddos%s_cell_z)==0)) THEN
DO k=1,zMat%matsize1
! DO k=1,zMat%matsize1
IF (zmat%l_real) THEN
w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat%data_r(k,i)*smat_unfold%data_r(j,k)
! w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat%data_r(k,i)*smat_unfold%data_r(j,k)
w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat_s%data_r(j,i)
ELSE
w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(k,i)*smat_unfold%data_c(j,k)
! w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(k,i)*smat_unfold%data_c(j,k)
w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat_s%data_c(j,i)
END IF
END DO
! END DO
END IF
END DO
END DO
......@@ -350,6 +383,8 @@ CONTAINS
!--------------------------LO's finished----------------
END IF
! IF (method_rubel) THEN
write_to_file=.true.
IF (write_to_file) THEN
IF (zmat%l_real) THEN
IF (w_n(i)/w_n_sum(i)<0) w_n(i)=0 ! delete negative entries
IF (jsp==1) write(679,'(3f15.8)') kpts%sc_list(10,i_kpt), ((eig(i)-results%ef)*hartree_to_ev_const),w_n(i)/w_n_sum(i)
......@@ -361,6 +396,16 @@ CONTAINS
IF (jsp==2) write(680,'(4f15.8)') kpts%sc_list(10,i_kpt), ((eig(i)-results%ef)*hartree_to_ev_const),w_n_c(i)/w_n_c_sum(i)
IF ((abs(w_n_c(i)/w_n_c_sum(i))>1).or.(real(w_n_c(i))<0)) write(*,*) 'w_n_c/sum larger 1 or smaller 0', w_n_c(i)/w_n_c_sum(i), 'eigenvalue',eig(i)
END IF
END IF
IF (zmat%l_real) THEN
IF (w_n(i)/w_n_sum(i)<0) w_n(i)=0 ! delete negative entries
unfoldingBuffer(i,i_kpt,jsp)=w_n(i)/w_n_sum(i)
IF ((w_n(i)/w_n_sum(i)>1).or.(w_n(i)/w_n_sum(i)<0)) write(*,*) 'w_n/sum larger 1 or smaller 0', w_n(i)/w_n_sum(i), 'eigenvalue',eig(i)
ELSE
IF (real(w_n_c(i))<0) w_n_c(i)=0 ! delete negative entries
unfoldingBuffer(i,i_kpt,jsp)=w_n_c(i)/w_n_c_sum(i)
IF ((abs(w_n_c(i)/w_n_c_sum(i))>1).or.(real(w_n_c(i))<0)) write(*,*) 'w_n_c/sum larger 1 or smaller 0', w_n_c(i)/w_n_c_sum(i), 'eigenvalue',eig(i)
END IF
! ELSE
! IF (zmat%l_real) THEN
! IF (jsp==1) write(679,'(3f15.8)') kpt_dist, ((eig(i)-results%ef)*hartree_to_ev_const),w_n(i)
......@@ -377,10 +422,39 @@ CONTAINS
IF (jsp==1) CLOSE (679)
IF (jsp==input%jspins) THEN
IF (jsp==2) CLOSE (680)
CALL juDFT_error('Unfolded Bandstructure created succesfully - use band_sc.gnu to plot', calledby='calculate_plot_w_n')
!kpts%bk(:,:)=kpts%sc_list(11:13,:)
write(*,*) 'Unfolded Bandstructure calculated succesfully, calledby=calculate_plot_w_n'
!CALL juDFT_error('Unfolded Bandstructure created succesfully - use band_sc.gnu to plot', calledby='calculate_plot_w_n')
END IF
END IF
END SUBROUTINE
SUBROUTINE write_band_sc(kpts,results,eFermiPrev)
USE m_types
USE m_juDFT
USE m_constants
IMPLICIT NONE
TYPE(t_results),INTENT(IN) :: results
TYPE(t_kpts),INTENT(IN) :: kpts
REAL, INTENT(IN) :: eFermiPrev
INTEGER :: i,i_kpt,jsp
OPEN (679,file='bands_sc.1',status='unknown') !This is kind of my birthday 6 july 1992 (S.R.)
OPEN (680,file='bands_sc.2',status='unknown')
DO jsp=1,SIZE(results%unfolding_weights,3)
DO i_kpt=1,SIZE(results%unfolding_weights,2)
DO i=1,results%neig(i_kpt,jsp)
IF (jsp==1) write(679,'(4f15.8)') kpts%sc_list(10,i_kpt), ((results%eig(i,i_kpt,1)-eFermiPrev)*hartree_to_ev_const),results%unfolding_weights(i,i_kpt,1)
IF (jsp==2) write(680,'(4f15.8)') kpts%sc_list(10,i_kpt), ((results%eig(i,i_kpt,2)-eFermiPrev)*hartree_to_ev_const),results%unfolding_weights(i,i_kpt,2)
END DO
END DO
END DO
CLOSE (679)
CLOSE (680)
write(*,*) 'Unfolded Bandstructure written succesfully - use band_sc.gnu to plot, calledby=write_band_sc',eFermiPrev
END SUBROUTINE
SUBROUTINE write_gnu_sc(nosyp,d,ssy,input)
USE m_types
......
......@@ -37,6 +37,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
USE m_doswrite
USE m_Ekwritesl
USE m_banddos_io
USE m_unfold_band_kpts
#ifdef CPP_MPI
USE m_mpi_bc_potden
#endif
......@@ -79,11 +80,12 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
!Local Scalars
REAL :: fix, qtot, dummy
REAL :: fix, qtot, dummy,eFermiPrev
INTEGER :: jspin, jspmax
#ifdef CPP_HDF
INTEGER(HID_T) :: banddosFile_id
#endif
LOGICAL :: l_error
CALL regCharges%init(input,atoms)
CALL dos%init(input,atoms,dimension,kpts,vacuum)
......@@ -108,6 +110,11 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
IF (mpi%irank.EQ.0) THEN
IF (banddos%dos.or.banddos%vacdos.or.input%cdinf) THEN
IF (banddos%unfoldband) THEN
eFermiPrev = 0.0
CALL readPrevEFermi(eFermiPrev,l_error)
CALL write_band_sc(kpts,results,eFermiPrev)
END IF
#ifdef CPP_HDF
CALL openBandDOSFile(banddosFile_id,input,atoms,cell,kpts)
CALL writeBandDOSData(banddosFile_id,input,atoms,cell,kpts,results,banddos,dos,vacuum)
......
......@@ -38,7 +38,7 @@ CONTAINS
INTEGER n
REAL rdum
! .. Local Arrays ..
INTEGER i(39),ierr(3)
INTEGER i(42),ierr(3)
REAL r(34)
LOGICAL l(45)
! ..
......@@ -57,7 +57,7 @@ CONTAINS
i(27)=vacuum%nstars ; i(28)=vacuum%nstm ; i(29)=oneD%odd%nq2 ; i(30)=oneD%odd%nop
i(31)=input%gw ; i(32)=input%gw_neigd ; i(33)=hybrid%ewaldlambda ; i(34)=hybrid%lexp
i(35)=hybrid%bands1 ; i(36)=1 ; i(37)=input%imix ; i(38)=banddos%orbCompAtom
i(39)=input%kcrel
i(39)=input%kcrel;i(40)=banddos%s_cell_x;i(41)=banddos%s_cell_y;i(42)=banddos%s_cell_z
r(1)=cell%omtil ; r(2)=cell%area ; r(3)=vacuum%delz ; r(4)=cell%z1 ; r(5)=input%alpha
r(6)=sliceplot%e1s ; r(7)=sliceplot%e2s ; r(8)=noco%theta; r(9)=noco%phi; r(10)=vacuum%tworkf
......@@ -76,7 +76,7 @@ CONTAINS
l(21)=input%pallst ; l(22)=sliceplot%slice ; l(23)=noco%l_soc ; l(24)=vacuum%starcoeff
l(25)=noco%l_noco ; l(26)=noco%l_ss; l(27)=noco%l_mperp; l(28)=noco%l_constr
l(29)=oneD%odd%d1 ; l(32)=input%ctail ; l(33)=banddos%l_orb
l(34)=banddos%l_mcd
l(34)=banddos%l_mcd ; l(35)=banddos%unfoldband
l(38)=field%efield%l_segmented
l(39)=sym%symor ; l(40)=input%frcor ; l(41)=input%tria ; l(42)=field%efield%dirichlet
l(43)=field%efield%l_dirichlet_coeff ; l(44)=input%l_coreSpec ; l(45)=input%ldauLinMix
......@@ -90,7 +90,7 @@ CONTAINS
sliceplot%nnne=i(17) ; banddos%ndir=i(18) ; stars%mx1=i(19) ; stars%mx2=i(20) ; stars%mx3=i(21)
input%jspins=i(12) ; vacuum%nvac=i(13) ; input%itmax=i(14) ; sliceplot%kk=i(15) ; vacuum%layers=i(16)
stars%ng2=i(7) ; stars%ng3=i(8) ; vacuum%nmz=i(9) ; vacuum%nmzxy=i(10) ; obsolete%lepr=i(11)
atoms%ntype=i(3) ; input%isec1=i(6) ; banddos%orbCompAtom=i(38)
atoms%ntype=i(3) ; input%isec1=i(6) ; banddos%orbCompAtom=i(38);banddos%s_cell_x=i(40);banddos%s_cell_y=i(41);banddos%s_cell_z=i(42)
input%coretail_lmax=i(2) ; input%kcrel=i(39)
stars%kimax=i(25);stars%kimax2=i(26)
!
......@@ -118,6 +118,7 @@ CONTAINS
input%eonly=l(1) ; input%secvar=l(3) ; sym%zrfs=l(4) ; input%film=l(5)
field%efield%l_segmented = l(38) ; sym%symor=l(39); field%efield%dirichlet = l(40)
field%efield%l_dirichlet_coeff = l(41) ; input%l_coreSpec=l(44) ; input%ldauLinMix=l(45)
banddos%unfoldband=l(35)
!
! -> Broadcast the arrays:
IF (field%efield%l_segmented) THEN
......@@ -265,6 +266,13 @@ CONTAINS
CALL MPI_BCAST(kpts%specialPoints,3*kpts%numSpecialPoints,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
END IF
IF(banddos%unfoldband) THEN
IF(mpi%irank.NE.0) THEN
ALLOCATE(kpts%sc_list(13,kpts%nkpt))
END IF
CALL MPI_BCAST(kpts%sc_list,13*kpts%nkpt,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
END IF
RETURN
#endif
END SUBROUTINE mpi_bc_all
......
......@@ -33,7 +33,7 @@ MODULE m_types_kpts
REAL ,ALLOCATABLE :: specialPoints(:,:)
INTEGER,ALLOCATABLE :: ntetra(:,:)
REAL ,ALLOCATABLE :: voltet(:)
REAL ,ALLOCATABLE :: sc_list(:,:) !list for all information about folding of bandstructure (need for unfoldBandKPTS)((k(x,y,z),K(x,y,z),m(g1,g2,g3)),(nkpt))
REAL ,ALLOCATABLE :: sc_list(:,:) !list for all information about folding of bandstructure (need for unfoldBandKPTS)((k(x,y,z),K(x,y,z),m(g1,g2,g3)),(nkpt),k_original(x,y,z))
ENDTYPE t_kpts
......
......@@ -58,6 +58,7 @@ MODULE m_types_misc
REAL :: tote
REAL :: last_distance
REAL :: bandgap
COMPLEX, ALLOCATABLE :: unfolding_weights(:,:,:) !weights for unfolding a supercell bandstructure
TYPE(t_energy_hf) :: te_hfex
REAL :: te_hfex_loc(2)
REAL, ALLOCATABLE :: w_iks(:,:,:)
......@@ -156,6 +157,7 @@ CONTAINS
ALLOCATE (thisResults%w_iks(neigd2,kpts%nkpt,input%jspins))
ALLOCATE (thisResults%neig(kpts%nkpt,input%jspins))
ALLOCATE (thisResults%eig(neigd2,kpts%nkpt,input%jspins))
ALLOCATE (thisResults%unfolding_weights(neigd2,kpts%nkpt,input%jspins))
thisResults%force = 0.0
thisResults%force_old = 0.0
......
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