Commit da4b396a authored by S.Rost's avatar S.Rost

changes to types lapw to adapt for kpoints outside of first BZ

parent cc07bc9d
......@@ -156,9 +156,13 @@ CONTAINS
TYPE(t_cell) :: p_cell
INTEGER, INTENT(IN) :: i_kpt,jsp
REAL, INTENT(IN) :: eig(:)
INTEGER :: i,j,k,l
INTEGER :: i,j,k,l,n
REAL, ALLOCATABLE ::w_n(:)
COMPLEX, ALLOCATABLE ::w_n_c(:)
REAL, ALLOCATABLE ::w_n_sum(:)
COMPLEX, ALLOCATABLE ::w_n_c_sum(:)
REAL ::kpt_dist=0
LOGICAL :: method_rubel=.false.
CALL build_primitive_cell(banddos,p_cell,cell)
......@@ -183,10 +187,48 @@ CONTAINS
! write(*,*) 'smat dim1', size(smat_unfold%data_r,1), 'dim2', size(smat_unfold%data_r,2),'data',smat_unfold%data_r(2,2)
! write(222,'(234f15.8)') zMat%data_r
! write(223,'(234f15.8)') smat_unfold%data_r
ALLOCATE(w_n(zMat%matsize2))
w_n = 0.0
method_rubel=.true.
IF (zmat%l_real) THEN
ALLOCATE(w_n(zMat%matsize2))
w_n = 0
IF (method_rubel) THEN
ALLOCATE(w_n_sum(zMat%matsize2))
w_n_sum = 0
END IF
ELSE
ALLOCATE(w_n_c(zMat%matsize2))
w_n_c=0
IF (method_rubel) THEN
ALLOCATE(w_n_c_sum(zMat%matsize2))
w_n_c_sum=0
END IF
END IF
! write(345,'(3I6)') lapw%gvec(:,:,jsp)
DO i=1,zMat%matsize2
IF (method_rubel) THEN
DO j=1,lapw%nv(jsp)
IF (zmat%l_real) THEN
w_n_sum(i)=w_n_sum(i)+zMat%data_r(j,i)*zMat%data_r(j,i)
! write(*,*) 'zMat is real'
ELSE
w_n_c_sum(i)=w_n_c_sum(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(j,i)
! write(*,*) 'zMat is complex'
END IF
IF ((modulo(lapw%gvec(1,j,jsp),banddos%s_cell_x)==0).AND.&
&(modulo(lapw%gvec(2,j,jsp),banddos%s_cell_y)==0).AND.&
&(modulo(lapw%gvec(3,j,jsp),banddos%s_cell_z)==0)) THEN
IF (zmat%l_real) THEN
w_n(i)=w_n(i)+zMat%data_r(j,i)*zMat%data_r(j,i)
! write(*,*) 'zMat is real'
ELSE
w_n_c(i)=w_n_c(i)+CONJG(zMat%data_c(j,i))*zMat%data_c(j,i)
! write(*,*) 'zMat is complex'
END IF
END IF
END DO
ELSE
DO j=1,lapw%nv(jsp)
l=j
IF ((modulo(lapw%gvec(1,l,jsp),banddos%s_cell_x)==0).AND.&
......@@ -195,14 +237,36 @@ CONTAINS
DO k=1,lapw%nv(jsp)
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)
! write(*,*) 'zMat is real'
ELSE
w_n(i)=w_n(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)
! write(*,*) 'zMat is complex'
END IF
END DO
END IF
END DO
IF (jsp==1) write(679,'(3f15.8)') kpt_dist, (eig(i)*hartree_to_ev_const),w_n(i)
IF (jsp==2) write(680,'(3f15.8)') kpt_dist, (eig(i)*hartree_to_ev_const),w_n(i)
END IF
IF (method_rubel) THEN
IF (zmat%l_real) THEN
IF (jsp==1) write(679,'(3f15.8)') kpt_dist, (eig(i)*hartree_to_ev_const),w_n(i)/w_n_sum(i)
IF (jsp==2) write(680,'(3f15.8)') kpt_dist, (eig(i)*hartree_to_ev_const),w_n(i)/w_n_sum(i)
IF ((w_n(i)>1).or.(w_n(i)<0)) write(*,*) 'w_n larger 1 or smaller 0', w_n(i), 'eigenvalue',eig(i)
ELSE
IF (jsp==1) write(679,'(4f15.8)') kpt_dist, (eig(i)*hartree_to_ev_const),w_n_c(i)/w_n_c_sum(i)
IF (jsp==2) write(680,'(4f15.8)') kpt_dist, (eig(i)*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
ELSE
IF (zmat%l_real) THEN
IF (jsp==1) write(679,'(3f15.8)') kpt_dist, (eig(i)*hartree_to_ev_const),w_n(i)
IF (jsp==2) write(680,'(3f15.8)') kpt_dist, (eig(i)*hartree_to_ev_const),w_n(i)
IF ((w_n(i)>1).or.(w_n(i)<0)) write(*,*) 'w_n larger 1 or smaller 0', w_n(i), 'eigenvalue',eig(i)
ELSE
IF (jsp==1) write(679,'(4f15.8)') kpt_dist, (eig(i)*hartree_to_ev_const),w_n_c(i)
IF (jsp==2) write(680,'(4f15.8)') kpt_dist, (eig(i)*hartree_to_ev_const),w_n_c(i)
IF ((abs(w_n_c(i))>1).or.(real(w_n_c(i))<0)) write(*,*) 'w_n_c larger 1 or smaller 0', w_n_c(i), 'eigenvalue',eig(i)
END IF
END IF
END DO
IF (i_kpt==kpts%nkpt) THEN
......
......@@ -50,7 +50,7 @@ CONTAINS
CLASS(t_lapw),INTENT(INOUT) :: lapw
INTEGER j1,j2,j3,mk1,mk2,mk3,nv
INTEGER j1,j2,j3,mk1,mk2,mk3,nv,addX,addY,addZ
INTEGER ispin,nvh(2)
REAL arltv1,arltv2,arltv3,rkm,rk2,r2,s(3)
......@@ -69,9 +69,18 @@ CONTAINS
CALL boxdim(cell%bmat,arltv1,arltv2,arltv3)
! (add 1+1 due to integer rounding, strange k_vector in BZ)
mk1 = int(input%rkmax/arltv1) + 2
mk2 = int(input%rkmax/arltv2) + 2
mk3 = int(input%rkmax/arltv3) + 2
addX = abs(NINT((lapw%bkpt(1)+ (2*ispin - 3)/2.0*noco%qss(1))/arltv1))
addY = abs(NINT((lapw%bkpt(2)+ (2*ispin - 3)/2.0*noco%qss(2))/arltv2))
addZ = abs(NINT((lapw%bkpt(3)+ (2*ispin - 3)/2.0*noco%qss(3))/arltv3))
! addX = 0
! addY = 0
! addZ = 0
write(*,*) 'addX',addX,'addY',addY,'addZ',addZ
mk1 = int(input%rkmax/arltv1)+2
mk2 = int(input%rkmax/arltv2)+2
mk3 = int(input%rkmax/arltv3)+2
rkm = input%rkmax
rk2 = rkm*rkm
......@@ -82,9 +91,12 @@ CONTAINS
nvh(2)=0
DO ispin = 1,MERGE(2,1,noco%l_ss)
nv = 0
DO j1 = -mk1,mk1
DO j2 = -mk2,mk2
DO j3 = -mk3,mk3
DO j1 = -mk1-addX,mk1+addX
DO j2 = -mk2-addY,mk2+addY
DO j3 = -mk3-addZ,mk3+addZ
! DO j1 = -mk1,mk1
! DO j2 = -mk2,mk2
! DO j3 = -mk3,mk3
s = lapw%bkpt + (/j1,j2,j3/) + (2*ispin - 3)/2.0*noco%qss
r2 = dot_PRODUCT(MATMUL(s,cell%bbmat),s)
IF (r2.LE.rk2) nv = nv + 1
......@@ -142,7 +154,7 @@ CONTAINS
! ..
! .. Local Scalars ..
REAL arltv1,arltv2,arltv3,r2,rk2,rkm,r2q,gla,eps,t
INTEGER i,j,j1,j2,j3,k,l ,mk1,mk2,mk3,n,ispin,gmi,m,nred,n_inner,n_bound,itt(3)
INTEGER i,j,j1,j2,j3,k,l ,mk1,mk2,mk3,n,ispin,gmi,m,nred,n_inner,n_bound,itt(3),addX,addY,addZ
! ..
! .. Local Arrays ..
REAL :: s(3),sq(3)
......@@ -175,18 +187,28 @@ CONTAINS
CALL boxdim(cell%bmat,arltv1,arltv2,arltv3)
! (add 1+1 due to integer rounding, strange k_vector in BZ)
mk1 = int( input%rkmax/arltv1 ) + 4
mk2 = int( input%rkmax/arltv2 ) + 4
mk3 = int( input%rkmax/arltv3 ) + 4
addX = abs(NINT((lapw%bkpt(1)+ (2*ispin - 3)/2.0*noco%qss(1))/arltv1))
addY = abs(NINT((lapw%bkpt(2)+ (2*ispin - 3)/2.0*noco%qss(2))/arltv2))
addZ = abs(NINT((lapw%bkpt(3)+ (2*ispin - 3)/2.0*noco%qss(3))/arltv3))
! addX = 0
! addY = 0
! addZ = 0
mk1 = int( input%rkmax/arltv1 )+4
mk2 = int( input%rkmax/arltv2 )+4
mk3 = int( input%rkmax/arltv3 )+4
rk2 = input%rkmax*input%rkmax
!---> if too many basis functions, reduce rkmax
spinloop:DO ispin = 1,input%jspins
!---> obtain vectors
n = 0
DO j1 = -mk1,mk1
DO j2 = -mk2,mk2
DO j3 = -mk3,mk3
DO j1 = -mk1-addX,mk1+addX
DO j2 = -mk2-addY,mk2+addY
DO j3 = -mk3-addZ,mk3+addZ
! DO j1 = -mk1,mk1
! DO j2 = -mk2,mk2
! DO j3 = -mk3,mk3
s=lapw%bkpt+(/j1,j2,j3/)+(2*ispin - 3)/2.0*noco%qss
sq = lapw%bkpt+ (/j1,j2,j3/)
r2 = dot_PRODUCT(s,MATMUL(s,cell%bbmat))
......
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