Commit f10fd0f8 authored by Daniel Wortmann's avatar Daniel Wortmann

More fixes...

parent 597e7658
...@@ -117,12 +117,9 @@ CONTAINS ...@@ -117,12 +117,9 @@ CONTAINS
! !
! --> Allocate ! --> Allocate
! !
ALLOCATE ( ud%uloulopn(atoms%nlod,atoms%nlod,atoms%ntype,DIMENSION%jspd),nv2(DIMENSION%jspd) ) call ud%init(atoms,DIMENSION%jspd)
ALLOCATE ( ud%ddn(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),eig(DIMENSION%neigd),bkpt(3) ) ALLOCATE ( nv2(DIMENSION%jspd) )
ALLOCATE ( ud%us(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),ud%uds(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd) ) ALLOCATE ( eig(DIMENSION%neigd),bkpt(3) )
ALLOCATE ( ud%dus(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),ud%duds(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd))
ALLOCATE ( ud%ulos(atoms%nlod,atoms%ntype,DIMENSION%jspd),ud%dulos(atoms%nlod,atoms%ntype,DIMENSION%jspd) )
ALLOCATE ( ud%uulon(atoms%nlod,atoms%ntype,DIMENSION%jspd),ud%dulon(atoms%nlod,atoms%ntype,DIMENSION%jspd) )
ALLOCATE ( lapw%k1(DIMENSION%nvd,DIMENSION%jspd),lapw%k2(DIMENSION%nvd,DIMENSION%jspd),& ALLOCATE ( lapw%k1(DIMENSION%nvd,DIMENSION%jspd),lapw%k2(DIMENSION%nvd,DIMENSION%jspd),&
lapw%k3(DIMENSION%nvd,DIMENSION%jspd),lapw%rk(DIMENSION%nvd,DIMENSION%jspd) ) lapw%k3(DIMENSION%nvd,DIMENSION%jspd),lapw%rk(DIMENSION%nvd,DIMENSION%jspd) )
! !
......
...@@ -241,11 +241,11 @@ CONTAINS ...@@ -241,11 +241,11 @@ CONTAINS
filename = 'inp_new.xml' filename = 'inp_new.xml'
input_temp%l_f = input%l_f input_temp%l_f = input%l_f
input_temp%gw_neigd = dimension_temp%neigd input_temp%gw_neigd = dimension_temp%neigd
div(:) = MIN(kpts_temp%nmop(:),1) div(:) = MIN(kpts_temp%nkpt3(:),1)
stars_temp%gmax = stars_temp%gmaxInit stars_temp%gmax = stars_temp%gmaxInit
CALL w_inpXML(atoms_new,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,& CALL w_inpXML(atoms_new,obsolete_temp,vacuum_temp,input_temp,stars_temp,sliceplot_temp,&
banddos_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,jij_temp,oneD_temp,hybrid_temp,& banddos_temp,cell_temp,sym_temp,xcpot_temp,noco_temp,jij_temp,oneD_temp,hybrid_temp,&
kpts_temp,kpts_temp%nmop,kpts_temp%l_gamma,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,& kpts_temp,kpts_temp%nkpt3,kpts_temp%l_gamma,noel_temp,namex_temp,relcor_temp,a1_temp,a2_temp,a3_temp,&
scale_temp,dtild_temp,input_temp%comment,xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,& scale_temp,dtild_temp,input_temp%comment,xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
atomTypeSpecies,speciesRepAtomType,.FALSE.,filename,.TRUE.,numSpecies,enpara_temp) atomTypeSpecies,speciesRepAtomType,.FALSE.,filename,.TRUE.,numSpecies,enpara_temp)
DEALLOCATE(atomTypeSpecies,speciesRepAtomType) DEALLOCATE(atomTypeSpecies,speciesRepAtomType)
......
This diff is collapsed.
...@@ -38,7 +38,6 @@ CONTAINS ...@@ -38,7 +38,6 @@ CONTAINS
USE m_radflo, ONLY : radflo USE m_radflo, ONLY : radflo
USE m_loddop, ONLY : loddop USE m_loddop, ONLY : loddop
USE m_util, ONLY : intgrf_init,intgrf,rorderpf USE m_util, ONLY : intgrf_init,intgrf,rorderpf
USE m_gen_bz
USE m_read_core USE m_read_core
USE m_wrapper USE m_wrapper
USE m_icorrkeys USE m_icorrkeys
...@@ -53,7 +52,7 @@ CONTAINS ...@@ -53,7 +52,7 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(INOUT) :: kpts TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: v TYPE(t_potden),INTENT(IN) :: v
...@@ -143,6 +142,8 @@ CONTAINS ...@@ -143,6 +142,8 @@ CONTAINS
IF(ALLOCATED(hybrid%basm1) ) DEALLOCATE(hybrid%basm1) IF(ALLOCATED(hybrid%basm1) ) DEALLOCATE(hybrid%basm1)
IF(ALLOCATED(hybrid%basm2) ) DEALLOCATE(hybrid%basm2) IF(ALLOCATED(hybrid%basm2) ) DEALLOCATE(hybrid%basm2)
call usdus%init(atoms,dimension%jspd)
! If restart is specified read file if it already exists ! If restart is specified read file if it already exists
! create it otherwise ! create it otherwise
IF ( l_restart ) THEN IF ( l_restart ) THEN
...@@ -201,9 +202,6 @@ CONTAINS ...@@ -201,9 +202,6 @@ CONTAINS
! initialize gridf for radial integration ! initialize gridf for radial integration
CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,gridf) CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,gridf)
! generate whole BZ form k-points given in kpts
CALL gen_bz(kpts,sym)
! !
! read in energy parameters from file eig ! read in energy parameters from file eig
! to avoid meaningless energy parameters which occur in the case ! to avoid meaningless energy parameters which occur in the case
......
...@@ -29,6 +29,7 @@ init/tetcon.f ...@@ -29,6 +29,7 @@ init/tetcon.f
) )
set(fleur_F90 ${fleur_F90} set(fleur_F90 ${fleur_F90}
init/compile_descr.F90 init/compile_descr.F90
init/kpoints.f90
init/apws_dim.f90 init/apws_dim.f90
init/checks.F90 init/checks.F90
init/dimen7.F90 init/dimen7.F90
......
...@@ -28,7 +28,6 @@ ...@@ -28,7 +28,6 @@
USE m_strgndim USE m_strgndim
USE m_convndim USE m_convndim
USE m_inpeigdim USE m_inpeigdim
USE m_kptgen_hybrid
USE m_ylm USE m_ylm
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -94,7 +93,7 @@ ...@@ -94,7 +93,7 @@
!---> determine ntype,nop,natd,nwdd,nlod and layerd !---> determine ntype,nop,natd,nwdd,nlod and layerd
! !
CALL first_glance(atoms%ntype,sym%nop,atoms%nat,atoms%nlod,vacuum%layerd,& CALL first_glance(atoms%ntype,sym%nop,atoms%nat,atoms%nlod,vacuum%layerd,&
input%itmax,l_kpts,l_qpts,l_gamma,kpts%nkpt,kpts%nmop,jij%nqpt,nmopq) input%itmax,l_kpts,l_qpts,l_gamma,kpts%nkpt,kpts%nkpt3,jij%nqpt,nmopq)
atoms%ntype=atoms%ntype atoms%ntype=atoms%ntype
atoms%nlod = max(atoms%nlod,1) atoms%nlod = max(atoms%nlod,1)
...@@ -330,10 +329,8 @@ ...@@ -330,10 +329,8 @@
& kpts,.false.,.FALSE.) & kpts,.false.,.FALSE.)
sym%nop=n1 sym%nop=n1
sym%nop2=n2 sym%nop2=n2
ELSE IF(l_gamma .and. banddos%ndir .eq. 0) THEN ELSE IF(l_gamma .and. banddos%ndir .eq. 0) THEN
CALL kptgen_hybrid(kpts%nmop(1),kpts%nmop(2),kpts%nmop(3),& call judft_error("gamma swtich not supported in old inp file anymore",calledby="dimen7")
kpts%nkpt,sym%invs,noco%l_soc,sym%nop,&
sym%mrot,sym%tau)
ELSE ELSE
CALL julia(& CALL julia(&
& sym,cell,input,noco,banddos,& & sym,cell,input,noco,banddos,&
...@@ -371,7 +368,7 @@ ...@@ -371,7 +368,7 @@
! Using the k-point generator also for creation of q-points for the ! Using the k-point generator also for creation of q-points for the
! J-constants calculation: ! J-constants calculation:
IF(.not.l_qpts)THEN IF(.not.l_qpts)THEN
kpts%nmop=nmopq kpts%nkpt3=nmopq
l_tmp=(/noco%l_ss,noco%l_soc/) l_tmp=(/noco%l_ss,noco%l_soc/)
noco%l_ss=.false. noco%l_ss=.false.
noco%l_soc=.false. noco%l_soc=.false.
......
...@@ -43,25 +43,27 @@ SUBROUTINE gen_bz( kpts,sym) ...@@ -43,25 +43,27 @@ SUBROUTINE gen_bz( kpts,sym)
! - local arrays - ! - local arrays -
INTEGER,ALLOCATABLE :: iarr(:) INTEGER,ALLOCATABLE :: iarr(:)
REAL :: rrot(3,3,sym%nsym),rotkpt(3) REAL :: rrot(3,3,2*sym%nop),rotkpt(3)
REAL,ALLOCATABLE :: rarr1(:,:) REAL,ALLOCATABLE :: rarr1(:,:)
INTEGER:: nsym
ALLOCATE (kpts%bkf(3,sym%nsym*kpts%nkpt))
ALLOCATE (kpts%bkp(sym%nsym*kpts%nkpt)) nsym=sym%nop
ALLOCATE (kpts%bksym(sym%nsym*kpts%nkpt)) if (.not.sym%invs) nsym=2*sym%nop
ALLOCATE (kpts%bkf(3,nsym*kpts%nkpt))
ALLOCATE (kpts%bkp(nsym*kpts%nkpt))
ALLOCATE (kpts%bksym(nsym*kpts%nkpt))
! Generate symmetry operations in reciprocal space ! Generate symmetry operations in reciprocal space
DO iop=1,nsym
DO iop=1,sym%nsym
IF( iop .le. sym%nop ) THEN IF( iop .le. sym%nop ) THEN
rrot(:,:,iop) = transpose( sym%mrot(:,:,sym%invtab(iop)) ) rrot(:,:,iop) = transpose( sym%mrot(:,:,iop) )
ELSE ELSE
rrot(:,:,iop) = -rrot(:,:,iop-sym%nop) rrot(:,:,iop) = -rrot(:,:,iop-sym%nop)
END IF END IF
END DO END DO
! Set target number for k points in full BZ ! Set target number for k points in full BZ
kpts%nkptf = kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3) kpts%nkptf = kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3)
IF(kpts%l_gamma) THEN IF(kpts%l_gamma) THEN
IF (ANY(MODULO(kpts%nkpt3(:),2).EQ.0)) THEN IF (ANY(MODULO(kpts%nkpt3(:),2).EQ.0)) THEN
...@@ -76,7 +78,7 @@ SUBROUTINE gen_bz( kpts,sym) ...@@ -76,7 +78,7 @@ SUBROUTINE gen_bz( kpts,sym)
kpts%bkf = 0 kpts%bkf = 0
ic = 0 ic = 0
DO iop=1,sym%nsym DO iop=1,nsym
DO ikpt=1,kpts%nkpt DO ikpt=1,kpts%nkpt
l_found = .FALSE. l_found = .FALSE.
rotkpt = MATMUL(rrot(:,:,iop), kpts%bk(:,ikpt)) rotkpt = MATMUL(rrot(:,:,iop), kpts%bk(:,ikpt))
...@@ -98,21 +100,22 @@ SUBROUTINE gen_bz( kpts,sym) ...@@ -98,21 +100,22 @@ SUBROUTINE gen_bz( kpts,sym)
END DO END DO
END DO END DO
IF (kpts%nkptf /= ic) THEN kpts%nkptf = ic
WRITE(*,*) '' !IF (kpts%nkptf /= ic) THEN
WRITE(*,*) 'Generation of full Brilloun zone from IBZ failed.' ! WRITE(*,*) ''
WRITE(*,*) 'Number of generated k points in full BZ does not' ! WRITE(*,*) 'Generation of full Brilloun zone from IBZ failed.'
WRITE(*,*) 'agree with target.' ! WRITE(*,*) 'Number of generated k points in full BZ does not'
WRITE(*,*) 'Number of generated k points in full BZ: ', ic ! WRITE(*,*) 'agree with target.'
WRITE(*,*) 'Target: ', kpts%nkptf ! WRITE(*,*) 'Number of generated k points in full BZ: ', ic
WRITE(*,*) '' ! WRITE(*,*) 'Target: ', kpts%nkptf
! WRITE(*,*) ''
! DO ikpt=1,kpts%nkptf
! WRITE(*,*) kpts%bkf(:,ikpt) ! DO ikpt=1,kpts%nkptf
! END DO ! WRITE(*,*) kpts%bkf(:,ikpt)
! END DO
CALL juDFT_error("gen_bz: error kpts/symmetry",calledby="gen_bz")
END IF ! CALL juDFT_error("gen_bz: error kpts/symmetry",calledby="gen_bz")
!END IF
! Reallocate bkf, bkp, bksym ! Reallocate bkf, bkp, bksym
ALLOCATE (iarr(kpts%nkptf)) ALLOCATE (iarr(kpts%nkptf))
......
...@@ -27,9 +27,9 @@ ...@@ -27,9 +27,9 @@
USE m_bandstr1 USE m_bandstr1
use m_types use m_types
IMPLICIT NONE IMPLICIT NONE
TYPE(t_sym),INTENT(INOUT) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_input),INTENT(INOUT) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_banddos),INTENT(IN) :: banddos TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_kpts),INTENT(INOUT) :: kpts TYPE(t_kpts),INTENT(INOUT) :: kpts
...@@ -78,9 +78,9 @@ ...@@ -78,9 +78,9 @@
INTEGER ikzero ! 0 no shift of k-points; INTEGER ikzero ! 0 no shift of k-points;
! 1 shift of k-points for better use of sym in irrBZ ! 1 shift of k-points for better use of sym in irrBZ
REAL kzero(3) ! shifting vector to bring one k-point to or REAL kzero(3) ! shifting vector to bring one k-point to or
! away from (0,0,0) (for even/odd nmop) ! away from (0,0,0) (for even/odd nkpt3)
INTEGER i,j,k,l,idiv,mkpt,addSym INTEGER i,j,k,l,idiv,mkpt,addSym,nsym
INTEGER iofile,iokpt,kpri,ktest,kmidtet INTEGER iofile,iokpt,kpri,ktest,kmidtet
INTEGER idivis(3) INTEGER idivis(3)
LOGICAL random,trias LOGICAL random,trias
...@@ -112,8 +112,9 @@ ...@@ -112,8 +112,9 @@
!------------------------------------------------------------ !------------------------------------------------------------
IF(l_q) THEN IF(l_q) THEN
trias=input%tria trias=input%tria
input%tria=.false. if (input%tria) call judft_error("tria=T not implemented for q-point generator",calledby='julia')
!input%tria=.false.
ENDIF ENDIF
IF (cell%latnam.EQ.'squ') THEN IF (cell%latnam.EQ.'squ') THEN
...@@ -147,8 +148,8 @@ ...@@ -147,8 +148,8 @@
& cell%amat,& & cell%amat,&
& idsyst,idtype) & idsyst,idtype)
ENDIF ENDIF
sym%nsym = sym%nop nsym = sym%nop
IF (input%film) sym%nsym = sym%nop2 IF (input%film) nsym = sym%nop2
! !
!-------------------- Want to make a Bandstructure ? -------- !-------------------- Want to make a Bandstructure ? --------
! !
...@@ -188,14 +189,14 @@ ...@@ -188,14 +189,14 @@
bltv(j,k) = cell%amat(k,j) bltv(j,k) = cell%amat(k,j)
binv(j,k) = cell%bmat(k,j)/tpi_const binv(j,k) = cell%bmat(k,j)/tpi_const
rltv(j,k) = cell%bmat(k,j) rltv(j,k) = cell%bmat(k,j)
DO i = 1,sym%nsym DO i = 1,nsym
rlsymr(k,j,i) = real( sym%mrot(j,k,i) ) rlsymr(k,j,i) = real( sym%mrot(j,k,i) )
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
ccr = 0.0 ccr = 0.0
DO i = 1,sym%nsym DO i = 1,nsym
DO j = 1,3 DO j = 1,3
talfa(j,i) = 0.0 talfa(j,i) = 0.0
DO k = 1,3 DO k = 1,3
...@@ -215,7 +216,7 @@ ...@@ -215,7 +216,7 @@
! write (*,'(3f12.6)') ((ccr(j,k,i),j=1,3),k=1,3) ! write (*,'(3f12.6)') ((ccr(j,k,i),j=1,3),k=1,3)
! write (*,*) ! write (*,*)
ENDDO ENDDO
DO i = 1,sym%nsym DO i = 1,nsym
rlsymr1(:,:) = rlsymr(:,:,i) rlsymr1(:,:) = rlsymr(:,:,i)
ccr1(:,:) = ccr(:,:,i) ccr1(:,:) = ccr(:,:,i)
DO j = 1,3 DO j = 1,3
...@@ -226,7 +227,7 @@ ...@@ -226,7 +227,7 @@
ENDDO ENDDO
ENDDO ENDDO
IF ((.not.noco%l_ss).AND.(.not.noco%l_soc).AND.(2*sym%nsym<nop48)) THEN IF ((.not.noco%l_ss).AND.(.not.noco%l_soc).AND.(2*nsym<nop48)) THEN
IF ( (input%film.AND.(.not.sym%invs2)).OR.& IF ( (input%film.AND.(.not.sym%invs2)).OR.&
& ((.not.input%film).AND.(.not.sym%invs)) ) THEN & ((.not.input%film).AND.(.not.sym%invs)) ) THEN
...@@ -235,15 +236,15 @@ ...@@ -235,15 +236,15 @@
! to exploit time reversal symmetry. However, if the new ! to exploit time reversal symmetry. However, if the new
! symmetry operation is the identity matrix it is excluded. ! symmetry operation is the identity matrix it is excluded.
! This is the case iff it is (-Id) + a translation vector. ! This is the case iff it is (-Id) + a translation vector.
DO i = 1, sym%nsym DO i = 1, nsym
! This test assumes that ccr(:,:,1) is the identity matrix. ! This test assumes that ccr(:,:,1) is the identity matrix.
IF(.NOT.ALL(ABS(ccr(:,:,1)+ccr(:,:,i)).LT.10e-10) ) THEN IF(.NOT.ALL(ABS(ccr(:,:,1)+ccr(:,:,i)).LT.10e-10) ) THEN
ccr(:,:,sym%nsym+addSym+1 ) = -ccr(:,:,i) ccr(:,:,nsym+addSym+1 ) = -ccr(:,:,i)
rlsymr(:,:,sym%nsym+addSym+1 ) = -rlsymr(:,:,i) rlsymr(:,:,nsym+addSym+1 ) = -rlsymr(:,:,i)
addSym = addSym + 1 addSym = addSym + 1
END IF END IF
END DO END DO
sym%nsym = sym%nsym + addSym nsym = nsym + addSym
ENDIF ENDIF
ENDIF ENDIF
...@@ -258,12 +259,12 @@ ...@@ -258,12 +259,12 @@
! interchangable. GM, 2016. ! interchangable. GM, 2016.
! CALL brzone(& ! CALL brzone(&
! & rltv,sym%nsym,ccr,mface,nbsz,nv48,& ! & rltv,nsym,ccr,mface,nbsz,nv48,&
! & cpoint,& ! & cpoint,&
! & xvec,ncorn,nedge,nface,fnorm,fdist) ! & xvec,ncorn,nedge,nface,fnorm,fdist)
CALL brzone2(& CALL brzone2(&
& rltv,sym%nsym,ccr,mface,nbsz,nv48,& & rltv,nsym,ccr,mface,nbsz,nv48,&
& cpoint,& & cpoint,&
& xvec,ncorn,nedge,nface,fnorm,fdist) & xvec,ncorn,nedge,nface,fnorm,fdist)
...@@ -281,7 +282,7 @@ ...@@ -281,7 +282,7 @@
& iofile,ibfile,iokpt,& & iofile,ibfile,iokpt,&
& kpri,ktest,kmidtet,mkpt,ndiv3,& & kpri,ktest,kmidtet,mkpt,ndiv3,&
& nreg,nfulst,rltv,cell%omtil,& & nreg,nfulst,rltv,cell%omtil,&
& sym%nsym,ccr,mdir,mface,& & nsym,ccr,mdir,mface,&
& ncorn,nface,fdist,fnorm,cpoint,& & ncorn,nface,fdist,fnorm,cpoint,&
& voltet,ntetra,ntet,vktet,& & voltet,ntetra,ntet,vktet,&
& kpts%nkpt,& & kpts%nkpt,&
...@@ -289,39 +290,39 @@ ...@@ -289,39 +290,39 @@
ELSE ELSE
! !
! If just the total number of k-points is given, determine ! If just the total number of k-points is given, determine
! the divisions in each direction (nmop): ! the divisions in each direction (nkpt3):
! !
! IF (tria) THEN ! IF (tria) THEN
! nkpt = nkpt/4 ! nkpt = nkpt/4
! nmop(:) = nmop(:) / 2 ! nkpt3(:) = nkpt3(:) / 2
! ENDIF ! ENDIF
IF (sum(kpts%nmop).EQ.0) THEN IF (sum(kpts%nkpt3).EQ.0) THEN
CALL divi(& CALL divi(&
& kpts%nkpt,cell%bmat,input%film,sym%nop,sym%nop2,& & kpts%nkpt,cell%bmat,input%film,sym%nop,sym%nop2,&
& kpts%nmop) & kpts%nkpt3)
ENDIF ENDIF
! !
! Now calculate Monkhorst-Pack k-points: ! Now calculate Monkhorst-Pack k-points:
! !
IF (kpts%nmop(2).EQ.0) kpts%nmop(2) = kpts%nmop(1) IF (kpts%nkpt3(2).EQ.0) kpts%nkpt3(2) = kpts%nkpt3(1)
IF ((.not.input%film).AND.(kpts%nmop(3).EQ.0)) kpts%nmop(3) = kpts%nmop(2) IF ((.not.input%film).AND.(kpts%nkpt3(3).EQ.0)) kpts%nkpt3(3) = kpts%nkpt3(2)
IF (nbound.EQ.1) THEN IF (nbound.EQ.1) THEN
mkpt = (2*kpts%nmop(1)+1)*(2*kpts%nmop(2)+1) mkpt = (2*kpts%nkpt3(1)+1)*(2*kpts%nkpt3(2)+1)
IF (.not.input%film) mkpt = mkpt*(2*kpts%nmop(3)+1) IF (.not.input%film) mkpt = mkpt*(2*kpts%nkpt3(3)+1)
ELSE ELSE
mkpt = kpts%nmop(1)*kpts%nmop(2) mkpt = kpts%nkpt3(1)*kpts%nkpt3(2)
IF (.not.input%film) mkpt = mkpt*kpts%nmop(3) IF (.not.input%film) mkpt = mkpt*kpts%nkpt3(3)
ENDIF ENDIF
ALLOCATE (vkxyz(3,mkpt),wghtkp(mkpt) ) ALLOCATE (vkxyz(3,mkpt),wghtkp(mkpt) )
vkxyz = 0.0 vkxyz = 0.0
CALL kptmop(& CALL kptmop(&
& iofile,iokpt,kpri,ktest,& & iofile,iokpt,kpri,ktest,&
& idsyst,idtype,kpts%nmop,ikzero,kzero,& & idsyst,idtype,kpts%nkpt3,ikzero,kzero,&
& rltv,bltv,nreg,nfulst,nbound,idimens,& & rltv,bltv,nreg,nfulst,nbound,idimens,&
& xvec,fnorm,fdist,ncorn,nface,nedge,cpoint,& & xvec,fnorm,fdist,ncorn,nface,nedge,cpoint,&
& sym%nsym,ccr,rlsymr,talfa,mkpt,mface,mdir,& & nsym,ccr,rlsymr,talfa,mkpt,mface,mdir,&
& kpts%nkpt,divis,vkxyz,nkstar,wghtkp) & kpts%nkpt,divis,vkxyz,nkstar,wghtkp)
ENDIF ENDIF
...@@ -360,7 +361,7 @@ ...@@ -360,7 +361,7 @@
WRITE (113,FMT=8050) (vkxyz(i,j)/real(idiv),i=1,3) WRITE (113,FMT=8050) (vkxyz(i,j)/real(idiv),i=1,3)
ENDDO ENDDO
CLOSE(113) CLOSE(113)
input%tria=trias !input%tria=trias
RETURN RETURN
ENDIF ENDIF
8050 FORMAT (2(f14.10,1x),f14.10) 8050 FORMAT (2(f14.10,1x),f14.10)
......
...@@ -8,18 +8,18 @@ ...@@ -8,18 +8,18 @@
CONTAINS CONTAINS
! this programm generates an aequdistant kpoint set including the ! this programm generates an aequdistant kpoint set including the
! Gamma point; it is reduced to IBZ and written in kpts ! Gamma point; it is reduced to IBZ and written in kpts (M.B.)
!Modified for types D.W.
SUBROUTINE kptgen_hybrid(nx,ny,nz,nkpt,invs,l_soc,nop,mrot,tau)
SUBROUTINE kptgen_hybrid(kpts,invs,l_soc,nop,mrot,tau)
USE m_types
IMPLICIT NONE IMPLICIT NONE
TYPE(t_kpts),INTENT(INOUT)::kpts
! - scalars - ! - scalars -
INTEGER, INTENT(IN) :: nx,ny,nz
INTEGER, INTENT(IN) :: nkpt
INTEGER, INTENT(IN) :: nop INTEGER, INTENT(IN) :: nop
LOGICAL, INTENT(IN) :: invs LOGICAL, INTENT(IN) :: invs
LOGICAL, INTENT(IN) :: l_soc LOGICAL, INTENT(IN) :: l_soc
...@@ -27,12 +27,10 @@ ...@@ -27,12 +27,10 @@
INTEGER, INTENT(IN) :: mrot(3,3,nop) INTEGER, INTENT(IN) :: mrot(3,3,nop)
REAL , INTENT(IN) :: tau(3,nop) REAL , INTENT(IN) :: tau(3,nop)
! - local scalars - ! - local scalars -
INTEGER :: i,j,k INTEGER :: i,j,k,nkpt
INTEGER :: ikpt,ikpt0,ikpt1,nkpti INTEGER :: ikpt,ikpt0,nkpti
INTEGER :: iop INTEGER :: nsym
INTEGER :: nrkpt,nsym
! - local arrays - ! - local arrays -
INTEGER :: nkpt3(3) ! generate axbxc k-point set
INTEGER,ALLOCATABLE :: rot(:,:,:),rrot(:,:,:) INTEGER,ALLOCATABLE :: rot(:,:,:),rrot(:,:,:)
INTEGER,ALLOCATABLE :: invtab(:) INTEGER,ALLOCATABLE :: invtab(:)
INTEGER,ALLOCATABLE :: neqkpt(:) INTEGER,ALLOCATABLE :: neqkpt(:)
...@@ -41,23 +39,18 @@ ...@@ -41,23 +39,18 @@
REAL,ALLOCATABLE :: rtau(:,:) REAL,ALLOCATABLE :: rtau(:,:)
REAL,ALLOCATABLE :: bk(:,:),bkhlp(:,:) REAL,ALLOCATABLE :: bk(:,:),bkhlp(:,:)
REAL,ALLOCATABLE :: rarr(:) REAL,ALLOCATABLE :: rarr(:)
REAL :: rotkpt(3) LOGICAL :: ldum
REAL :: rdum
LOGICAL :: inv,ldum
IF( nx*ny*nz .ne. nkpt ) nkpt=kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3)
&STOP 'kptgen_hybrid: nx*ny*nz=/nkpt'
nkpt3(1) = nx; nkpt3(2) = ny; nkpt3(3) = nz
ALLOCATE( bk(3,nkpt),bkhlp(3,nkpt) ) ALLOCATE( bk(3,nkpt),bkhlp(3,nkpt) )
ikpt = 0 ikpt = 0
DO i=0,nkpt3(1)-1 DO i=0,kpts%nkpt3(1)-1
DO j=0,nkpt3(2)-1 DO j=0,kpts%nkpt3(2)-1
DO k=0,nkpt3(3)-1 DO k=0,kpts%nkpt3(3)-1
ikpt = ikpt + 1 ikpt = ikpt + 1
bk(:,ikpt) = (/ 1.0*i/nkpt3(1),1.0*j/nkpt3(2), bk(:,ikpt) = (/ 1.0*i/kpts%nkpt3(1),1.0*j/kpts%nkpt3(2),
& 1.0*k/nkpt3(3) /) & 1.0*k/kpts%nkpt3(3) /)
END DO END DO
END DO END DO
END DO END DO
...@@ -112,16 +105,16 @@ ...@@ -112,16 +105,16 @@
END DO END DO
ALLOCATE ( kptp(nkpt),symkpt(nkpt),rarr(3),iarr2(3),iarr(nkpt) ) ALLOCATE ( kptp(nkpt),symkpt(nkpt),rarr(3),iarr2(3),iarr(nkpt) )
ALLOCATE ( pkpt(nkpt3(1)+1,nkpt3(2)+1,nkpt3(3)+1) ) ALLOCATE ( pkpt(kpts%nkpt3(1)+1,kpts%nkpt3(2)+1,kpts%nkpt3(3)+1) )
pkpt = 0 pkpt = 0
DO ikpt = 1,nkpt DO ikpt = 1,nkpt
iarr2 = nint ( bk(:,ikpt) * nkpt3 ) + 1 iarr2 = nint ( bk(:,ikpt) * kpts%nkpt3 ) + 1
pkpt(iarr2(1),iarr2(2),iarr2(3)) = ikpt pkpt(iarr2(1),iarr2(2),iarr2(3)) = ikpt
END DO END DO
pkpt(nkpt3(1)+1, : , : ) = pkpt(1,:,:) pkpt(kpts%nkpt3(1)+1, : , : ) = pkpt(1,:,:)
pkpt( : ,nkpt3(2)+1, : ) = pkpt(:,1,:) pkpt( : ,kpts%nkpt3(2)+1, : ) = pkpt(:,1,:)
pkpt( : , : ,nkpt3(3)+1) = pkpt(:,:,1) pkpt( : , : ,kpts%nkpt3(3)+1) = pkpt(:,:,1)
IF(any(pkpt.eq.0)) IF(any(pkpt.eq.0))
&STOP 'kptgen: Definition of pkpt-pointer failed.' &STOP 'kptgen: Definition of pkpt-pointer failed.'
...@@ -132,15 +125,15 @@ ...@@ -132,15 +125,15 @@
kptp(i) = i kptp(i) = i
symkpt(i) = 1 symkpt(i) = 1
DO k = 2,nsym DO k = 2,nsym
rarr = matmul(rrot(:,:,k),bk(:,i)) * nkpt3 rarr = matmul(rrot(:,:,k),bk(:,i)) * kpts%nkpt3
iarr2 = nint(rarr) iarr2 = nint(rarr)
IF(any(abs(iarr2-rarr).gt.1d-10)) THEN IF(any(abs(iarr2-rarr).gt.1d-10)) THEN
WRITE(6,'(A,I3,A)') 'kptgen: Symmetry operation',k, WRITE(6,'(A,I3,A)') 'kptgen: Symmetry operation',k,
& ' incompatible with k-point set.' & ' incompatible with k-point set.'
ldum = .true. ldum = .true.
END IF END IF
iarr2 = modulo(iarr2,nkpt3) + 1