Skip to content

fleur
fleur
Commit f10fd0f8 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

More fixes...

parent 597e7658
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 1083 additions and 1081 deletions
eigen/eigen.F90
View file @ f10fd0f8
......@@ -117,12 +117,9 @@ CONTAINS
!
! --> Allocate
!
ALLOCATE ( ud%uloulopn(atoms%nlod,atoms%nlod,atoms%ntype,DIMENSION%jspd),nv2(DIMENSION%jspd) )
ALLOCATE ( ud%ddn(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),eig(DIMENSION%neigd),bkpt(3) )
ALLOCATE ( ud%us(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),ud%uds(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd) )
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) )
call ud%init(atoms,DIMENSION%jspd)
ALLOCATE ( nv2(DIMENSION%jspd) )
ALLOCATE ( eig(DIMENSION%neigd),bkpt(3) )
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) )
!
......
force/geo.f90
View file @ f10fd0f8
......@@ -241,11 +241,11 @@ CONTAINS
filename = 'inp_new.xml'
input_temp%l_f = input%l_f
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
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,&
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,&
atomTypeSpecies,speciesRepAtomType,.FALSE.,filename,.TRUE.,numSpecies,enpara_temp)
DEALLOCATE(atomTypeSpecies,speciesRepAtomType)
......
global/types.F90
View file @ f10fd0f8
This diff is collapsed.
hybrid/mixedbasis.F90
View file @ f10fd0f8
......@@ -38,7 +38,6 @@ CONTAINS
USE m_radflo, ONLY : radflo
USE m_loddop, ONLY : loddop
USE m_util, ONLY : intgrf_init,intgrf,rorderpf
USE m_gen_bz
USE m_read_core
USE m_wrapper
USE m_icorrkeys
......@@ -53,7 +52,7 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
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_potden),INTENT(IN) :: v
......@@ -143,6 +142,8 @@ CONTAINS
IF(ALLOCATED(hybrid%basm1) ) DEALLOCATE(hybrid%basm1)
IF(ALLOCATED(hybrid%basm2) ) DEALLOCATE(hybrid%basm2)
call usdus%init(atoms,dimension%jspd)
! If restart is specified read file if it already exists
! create it otherwise
IF ( l_restart ) THEN
......@@ -201,9 +202,6 @@ CONTAINS
! initialize gridf for radial integration
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
! to avoid meaningless energy parameters which occur in the case
......
init/CMakeLists.txt
View file @ f10fd0f8
......@@ -29,6 +29,7 @@ init/tetcon.f
)
set(fleur_F90 ${fleur_F90}
init/compile_descr.F90
init/kpoints.f90
init/apws_dim.f90
init/checks.F90
init/dimen7.F90
......
init/dimen7.F90
View file @ f10fd0f8
......@@ -28,7 +28,6 @@
USE m_strgndim
USE m_convndim
USE m_inpeigdim
USE m_kptgen_hybrid
USE m_ylm
IMPLICIT NONE
!
......@@ -94,7 +93,7 @@
!---> determine ntype,nop,natd,nwdd,nlod and 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%nlod = max(atoms%nlod,1)
......@@ -330,10 +329,8 @@
& kpts,.false.,.FALSE.)
sym%nop=n1
sym%nop2=n2
ELSE IF(l_gamma .and. banddos%ndir .eq. 0) THEN
CALL kptgen_hybrid(kpts%nmop(1),kpts%nmop(2),kpts%nmop(3),&
kpts%nkpt,sym%invs,noco%l_soc,sym%nop,&
sym%mrot,sym%tau)
ELSE IF(l_gamma .and. banddos%ndir .eq. 0) THEN
call judft_error("gamma swtich not supported in old inp file anymore",calledby="dimen7")
ELSE
CALL julia(&
& sym,cell,input,noco,banddos,&
......@@ -371,7 +368,7 @@
! Using the k-point generator also for creation of q-points for the
! J-constants calculation:
IF(.not.l_qpts)THEN
kpts%nmop=nmopq
kpts%nkpt3=nmopq
l_tmp=(/noco%l_ss,noco%l_soc/)
noco%l_ss=.false.
noco%l_soc=.false.
......
init/gen_bz.F90
View file @ f10fd0f8
......@@ -43,25 +43,27 @@ SUBROUTINE gen_bz( kpts,sym)
! - local arrays -
INTEGER,ALLOCATABLE :: iarr(:)
REAL :: rrot(3,3,sym%nsym),rotkpt(3)
REAL :: rrot(3,3,2*sym%nop),rotkpt(3)
REAL,ALLOCATABLE :: rarr1(:,:)
ALLOCATE (kpts%bkf(3,sym%nsym*kpts%nkpt))
ALLOCATE (kpts%bkp(sym%nsym*kpts%nkpt))
ALLOCATE (kpts%bksym(sym%nsym*kpts%nkpt))
INTEGER:: nsym
nsym=sym%nop
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
DO iop=1,sym%nsym
DO iop=1,nsym
IF( iop .le. sym%nop ) THEN
rrot(:,:,iop) = transpose( sym%mrot(:,:,sym%invtab(iop)) )
rrot(:,:,iop) = transpose( sym%mrot(:,:,iop) )
ELSE
rrot(:,:,iop) = -rrot(:,:,iop-sym%nop)
END IF
END DO
! Set target number for k points in full BZ
kpts%nkptf = kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3)
IF(kpts%l_gamma) THEN
IF (ANY(MODULO(kpts%nkpt3(:),2).EQ.0)) THEN
......@@ -76,7 +78,7 @@ SUBROUTINE gen_bz( kpts,sym)
kpts%bkf = 0
ic = 0
DO iop=1,sym%nsym
DO iop=1,nsym
DO ikpt=1,kpts%nkpt
l_found = .FALSE.
rotkpt = MATMUL(rrot(:,:,iop), kpts%bk(:,ikpt))
......@@ -98,21 +100,22 @@ SUBROUTINE gen_bz( kpts,sym)
END DO
END DO
IF (kpts%nkptf /= ic) THEN
WRITE(*,*) ''
WRITE(*,*) 'Generation of full Brilloun zone from IBZ failed.'
WRITE(*,*) 'Number of generated k points in full BZ does not'
WRITE(*,*) 'agree with target.'
WRITE(*,*) 'Number of generated k points in full BZ: ', ic
WRITE(*,*) 'Target: ', kpts%nkptf
WRITE(*,*) ''
! DO ikpt=1,kpts%nkptf
! WRITE(*,*) kpts%bkf(:,ikpt)
! END DO
CALL juDFT_error("gen_bz: error kpts/symmetry",calledby="gen_bz")
END IF
kpts%nkptf = ic
!IF (kpts%nkptf /= ic) THEN
! WRITE(*,*) ''
! WRITE(*,*) 'Generation of full Brilloun zone from IBZ failed.'
! WRITE(*,*) 'Number of generated k points in full BZ does not'
! WRITE(*,*) 'agree with target.'
! WRITE(*,*) 'Number of generated k points in full BZ: ', ic
! WRITE(*,*) 'Target: ', kpts%nkptf
! WRITE(*,*) ''
! DO ikpt=1,kpts%nkptf
! WRITE(*,*) kpts%bkf(:,ikpt)
! END DO
! CALL juDFT_error("gen_bz: error kpts/symmetry",calledby="gen_bz")
!END IF
! Reallocate bkf, bkp, bksym
ALLOCATE (iarr(kpts%nkptf))
......
init/julia.f90
View file @ f10fd0f8
......@@ -27,9 +27,9 @@
USE m_bandstr1
use m_types
IMPLICIT NONE
TYPE(t_sym),INTENT(INOUT) :: sym
TYPE(t_sym),INTENT(IN) :: sym
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_banddos),INTENT(IN) :: banddos
TYPE(t_kpts),INTENT(INOUT) :: kpts
......@@ -78,9 +78,9 @@
INTEGER ikzero ! 0 no shift of k-points;
! 1 shift of k-points for better use of sym in irrBZ
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 idivis(3)
LOGICAL random,trias
......@@ -112,8 +112,9 @@
!------------------------------------------------------------
IF(l_q) THEN
trias=input%tria
input%tria=.false.
trias=input%tria
if (input%tria) call judft_error("tria=T not implemented for q-point generator",calledby='julia')
!input%tria=.false.
ENDIF
IF (cell%latnam.EQ.'squ') THEN
......@@ -147,8 +148,8 @@
& cell%amat,&
& idsyst,idtype)
ENDIF
sym%nsym = sym%nop
IF (input%film) sym%nsym = sym%nop2
nsym = sym%nop
IF (input%film) nsym = sym%nop2
!
!-------------------- Want to make a Bandstructure ? --------
!
......@@ -188,14 +189,14 @@
bltv(j,k) = cell%amat(k,j)
binv(j,k) = cell%bmat(k,j)/tpi_const
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) )
ENDDO
ENDDO
ENDDO
ccr = 0.0
DO i = 1,sym%nsym
DO i = 1,nsym
DO j = 1,3
talfa(j,i) = 0.0
DO k = 1,3
......@@ -215,7 +216,7 @@
! write (*,'(3f12.6)') ((ccr(j,k,i),j=1,3),k=1,3)
! write (*,*)
ENDDO
DO i = 1,sym%nsym
DO i = 1,nsym
rlsymr1(:,:) = rlsymr(:,:,i)
ccr1(:,:) = ccr(:,:,i)
DO j = 1,3
......@@ -226,7 +227,7 @@
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.&
& ((.not.input%film).AND.(.not.sym%invs)) ) THEN
......@@ -235,15 +236,15 @@
! to exploit time reversal symmetry. However, if the new
! symmetry operation is the identity matrix it is excluded.
! 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.
IF(.NOT.ALL(ABS(ccr(:,:,1)+ccr(:,:,i)).LT.10e-10) ) THEN
ccr(:,:,sym%nsym+addSym+1 ) = -ccr(:,:,i)
rlsymr(:,:,sym%nsym+addSym+1 ) = -rlsymr(:,:,i)
ccr(:,:,nsym+addSym+1 ) = -ccr(:,:,i)
rlsymr(:,:,nsym+addSym+1 ) = -rlsymr(:,:,i)
addSym = addSym + 1
END IF
END DO
sym%nsym = sym%nsym + addSym
nsym = nsym + addSym
ENDIF
ENDIF
......@@ -258,12 +259,12 @@
! interchangable. GM, 2016.
! CALL brzone(&
! & rltv,sym%nsym,ccr,mface,nbsz,nv48,&
! & rltv,nsym,ccr,mface,nbsz,nv48,&
! & cpoint,&
! & xvec,ncorn,nedge,nface,fnorm,fdist)
CALL brzone2(&
& rltv,sym%nsym,ccr,mface,nbsz,nv48,&
& rltv,nsym,ccr,mface,nbsz,nv48,&
& cpoint,&
& xvec,ncorn,nedge,nface,fnorm,fdist)
......@@ -281,7 +282,7 @@
& iofile,ibfile,iokpt,&
& kpri,ktest,kmidtet,mkpt,ndiv3,&
& nreg,nfulst,rltv,cell%omtil,&
& sym%nsym,ccr,mdir,mface,&
& nsym,ccr,mdir,mface,&
& ncorn,nface,fdist,fnorm,cpoint,&
& voltet,ntetra,ntet,vktet,&
& kpts%nkpt,&
......@@ -289,39 +290,39 @@
ELSE
!
! 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
! nkpt = nkpt/4
! nmop(:) = nmop(:) / 2
! nkpt3(:) = nkpt3(:) / 2
! ENDIF
IF (sum(kpts%nmop).EQ.0) THEN
IF (sum(kpts%nkpt3).EQ.0) THEN
CALL divi(&
& kpts%nkpt,cell%bmat,input%film,sym%nop,sym%nop2,&
& kpts%nmop)
& kpts%nkpt3)
ENDIF
!
! Now calculate Monkhorst-Pack k-points:
!
IF (kpts%nmop(2).EQ.0) kpts%nmop(2) = kpts%nmop(1)
IF ((.not.input%film).AND.(kpts%nmop(3).EQ.0)) kpts%nmop(3) = kpts%nmop(2)
IF (kpts%nkpt3(2).EQ.0) kpts%nkpt3(2) = kpts%nkpt3(1)
IF ((.not.input%film).AND.(kpts%nkpt3(3).EQ.0)) kpts%nkpt3(3) = kpts%nkpt3(2)
IF (nbound.EQ.1) THEN
mkpt = (2*kpts%nmop(1)+1)*(2*kpts%nmop(2)+1)
IF (.not.input%film) mkpt = mkpt*(2*kpts%nmop(3)+1)
mkpt = (2*kpts%nkpt3(1)+1)*(2*kpts%nkpt3(2)+1)
IF (.not.input%film) mkpt = mkpt*(2*kpts%nkpt3(3)+1)
ELSE
mkpt = kpts%nmop(1)*kpts%nmop(2)
IF (.not.input%film) mkpt = mkpt*kpts%nmop(3)
mkpt = kpts%nkpt3(1)*kpts%nkpt3(2)
IF (.not.input%film) mkpt = mkpt*kpts%nkpt3(3)
ENDIF
ALLOCATE (vkxyz(3,mkpt),wghtkp(mkpt) )
vkxyz = 0.0
CALL kptmop(&
& iofile,iokpt,kpri,ktest,&
& idsyst,idtype,kpts%nmop,ikzero,kzero,&
& idsyst,idtype,kpts%nkpt3,ikzero,kzero,&
& rltv,bltv,nreg,nfulst,nbound,idimens,&
& 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)
ENDIF
......@@ -360,7 +361,7 @@
WRITE (113,FMT=8050) (vkxyz(i,j)/real(idiv),i=1,3)
ENDDO
CLOSE(113)
input%tria=trias
!input%tria=trias
RETURN
ENDIF
8050 FORMAT (2(f14.10,1x),f14.10)
......
init/kptgen_hybrid.f
View file @ f10fd0f8
......@@ -8,18 +8,18 @@
CONTAINS
! this programm generates an aequdistant kpoint set including the
! Gamma point; it is reduced to IBZ and written in kpts
! this programm generates an aequdistant kpoint set including the
! 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
TYPE(t_kpts),INTENT(INOUT)::kpts
! - scalars -
INTEGER, INTENT(IN) :: nx,ny,nz
INTEGER, INTENT(IN) :: nkpt
INTEGER, INTENT(IN) :: nop
LOGICAL, INTENT(IN) :: invs
LOGICAL, INTENT(IN) :: l_soc
......@@ -27,12 +27,10 @@
INTEGER, INTENT(IN) :: mrot(3,3,nop)
REAL , INTENT(IN) :: tau(3,nop)
! - local scalars -
INTEGER :: i,j,k
INTEGER :: ikpt,ikpt0,ikpt1,nkpti
INTEGER :: iop
INTEGER :: nrkpt,nsym
INTEGER :: i,j,k,nkpt
INTEGER :: ikpt,ikpt0,nkpti
INTEGER :: nsym
! - local arrays -
INTEGER :: nkpt3(3) ! generate axbxc k-point set
INTEGER,ALLOCATABLE :: rot(:,:,:),rrot(:,:,:)
INTEGER,ALLOCATABLE :: invtab(:)
INTEGER,ALLOCATABLE :: neqkpt(:)
......@@ -41,23 +39,18 @@
REAL,ALLOCATABLE :: rtau(:,:)
REAL,ALLOCATABLE :: bk(:,:),bkhlp(:,:)
REAL,ALLOCATABLE :: rarr(:)
REAL :: rotkpt(3)
REAL :: rdum
LOGICAL :: inv,ldum
LOGICAL :: ldum
IF( nx*ny*nz .ne. nkpt )
&STOP 'kptgen_hybrid: nx*ny*nz=/nkpt'
nkpt3(1) = nx; nkpt3(2) = ny; nkpt3(3) = nz
nkpt=kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3)
ALLOCATE( bk(3,nkpt),bkhlp(3,nkpt) )
ikpt = 0
DO i=0,nkpt3(1)-1
DO j=0,nkpt3(2)-1
DO k=0,nkpt3(3)-1
DO i=0,kpts%nkpt3(1)-1
DO j=0,kpts%nkpt3(2)-1
DO k=0,kpts%nkpt3(3)-1
ikpt = ikpt + 1
bk(:,ikpt) = (/ 1.0*i/nkpt3(1),1.0*j/nkpt3(2),
& 1.0*k/nkpt3(3) /)
bk(:,ikpt) = (/ 1.0*i/kpts%nkpt3(1),1.0*j/kpts%nkpt3(2),
& 1.0*k/kpts%nkpt3(3) /)
END DO
END DO
END DO
......@@ -112,16 +105,16 @@
END DO
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
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
END DO
pkpt(nkpt3(1)+1, : , : ) = pkpt(1,:,:)
pkpt( : ,nkpt3(2)+1, : ) = pkpt(:,1,:)
pkpt( : , : ,nkpt3(3)+1) = pkpt(:,:,1)
pkpt(kpts%nkpt3(1)+1, : , : ) = pkpt(1,:,:)
pkpt( : ,kpts%nkpt3(2)+1, : ) = pkpt(:,1,:)
pkpt( : , : ,kpts%nkpt3(3)+1) = pkpt(:,:,1)
IF(any(pkpt.eq.0))
&STOP 'kptgen: Definition of pkpt-pointer failed.'
......@@ -132,15 +125,15 @@
kptp(i) = i
symkpt(i) = 1
DO k = 2,nsym
rarr = matmul(rrot(:,:,k),bk(:,i)) * nkpt3
rarr = matmul(rrot(:,:,k),bk(:,i)) * kpts%nkpt3
iarr2 = nint(rarr)
IF(any(abs(iarr2-rarr).gt.1d-10)) THEN
WRITE(6,'(A,I3,A)') 'kptgen: Symmetry operation',k,
& ' incompatible with k-point set.'
ldum = .true.
END IF
iarr2 = modulo(iarr2,nkpt3) + 1
IF(any(iarr2.gt.nkpt3))
iarr2 = modulo(iarr2,kpts%nkpt3) + 1
IF(any(iarr2.gt.kpts%nkpt3))
& STOP 'kptgen: pointer indices exceed pointer dimensions.'
j = pkpt(iarr2(1),iarr2(2),iarr2(3))
IF(j.eq.0) STOP 'kptgen: k-point index is zero (bug?)'
......@@ -171,15 +164,14 @@
kptp = iarr(kptp)
kptp(iarr) = kptp
symkpt(iarr) = symkpt
DO i=1,nkpt3(1)+1
DO j=1,nkpt3(2)+1
DO k=1,nkpt3(3)+1
DO i=1,kpts%nkpt3(1)+1
DO j=1,kpts%nkpt3(2)+1
DO k=1,kpts%nkpt3(3)+1
pkpt(i,j,k) = iarr(pkpt(i,j,k))
END DO
END DO
END DO
DEALLOCATE (rarr,iarr,iarr2)
ALLOCATE( neqkpt(nkpti) )
neqkpt = 0
DO ikpt0 = 1,nkpti
......@@ -188,15 +180,19 @@
END DO
END DO
OPEN(unit=41,file='kpts',form='formatted',status='new')
! Do not do any IO, but store in kpts
kpts%nkpt=nkpti
if (allocated(kpts%bk)) deallocate(kpts%bk)
if (allocated(kpts%wtkpt)) deallocate(kpts%wtkpt)
ALLOCATE(kpts%bk(3,kpts%nkpt),kpts%wtkpt(kpts%nkpt))
rdum = kgv( (/nkpt3(1),nkpt3(2),nkpt3(3)/),3 )
WRITE(41,'(I5,F20.10)') nkpti,rdum
DO ikpt=1,nkpti
WRITE(41,'(4F10.5)') bk(:,ikpt)*rdum,1.0*neqkpt(ikpt) !3x,f7.5,3x,f7.5,3x,f7.5,f10.5
kpts%bk(:,ikpt)=bk(:,ikpt)
kpts%wtkpt(ikpt)=neqkpt(ikpt)
END DO
CLOSE(41)
kpts%posScale=1.0
CONTAINS
! Returns least common multiple of the integers iarr(1:n).
......
inpgen/set_inp.f90
View file @ f10fd0f8
......@@ -29,7 +29,6 @@
USE m_types
USE m_juDFT_init
USE m_julia
USE m_kptgen_hybrid
USE m_od_kptsgen
USE m_inv3
......@@ -418,7 +417,7 @@
! kpts generation
CALL inv3(cell%amat,cell%bmat,cell%omtil)
cell%bmat=tpi_const*cell%bmat
kpts%nmop(:) = div(:)
kpts%nkpt3(:) = div(:)
kpts%l_gamma = l_gamma
IF (.NOT.oneD%odd%d1) THEN
IF (jij%l_J) THEN
......@@ -431,9 +430,9 @@
sym%nop2=n2
ELSE IF(kpts%l_gamma .and. banddos%ndir .eq. 0) THEN
STOP 'Error: No kpoint set generation for gamma=T yet!'
CALL kptgen_hybrid(kpts%nmop(1),kpts%nmop(2),kpts%nmop(3),&
kpts%nkpt,sym%invs,noco%l_soc,sym%nop,&
sym%mrot,sym%tau)
!CALL kptgen_hybrid(kpts%nkpt3(1),kpts%nkpt3(2),kpts%nkpt3(3),&
! kpts%nkpt,sym%invs,noco%l_soc,sym%nop,&
! sym%mrot,sym%tau)
ELSE
CALL julia(sym,cell,input,noco,banddos,kpts,.FALSE.,.TRUE.)
END IF
......
io/r_inpXML.F90
View file @ f10fd0f8
......@@ -34,9 +34,6 @@ SUBROUTINE r_inpXML(&
USE m_icorrkeys
USE m_constants
USE m_hybridmix, ONLY : aMix_VHSE, omega_VHSE
USE m_julia
USE m_kptgen_hybrid
USE m_od_kptsgen
USE m_strgndim
USE m_strgn
USE m_od_strgn1
......@@ -59,6 +56,7 @@ SUBROUTINE r_inpXML(&
USE m_apwsdim
USE m_sort
USE m_nocoInputCheck
USE m_kpoints
USE m_enpara, ONLY : r_enpara
IMPLICIT NONE
......@@ -402,7 +400,6 @@ SUBROUTINE r_inpXML(&
! Read in Brillouin zone integration parameters
kpts%nkpt3 = 0
kpts%nmop = 0
l_kpts = .FALSE.
valueString = TRIM(ADJUSTL(xmlGetAttributeValue('/fleurInput/calculationSetup/bzIntegration/@mode')))
......@@ -455,9 +452,6 @@ SUBROUTINE r_inpXML(&
kpts%nkpt3(2) = evaluateFirstIntOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@ny'))
kpts%nkpt3(3) = evaluateFirstIntOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@nz'))
kpts%l_gamma = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@gamma'))
kpts%nmop(1) = kpts%nkpt3(1)
kpts%nmop(2) = kpts%nkpt3(2)
kpts%nmop(3) = kpts%nkpt3(3)
kpts%nkpt = kpts%nkpt3(1) * kpts%nkpt3(2) * kpts%nkpt3(3)
END IF
......@@ -1956,40 +1950,8 @@ SUBROUTINE r_inpXML(&
END IF
! Calculate missing kpts parameters
IF (.not.l_kpts) THEN
IF (.NOT.oneD%odd%d1) THEN
IF (jij%l_J) THEN
n1=sym%nop
n2=sym%nop2
sym%nop=1
sym%nop2=1
CALL julia(sym,cell,input,noco,banddos,kpts,.FALSE.,.TRUE.)
sym%nop=n1
sym%nop2=n2
ELSE IF(kpts%l_gamma .and. banddos%ndir .eq. 0) THEN
CALL kptgen_hybrid(kpts%nmop(1),kpts%nmop(2),kpts%nmop(3),&
kpts%nkpt,sym%invs,noco%l_soc,sym%nop,&
sym%mrot,sym%tau)
ELSE
CALL julia(sym,cell,input,noco,banddos,kpts,.FALSE.,.TRUE.)
END IF
ELSE
STOP 'Error: No kpoint set generation for 1D systems yet!'
CALL od_kptsgen (kpts%nkpt)
END IF
END IF
sumWeight = 0.0
DO i = 1, kpts%nkpt
sumWeight = sumWeight + kpts%wtkpt(i)
kpts%bk(:,i) = kpts%bk(:,i) / kpts%posScale
END DO
kpts%posScale = 1.0
DO i = 1, kpts%nkpt
kpts%wtkpt(i) = kpts%wtkpt(i) / sumWeight
END DO
kpts%nkpt3(:) = kpts%nmop(:)
IF (kpts%nkpt3(3).EQ.0) kpts%nkpt3(3) = 1
call kpoints(oneD,jij,sym,cell,input,noco,banddos,kpts,l_kpts)
! Generate missing general parameters
......
main/fleur.F90
View file @ f10fd0f8
......@@ -66,7 +66,6 @@
USE m_coulomb
USE m_gen_map
USE m_dwigner
USE m_gen_bz
! USE m_generate_pntgpt
! USE m_rotate_eig
USE m_ylm
......@@ -234,7 +233,7 @@
IF( .NOT. ALLOCATED(results%w_iks) )&
ALLOCATE ( results%w_iks(dimension%neigd2,kpts%nkpt,dimension%jspd) )
#ifdef CPP_NEVER
IF( hybrid%l_hybrid .AND. it == 1 ) THEN
CALL juDFT_WARN ("Hybrid functionals not working in this version")
CALL timestart("generation of mixedbasis and coulombmatrix")
......@@ -246,9 +245,7 @@
mpi%n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=DIMENSION%nstd,&
nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
l_orb=banddos%l_orb)
!calculate whole Brilloun zone
CALL gen_bz(kpts,sym)
if (kpts%nkptf==0) call judft_error("kpoint-set of full BZ not available",hint="to generate kpts in the full BZ you should specify a k-mesh in inp.xml")
!construct the mixed-basis
CALL mixedbasis(atoms,kpts, dimension,input,cell,sym,xcpot,hybrid, eig_id,mpi,v,l_restart)
IF ( mpi%irank == 0 ) WRITE(*,'(A)')'...done'
......@@ -291,6 +288,7 @@
hybrid%pgptm1(0,0),hybrid%ngptm2(0),hybrid%pgptm2(0,0),hybrid%basm1(0,0,0,0),&
hybrid%basm2(0,0,0,0),hybrid%nindxm1(0,0),hybrid%nindxm2(0,0))
END IF ! first iteration hybrids
#endif
!HF
!#endif
IF (.NOT.obsolete%pot8) THEN
......@@ -319,6 +317,33 @@
!
!+t3e
ENDIF ! .not.obsolete%pot8
IF( hybrid%l_hybrid .AND. it == 1 ) THEN
CALL juDFT_WARN ("Hybrid functionals not working in this version")
CALL timestart("generation of mixedbasis and coulombmatrix")
IF ( mpi%irank == 0 ) WRITE(*,'(/A)',advance='no') ' calculation of mixedbasis...'
eig_id=open_eig(&
mpi%mpi_comm,dimension%nbasfcn,dimension