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

kpoint parallel unfolding of band works - with debug output

parent 5c27041c
...@@ -21,6 +21,7 @@ CONTAINS ...@@ -21,6 +21,7 @@ CONTAINS
SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,sym,kpts,DIMENSION,vacuum,input,& 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) 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_constants, ONLY : pi_const,sfp_const
USE m_types USE m_types
USE m_apws USE m_apws
...@@ -60,7 +61,7 @@ CONTAINS ...@@ -60,7 +61,7 @@ CONTAINS
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell 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_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: inden,vx TYPE(t_potden),INTENT(IN) :: inden,vx
...@@ -70,6 +71,8 @@ CONTAINS ...@@ -70,6 +71,8 @@ CONTAINS
INCLUDE 'mpif.h' INCLUDE 'mpif.h'
#endif #endif
! EXTERNAL MPI_BCAST !only used by band_unfolding to broadcast the gvec
! Scalar Arguments ! Scalar Arguments
INTEGER,INTENT(IN) :: iter INTEGER,INTENT(IN) :: iter
INTEGER,INTENT(IN) :: eig_id INTEGER,INTENT(IN) :: eig_id
...@@ -83,11 +86,16 @@ CONTAINS ...@@ -83,11 +86,16 @@ CONTAINS
! Local Arrays ! Local Arrays
INTEGER :: ierr(3) INTEGER :: ierr(3)
INTEGER :: neigBuffer(kpts%nkpt,input%jspins) 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 INTEGER, PARAMETER :: lmaxb = 3
REAL, ALLOCATABLE :: bkpt(:) REAL, ALLOCATABLE :: bkpt(:)
REAL, ALLOCATABLE :: eig(:) REAL, ALLOCATABLE :: eig(:)
COMPLEX, ALLOCATABLE :: vs_mmp(:,:,:,:) COMPLEX, ALLOCATABLE :: vs_mmp(:,:,:,:)
INTEGER :: jsp_m, i_kpt_m, i_m
TYPE(t_tlmplm) :: td TYPE(t_tlmplm) :: td
TYPE(t_usdus) :: ud TYPE(t_usdus) :: ud
TYPE(t_lapw) :: lapw TYPE(t_lapw) :: lapw
...@@ -123,6 +131,7 @@ CONTAINS ...@@ -123,6 +131,7 @@ CONTAINS
neigBuffer = 0 neigBuffer = 0
results%neig = 0 results%neig = 0
results%eig = 1.0e300 results%eig = 1.0e300
unfoldingBuffer = CMPLX(0.0,0.0)
DO jsp = 1,MERGE(1,input%jspins,noco%l_noco) DO jsp = 1,MERGE(1,input%jspins,noco%l_noco)
k_loop:DO nk = mpi%n_start,kpts%nkpt,mpi%n_stride k_loop:DO nk = mpi%n_start,kpts%nkpt,mpi%n_stride
...@@ -218,7 +227,7 @@ CONTAINS ...@@ -218,7 +227,7 @@ CONTAINS
CALL timestop("EV output") CALL timestop("EV output")
IF (banddos%unfoldband) THEN 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) DEALLOCATE(smat_unfold, stat=dealloc_stat, errmsg=errmsg)
if(dealloc_stat /= 0) call juDFT_error("deallocate failed for smat_unfold",& if(dealloc_stat /= 0) call juDFT_error("deallocate failed for smat_unfold",&
hint=errmsg, calledby="eigen.F90") hint=errmsg, calledby="eigen.F90")
...@@ -228,10 +237,34 @@ CONTAINS ...@@ -228,10 +237,34 @@ CONTAINS
END DO ! spin loop ends END DO ! spin loop ends
#ifdef CPP_MPI #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_ALLREDUCE(neigBuffer,results%neig,kpts%nkpt*input%jspins,MPI_INTEGER,MPI_SUM,mpi%sub_comm,ierr)
CALL MPI_BARRIER(mpi%MPI_COMM,ierr) CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#else #else
results%neig(:,:) = neigBuffer(:,:) results%neig(:,:) = neigBuffer(:,:)
results%unfolding_weights(:,:,:) = unfoldingBuffer(:,:,:)
#endif #endif
! Sorry for the following strange workaround to fill the results%eig array. ! Sorry for the following strange workaround to fill the results%eig array.
......
...@@ -52,6 +52,7 @@ contains ...@@ -52,6 +52,7 @@ contains
ELSE ELSE
IF (banddos%unfoldband) THEN IF (banddos%unfoldband) THEN
CALL unfold_band_kpts(banddos,p_cell,cell,p_kpts,kpts) 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 julia(sym,p_cell,input,noco,banddos,p_kpts,.FALSE.,.TRUE.)
CALL find_supercell_kpts(banddos,p_cell,cell,p_kpts,kpts) CALL find_supercell_kpts(banddos,p_cell,cell,p_kpts,kpts)
ELSE ELSE
......
...@@ -84,7 +84,7 @@ CONTAINS ...@@ -84,7 +84,7 @@ CONTAINS
INTEGER :: i,m1,m2,m3 INTEGER :: i,m1,m2,m3
REAL :: rez_inv_to_internal(3,3) REAL :: rez_inv_to_internal(3,3)
REAL :: rez_inv_det 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 :: pc_kpoint_i(3) !primitive cell kpoint internal
REAL :: sc_kpoint_i(3) !super cell kpoint internal REAL :: sc_kpoint_i(3) !super cell kpoint internal
REAL :: pc_kpoint_c(3) !primitive cell kpoint cartesian REAL :: pc_kpoint_c(3) !primitive cell kpoint cartesian
...@@ -160,6 +160,9 @@ CONTAINS ...@@ -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 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) ! 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) kpts%bk(:,i)=list(4:6,i)
IF (i>1) THEN IF (i>1) THEN
...@@ -169,12 +172,12 @@ CONTAINS ...@@ -169,12 +172,12 @@ CONTAINS
END DO END DO
write(91,'(3f15.8)') kpts%bk write(91,'(3f15.8)') kpts%bk
write(92,*) kpts%wtkpt write(92,*) kpts%wtkpt
ALLOCATE (kpts%sc_list(10,p_kpts%nkpt)) ALLOCATE (kpts%sc_list(13,p_kpts%nkpt))
kpts%sc_list=list kpts%sc_list=list
write(90,'(10f15.8)') kpts%sc_list write(90,'(10f15.8)') kpts%sc_list
END SUBROUTINE find_supercell_kpts 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_types
USE m_juDFT USE m_juDFT
USE m_inv3 USE m_inv3
...@@ -185,15 +188,17 @@ CONTAINS ...@@ -185,15 +188,17 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_banddos),INTENT(IN) :: banddos 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_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(INOUT) :: smat_unfold
CLASS(t_mat),INTENT(IN) :: zMat CLASS(t_mat),INTENT(IN) :: zMat
TYPE(t_lapw),INTENT(IN) :: lapw TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_cell) :: p_cell TYPE(t_cell) :: p_cell
INTEGER, INTENT(IN) :: i_kpt,jsp INTEGER, INTENT(IN) :: i_kpt,jsp
REAL, INTENT(IN) :: eig(:) REAL, INTENT(IN) :: eig(:)
COMPLEX, INTENT(INOUT) :: unfoldingBuffer(:,:,:)
INTEGER :: i,j,k,l,n INTEGER :: i,j,k,l,n
INTEGER :: na,n_i,nn,nk,nki,gi,lo INTEGER :: na,n_i,nn,nk,nki,gi,lo
REAL, ALLOCATABLE ::w_n(:) REAL, ALLOCATABLE ::w_n(:)
...@@ -201,6 +206,8 @@ CONTAINS ...@@ -201,6 +206,8 @@ CONTAINS
REAL, ALLOCATABLE ::w_n_sum(:) REAL, ALLOCATABLE ::w_n_sum(:)
COMPLEX, ALLOCATABLE ::w_n_c_sum(:) COMPLEX, ALLOCATABLE ::w_n_c_sum(:)
LOGICAL :: method_rubel=.false. LOGICAL :: method_rubel=.false.
LOGICAL :: write_to_file=.false.
CLASS(t_mat), ALLOCATABLE :: zMat_s
CALL build_primitive_cell(banddos,p_cell,cell) CALL build_primitive_cell(banddos,p_cell,cell)
...@@ -214,8 +221,8 @@ CONTAINS ...@@ -214,8 +221,8 @@ CONTAINS
END DO END DO
END DO END DO
IF (i_kpt==1) THEN 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==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.2',status='unknown') IF (jsp==2) OPEN (680,file='bands_sc_old.2',status='unknown')
END IF END IF
! write(*,*) 'real zmat size dim 1:', size(zMat%data_r,1), 'dim2:', size(zMat%data_r,2) ! write(*,*) 'real zmat size dim 1:', size(zMat%data_r,1), 'dim2:', size(zMat%data_r,2)
...@@ -240,6 +247,22 @@ CONTAINS ...@@ -240,6 +247,22 @@ CONTAINS
w_n_c_sum=0 w_n_c_sum=0
! END IF ! 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(345,'(3I6)') lapw%gvec(:,:,jsp)
write (*,*)results%ef write (*,*)results%ef
write (*,*) i_kpt write (*,*) i_kpt
...@@ -295,26 +318,32 @@ CONTAINS ...@@ -295,26 +318,32 @@ CONTAINS
END DO END DO
!--------------------------LO's finished---------------- !--------------------------LO's finished----------------
ELSE ELSE
call smat_unfold%multiply(zMat,zMat_s)
DO j=1,lapw%nv(jsp) DO j=1,lapw%nv(jsp)
DO k=1,zMat%matsize1 ! DO k=1,zMat%matsize1
IF (zmat%l_real) THEN 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 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 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.& 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(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 &(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 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 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 IF
END DO ! END DO
END IF END IF
END DO END DO
write(1250+mpi%irank,'(4f15.8)') w_n_c(i),w_n_c_sum(i)
!------------------LO's------------------------ !------------------LO's------------------------
na=0 na=0
DO n_i=1,atoms%ntype DO n_i=1,atoms%ntype
...@@ -325,23 +354,27 @@ CONTAINS ...@@ -325,23 +354,27 @@ CONTAINS
DO nki=1,nk DO nki=1,nk
gi=lapw%kvec(nki,lo,na) gi=lapw%kvec(nki,lo,na)
j=lapw%nv(jsp)+lapw%index_lo(lo,na)+nki 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 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 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 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.& 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(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 &(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 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 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 IF
END DO ! END DO
END IF END IF
END DO END DO
END DO END DO
...@@ -350,6 +383,8 @@ CONTAINS ...@@ -350,6 +383,8 @@ CONTAINS
!--------------------------LO's finished---------------- !--------------------------LO's finished----------------
END IF END IF
! IF (method_rubel) THEN ! IF (method_rubel) THEN
write_to_file=.true.
IF (write_to_file) THEN
IF (zmat%l_real) THEN IF (zmat%l_real) THEN
IF (w_n(i)/w_n_sum(i)<0) w_n(i)=0 ! delete negative entries 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) 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 ...@@ -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 (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) 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
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 ! ELSE
! IF (zmat%l_real) THEN ! 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) ! IF (jsp==1) write(679,'(3f15.8)') kpt_dist, ((eig(i)-results%ef)*hartree_to_ev_const),w_n(i)
...@@ -377,11 +422,40 @@ CONTAINS ...@@ -377,11 +422,40 @@ CONTAINS
IF (jsp==1) CLOSE (679) IF (jsp==1) CLOSE (679)
IF (jsp==input%jspins) THEN IF (jsp==input%jspins) THEN
IF (jsp==2) CLOSE (680) 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 IF END IF
END SUBROUTINE 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) SUBROUTINE write_gnu_sc(nosyp,d,ssy,input)
USE m_types USE m_types
USE m_juDFT USE m_juDFT
......
...@@ -37,6 +37,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ...@@ -37,6 +37,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
USE m_doswrite USE m_doswrite
USE m_Ekwritesl USE m_Ekwritesl
USE m_banddos_io USE m_banddos_io
USE m_unfold_band_kpts
#ifdef CPP_MPI #ifdef CPP_MPI
USE m_mpi_bc_potden USE m_mpi_bc_potden
#endif #endif
...@@ -79,11 +80,12 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ...@@ -79,11 +80,12 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
!Local Scalars !Local Scalars
REAL :: fix, qtot, dummy REAL :: fix, qtot, dummy,eFermiPrev
INTEGER :: jspin, jspmax INTEGER :: jspin, jspmax
#ifdef CPP_HDF #ifdef CPP_HDF
INTEGER(HID_T) :: banddosFile_id INTEGER(HID_T) :: banddosFile_id
#endif #endif
LOGICAL :: l_error
CALL regCharges%init(input,atoms) CALL regCharges%init(input,atoms)
CALL dos%init(input,atoms,dimension,kpts,vacuum) CALL dos%init(input,atoms,dimension,kpts,vacuum)
...@@ -108,6 +110,11 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ...@@ -108,6 +110,11 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
IF (mpi%irank.EQ.0) THEN IF (mpi%irank.EQ.0) THEN
IF (banddos%dos.or.banddos%vacdos.or.input%cdinf) 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 #ifdef CPP_HDF
CALL openBandDOSFile(banddosFile_id,input,atoms,cell,kpts) CALL openBandDOSFile(banddosFile_id,input,atoms,cell,kpts)
CALL writeBandDOSData(banddosFile_id,input,atoms,cell,kpts,results,banddos,dos,vacuum) CALL writeBandDOSData(banddosFile_id,input,atoms,cell,kpts,results,banddos,dos,vacuum)
......
...@@ -38,7 +38,7 @@ CONTAINS ...@@ -38,7 +38,7 @@ CONTAINS
INTEGER n INTEGER n
REAL rdum REAL rdum
! .. Local Arrays .. ! .. Local Arrays ..
INTEGER i(39),ierr(3) INTEGER i(42),ierr(3)
REAL r(34) REAL r(34)
LOGICAL l(45) LOGICAL l(45)
! .. ! ..
...@@ -57,7 +57,7 @@ CONTAINS ...@@ -57,7 +57,7 @@ CONTAINS
i(27)=vacuum%nstars ; i(28)=vacuum%nstm ; i(29)=oneD%odd%nq2 ; i(30)=oneD%odd%nop 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(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(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(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 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 ...@@ -76,7 +76,7 @@ CONTAINS
l(21)=input%pallst ; l(22)=sliceplot%slice ; l(23)=noco%l_soc ; l(24)=vacuum%starcoeff 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(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(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(38)=field%efield%l_segmented
l(39)=sym%symor ; l(40)=input%frcor ; l(41)=input%tria ; l(42)=field%efield%dirichlet 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 l(43)=field%efield%l_dirichlet_coeff ; l(44)=input%l_coreSpec ; l(45)=input%ldauLinMix
...@@ -90,7 +90,7 @@ CONTAINS ...@@ -90,7 +90,7 @@ CONTAINS
sliceplot%nnne=i(17) ; banddos%ndir=i(18) ; </