Commit b1dc7820 authored by Daniel Wortmann's avatar Daniel Wortmann

more modifications...

parent 6ae2e892
......@@ -62,36 +62,63 @@ PROGRAM inpgen
!Start program and greet user
CALL inpgen_help()
!read the input
CALL read_input(film,symor,atomid,atompos,atomlabel,amat,dvac,noco)
!First we determine the spacegoup and map the atoms to groups
CALL make_crystal(film,symor,atomid,atompos,atomlabel,amat,dvac,noco,&
cell,sym,atoms)
!All atom related parameters are set here. Note that some parameters might
!have been set in the read_input call before by adding defaults to the atompar module
CALL make_atomic_defaults(input,vacuum,cell,oneD,atoms)
INQUIRE(file='inp.xml',exist=l_inpxml)
IF (l_inpxml.AND..NOT.judft_was_argument("-inp.xml")) CALL judft_error("inp.xml exists and can not be overwritten")
IF (judft_was_argument("-inp")) THEN
STOP "not yet"
!CALL read_old_input()
full_input=.TRUE.
ELSEIF (judft_was_argument("-inp.xml")) THEN
STOP "not yet"
!CALL r_inpXML()
full_input=.TRUE.
ELSEIF(judft_was_argument("-f")) THEN
!read the input
CALL read_inpgen_input(atom_pos,atom_id,atom_label,amat,
!Set all defaults that have not been specified before or can not be specified in inpgen
call make_defaults(atoms,vacuum,input,stars,sliceplot,forcetheo,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts)
film,symor,atomid,atompos,atomlabel,amat,dvac,noco)
full_input=.FALSE.
ELSE
CALL judft_error("You should either specify -inp,-inp.xml or -f command line options. Check -h if unsure")
ENDIF
IF (.NOT.full_input) THEN
!First we determine the spacegoup and map the atoms to groups
CALL make_crystal(film,symor,atomid,atompos,atomlabel,amat,dvac,noco,&
cell,sym,atoms)
!All atom related parameters are set here. Note that some parameters might
!have been set in the read_input call before by adding defaults to the atompar module
CALL make_atomic_defaults(input,vacuum,cell,oneD,atoms)
!Set all defaults that have not been specified before or can not be specified in inpgen
CALL make_defaults(atoms,vacuum,input,stars,sliceplot,forcetheo,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts)
ENDIF
!
! k-points can also be modified here
!
call make_kpoints()
!
!Now the IO-section
!
!the inp.xml file
CALL w_inpxml(&
atoms,vacuum,input,stars,sliceplot,forcetheo,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts,&
div,l_gamma,& !should be in kpts!?
namex,relcor,dtild_opt,name_opt,&!?should be somewhere...
l_outFile,"inp.xml",&
l_explicit,enpara)
!the sym.xml file
CALL write_sym()
IF (.NOT.l_inpxml) THEN
!the inp.xml file
l_explicit=judft_was_argument("-explicit")
CALL dump_FleurInputSchema()
CALL w_inpxml(&
atoms,vacuum,input,stars,sliceplot,forcetheo,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts,&
div,l_gamma,& !should be in kpts!?
namex,relcor,dtild_opt,name_opt,&!?should be somewhere...
.false.,"inp.xml",&
l_explicit,enpara)
!the sym.xml file
CALL sym%writeXML(0,"sym.xml")
ENDIF
CALL kpts%writeXML(0,"kpts.xml")
! Structure in xsf-format
OPEN (55,file="struct.xsf")
......
......@@ -36,14 +36,25 @@ CONTAINS
SUBROUTINE make_defaults(atoms,vacuum,input,stars,&
& cell,sym,xcpot,noco,hybrid,kpts)
SUBROUTINE make_defaults(atoms,sym,vacuum,input,stars,&
& xcpot,noco,hybrid)
USE m_types
TYPE(t_atoms),INTENT(IN) ::atoms
TYPE(t_sym),INTENT(IN) ::sym
TYPE(t_vacuum),INTENT(INOUT)::vacuum
TYPE(t_input),INTENT(INOUT) ::input
TYPE(t_stars),INTENT(INOUT) ::stars
TYPE(t_xcpot),INTENT(INOUT) ::xcpot
TYPE(t_noco),INTENT(INOUT) ::noco
TYPE(t_hybrid),INTENT(INOUT)::hybrid
IMPLICIT NONE
!Set some more input switches
!
!input
!
input%delgau = input%tkb
IF (noco%l_noco) input%jspins = 2
......@@ -70,25 +81,47 @@ CONTAINS
input%rkmax = real(NINT(input%rkmax * 10 ) / 10.)
IF (noco%l_ss) input%ctail = .FALSE.
stars%gmax=merge(stars%gmax,3.0*input%rkmax,stars%gmax>0)
stars%gmax = real(NINT(stars%gmax * 10 ) / 10.)
!
! stars
!
stars%gmax = merge(stars%gmax,3.0*input%rkmax,stars%gmax>0)
stars%gmax = real(NINT(stars%gmax * 10 ) / 10.)
stars%gmaxInit = stars%gmax
xcpot%gmaxxc=merge(xcpot%gmaxxc,3.0*input%rkmax,xcpot%gmaxxc>0)
!
!xcpot
!
xcpot%gmaxxc = merge(xcpot%gmaxxc,3.0*input%rkmax,xcpot%gmaxxc>0)
xcpot%gmaxxc = real(NINT(xcpot%gmaxxc * 10 ) / 10.)
!
!vacuum
!
IF (.not.input%film) THEN
vacuum%dvac = a3(3)
Else
vacuum%dvac = real(NINT(vacuum%dvac*100)/100.)
vacuum%dvac = REAL(NINT(vacuum%dvac*100)/100.)
ENDIF
!
!HF added for HF and hybrid functionals
vacuum%nvac = 2
IF (sym%zrfs.OR.sym%invs) vacuum%nvac = 1
IF (oneD%odd%d1) vacuum%nvac = 1
!
!noco
!
ALLOCATE(noco%l_relax(atoms%ntype),noco%b_con(2,atoms%ntype))
ALLOCATE(noco%alphInit(atoms%ntype),noco%alph(atoms%ntype),noco%beta(atoms%ntype))
noco%qss = MERGE(noco%qss,[0.0,0.0,0.0],noco%l_ss)
noco%l_relax(:) = .FALSE.
noco%alphInit(:) = 0.0
noco%alph(:) = 0.0
noco%beta(:) = 0.0
noco%b_con(:,:) = 0.0
!
!hybrid
!
hybrid%gcutm1 = input%rkmax - 0.5
ALLOCATE(hybrid%lcutwf(atoms%ntype))
ALLOCATE(hybrid%lcutm1(atoms%ntype))
......@@ -101,55 +134,7 @@ CONTAINS
hybrid%select1(4,:) = 2
hybrid%l_hybrid = l_hyb
hybrid%gcutm1 = real(NINT(hybrid%gcutm1 * 10 ) / 10.)
! Set defaults for noco types
ALLOCATE(noco%l_relax(atoms%ntype),noco%b_con(2,atoms%ntype))
ALLOCATE(noco%alphInit(atoms%ntype),noco%alph(atoms%ntype),noco%beta(atoms%ntype))
noco%qss = merge(noco%qss,[0.0,0.0,0.0],noco%l_ss)
noco%l_relax(:) = .FALSE.
noco%alphInit(:) = 0.0
noco%alph(:) = 0.0
noco%beta(:) = 0.0
noco%b_con(:,:) = 0.0
! set vacuum%nvac
vacuum%nvac = 2
IF (sym%zrfs.OR.sym%invs) vacuum%nvac = 1
IF (oneD%odd%d1) vacuum%nvac = 1
IF (l_hyb) THEN
! Changes for hybrid functionals
namex = 'pbe0'
atoms%l_geo = .false.! ; input%frcor = .true.
END IF
l_explicit = juDFT_was_argument("-explicit")
IF(l_explicit) THEN
! kpts generation
CALL kpoints(oneD,sym,cell,input,noco,banddos,kpts,l_kpts)
kpts%specificationType = 3
kpts%l_gamma = .true.
IF (l_hyb) kpts%specificationType = 2
END IF
END SUBROUTINE make_defaults
END MODULE m_make_defaults
END SUBROUTINE make_defaults
END MODULE m_make_defaults
This diff is collapsed.
......@@ -16,17 +16,17 @@
!Modified for types D.W.
SUBROUTINE kptgen_hybrid(input,cell,sym,kpts,l_soc)
SUBROUTINE kptgen_hybrid(film,grid,cell,sym,kpts,l_soc)
USE m_types
USE m_divi
IMPLICIT NONE
TYPE(t_input), INTENT(IN) :: input
LOGICAL,INTENT(IN) :: film
INTEGER,INTENT(IN) :: grid(3)
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_kpts), INTENT(INOUT) :: kpts
TYPE(t_kpts), INTENT(OUT) :: kpts
! - scalars -
LOGICAL, INTENT(IN) :: l_soc
! - local scalars -
......@@ -44,21 +44,17 @@
REAL,ALLOCATABLE :: rarr(:)
LOGICAL :: ldum
IF (sum(kpts%nkpt3).EQ.0) THEN
CALL divi(kpts%nkpt,cell%bmat,input%film,sym%nop,
& sym%nop2,kpts%nkpt3)
END IF
nkpt=kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3)
nkpt=grid(1)*grid(2)*grid(3)
ALLOCATE( bk(3,nkpt),bkhlp(3,nkpt) )
ikpt = 0
DO i=0,kpts%nkpt3(1)-1
DO j=0,kpts%nkpt3(2)-1
DO k=0,kpts%nkpt3(3)-1
DO i=0,grid(1)-1
DO j=0,grid(2)-1
DO k=0,grid(3)-1
ikpt = ikpt + 1
bk(:,ikpt) = (/ 1.0*i/kpts%nkpt3(1),1.0*j/kpts%nkpt3(2),
& 1.0*k/kpts%nkpt3(3) /)
bk(:,ikpt) = (/ 1.0*i/grid(1),1.0*j/grid(2),
& 1.0*k/grid(3) /)
END DO
END DO
END DO
......@@ -113,16 +109,16 @@
END DO
ALLOCATE ( kptp(nkpt),symkpt(nkpt),rarr(3),iarr2(3),iarr(nkpt) )
ALLOCATE ( pkpt(kpts%nkpt3(1)+1,kpts%nkpt3(2)+1,kpts%nkpt3(3)+1) )
ALLOCATE ( pkpt(grid(1)+1,grid(2)+1,grid(3)+1) )
pkpt = 0
DO ikpt = 1,nkpt
iarr2 = nint ( bk(:,ikpt) * kpts%nkpt3 ) + 1
iarr2 = nint ( bk(:,ikpt) * grid ) + 1
pkpt(iarr2(1),iarr2(2),iarr2(3)) = ikpt
END DO
pkpt(kpts%nkpt3(1)+1, : , : ) = pkpt(1,:,:)
pkpt( : ,kpts%nkpt3(2)+1, : ) = pkpt(:,1,:)
pkpt( : , : ,kpts%nkpt3(3)+1) = pkpt(:,:,1)
pkpt(grid(1)+1, : , : ) = pkpt(1,:,:)
pkpt( : ,grid(2)+1, : ) = pkpt(:,1,:)
pkpt( : , : ,grid(3)+1) = pkpt(:,:,1)
IF(any(pkpt.eq.0)) THEN
CALL juDFT_error('kptgen: Definition of pkpt-pointer failed.',
......@@ -135,15 +131,15 @@
kptp(i) = i
symkpt(i) = 1
DO k = 2,nsym
rarr = matmul(rrot(:,:,k),bk(:,i)) * kpts%nkpt3
rarr = matmul(rrot(:,:,k),bk(:,i)) * grid
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,kpts%nkpt3) + 1
IF(any(iarr2.gt.kpts%nkpt3))
iarr2 = modulo(iarr2,grid) + 1
IF(any(iarr2.gt.grid))
& 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?)'
......@@ -174,9 +170,9 @@
kptp = iarr(kptp)
kptp(iarr) = kptp
symkpt(iarr) = symkpt
DO i=1,kpts%nkpt3(1)+1
DO j=1,kpts%nkpt3(2)+1
DO k=1,kpts%nkpt3(3)+1
DO i=1,grid(1)+1
DO j=1,grid(2)+1
DO k=1,grid(3)+1
pkpt(i,j,k) = iarr(pkpt(i,j,k))
END DO
END DO
......@@ -201,7 +197,6 @@
kpts%bk(:,ikpt)=bk(:,ikpt)
kpts%wtkpt(ikpt)=neqkpt(ikpt)
END DO
kpts%posScale=1.0
CONTAINS
......
This diff is collapsed.
......@@ -2,19 +2,17 @@
use m_juDFT
CONTAINS
SUBROUTINE kpttet(
> iofile,ibfile,iokpt,
> kpri,ktest,kmidtet,mkpt,ndiv3,
> nreg,nfulst,rltv,voluni,
> kmidtet,mkpt,ndiv3,
> rltv,voluni,
> nsym,ccr,mdir,mface,
> ncorn,nface,fdist,fnorm,cpoint,
< voltet,ntetra,ntet,vktet,
= nkpt,
< divis,vkxyz,wghtkp)
< vkxyz,wghtkp)
c
c
c ---> This program generates k-points
c in irreducible wedge of BZ (for nreg=0)
c in total BZ (for nreg=1)
c in irreducible wedge of BZ
c (BZ = 1. Brillouin-zone) for all canonical Bravais lattices
c in 3 dimensions,
c using the basis vectors of the reciprocal lattice,
......@@ -48,9 +46,6 @@ c nface : number of faces of the irrBZ
c cpoint : cartesian coordinates of corner points of irrBZ
c
c characterization of the tetrahedron-method k-point set:
c nreg : 1 kpoints in full BZ; 0 kpoints in irrBZ
c nfulst : 1 kpoints ordered in full stars
c (meaningful only for nreg =1; full BZ)
c nkpt : on input: required number of k-points inside irrBZ
c to build the tetrahedrons
c ntet : number of tetrahedra generated
......@@ -65,9 +60,6 @@ c OUTPUT: k-point set
c nkpt : number of k-points generated in set
c vkxyz : vector of kpoint generated; in cartesian representation
c wghtkp : weight associated with k-points for BZ integration
c divis : integer triple divis(i); i=1,4.
c Used to find more accurate representation of k-points
c vklmn(i,kpt)/divis(i) and weights as wght(kpt)/divis(4)
c
c-----------------------------------------------------------------------
USE m_constants, ONLY : pimach
......@@ -80,13 +72,8 @@ C-----> PARAMETER STATEMENTS
C
INTEGER, INTENT (IN) :: mkpt,ndiv3,mface,mdir
c
c ---> file number for read and write
c
INTEGER, INTENT (IN) :: iofile,iokpt,ibfile
c
c ---> running mode parameter
c
INTEGER, INTENT (IN) :: kpri,ktest
C
C-----> Symmetry information
C
......@@ -105,11 +92,11 @@ C
C
C-----> BRILLOUINE ZONE INTEGRATION
C
INTEGER, INTENT (IN) :: nreg,nfulst,kmidtet
INTEGER, INTENT (IN) :: kmidtet
INTEGER, INTENT (INOUT) :: nkpt
INTEGER, INTENT (OUT) :: ntetra(4,ndiv3),ntet
REAL, INTENT (OUT) :: voltet(ndiv3),vktet(3,mkpt)
REAL, INTENT (OUT) :: vkxyz(3,mkpt),wghtkp(mkpt),divis(4)
REAL, INTENT (OUT) :: vkxyz(3,mkpt),wghtkp(mkpt)
C
C ---> local variables
......@@ -127,38 +114,16 @@ c======================================================================
c
tpi = 2.0 * pimach()
c
IF (kpri.GE.1) THEN
WRITE (iofile,'(3x,'' *<* kpttet *>* '')')
WRITE (iofile,'(3x,'' generate k-vectors'')')
WRITE (iofile,'(3x,'' ~~~~~~~~~~~~~~~~~~'')')
WRITE (iofile,'(3x,'' by tetrahedron-method'')')
WRITE (iofile,'(3x,'' ~~~~~~~~~~~~~~~~~~~~~'')')
ENDIF
WRITE (iofile,'('' k-points generated with tetrahedron '',
WRITE (6,'('' k-points generated with tetrahedron '',
> ''method'')')
WRITE (iokpt,'(''# k-points generated with tetrahedron '',
WRITE (6,'(''# k-points generated with tetrahedron '',
> ''method'')')
IF (nreg .EQ. 0) THEN
WRITE (iofile,'(3x,'' in irred wedge of 1. Brillouin zone'')')
WRITE (iofile,'(3x,'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'')')
WRITE (iokpt,'(''#'',i4,21x,''nreg: k-points in irrBZ'')') nreg
ELSEIF (nreg .eq. 1 .and. nfulst .eq. 1) then
WRITE (iofile,'(3x,'' in 1. Brillouin zone'')')
WRITE (iofile,'(3x,'' ~~~~~~~~~~~~~~~~~~~~'')')
WRITE (iofile,'(3x,'' full stars generated'')')
WRITE (iofile,'(3x,'' ~~~~~~~~~~~~~~~~~~~~'')')
WRITE (iokpt,'(''#'',2(i4,1x),14x,'' nreg,nfulst: '',
> ''k-points in totBZ, ordered in full stars'')') nreg,nfulst
ELSE
WRITE (iofile,'(2(1x,i4),4x,'' nreg,nfulst: wrong choice;'',
> /,27x,'' allowed combinations: (1,1); (0,0),(0,1)'')' )
> nreg,nfulst
CALL juDFT_error("nreg,nfulst: wrong choice",calledby="kpttet")
ENDIF
WRITE (6,'(3x,'' in irred wedge of 1. Brillouin zone'')')
WRITE (6,'(3x,'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'')')
CALL kvecon(
> iofile,ibfile,mkpt,mface,
> 6,6,mkpt,mface,
> nkpt,ncorn,nsym,nface,rltv,fdist,fnorm,cpoint,
< vktet )
!
......@@ -169,22 +134,22 @@ c
! ---> determine the volume of each tetrahedron
!
CALL tetcon(
> iofile,ibfile,mkpt,ndiv3,
> 6,6,mkpt,ndiv3,
> nkpt,voluni,vktet,
= nsym,
< ntet,voltet,ntetra)
c
WRITE (iofile,'('' the number of tetrahedra '')')
WRITE (iofile,*) ntet
WRITE (iofile,'('' volumes of the tetrahedra '')')
WRITE (iofile,'(e19.12,1x,i5,5x,''voltet(i),i'')')
WRITE (6,'('' the number of tetrahedra '')')
WRITE (6,*) ntet
WRITE (6,'('' volumes of the tetrahedra '')')
WRITE (6,'(e19.12,1x,i5,5x,''voltet(i),i'')')
> (voltet(i),i,i=1,ntet)
WRITE (iofile,'('' corners of the tetrahedra '')')
WRITE (iofile, 999) ((ntetra(j,i),j=1,4),i=1,ntet)
WRITE (iofile,'('' the # of different k-points '')')
WRITE (iofile,*) nkpt
WRITE (iofile,'('' k-points used to construct tetrahedra'')')
WRITE (iofile,'(3(4x,f10.6))') ((vktet(i,j),i=1,3),j=1,nkpt)
WRITE (6,'('' corners of the tetrahedra '')')
WRITE (6, 999) ((ntetra(j,i),j=1,4),i=1,ntet)
WRITE (6,'('' the # of different k-points '')')
WRITE (6,*) nkpt
WRITE (6,'('' k-points used to construct tetrahedra'')')
WRITE (6,'(3(4x,f10.6))') ((vktet(i,j),i=1,3),j=1,nkpt)
999 FORMAT (4(3x,4i4))
c
c ---> calculate weights from volume of tetrahedra
......@@ -207,7 +172,7 @@ c
ENDDO
ENDIF
ELSE
WRITE (iofile, '(2(e19.12,1x),5x,''summvol.ne.volirbz'')')
WRITE (6, '(2(e19.12,1x),5x,''summvol.ne.volirbz'')')
> sumvol,volirbz
CALL juDFT_error("sumvol =/= volirbz",calledby="kpttet")
ENDIF
......@@ -218,7 +183,7 @@ c
c
DO i = 1, nkpt
vkxyz(:,i) = vktet(:,i)
WRITE (iofile,'(3(f10.7,1x),f12.10,1x,i4,3x,
WRITE (6,'(3(f10.7,1x),f12.10,1x,i4,3x,
+ ''vkxyz, wghtkp'')') (vkxyz(ii,i),ii=1,3),wghtkp(i),i
ENDDO
nkstar = nkpt
......@@ -236,10 +201,10 @@ c
ENDDO
nkpt = ntet
WRITE (iofile,'('' the new number of k-points is '',i4)') nkpt
WRITE (iofile,'('' the new k-points are the '',
WRITE (6,'('' the new number of k-points is '',i4)') nkpt
WRITE (6,'('' the new k-points are the '',
+ ''mid-tetrahedron-points '')')
WRITE (iokpt,'(''# the new k-points are the '',
WRITE (6,'(''# the new k-points are the '',
+ ''mid-tetrahedron-points '')')
sumwght = 0.00
DO i=1,ntet
......@@ -250,48 +215,22 @@ c
! ---> check sumwght; if abs(sumwght-1).lt.eps print kpoints and weights
!
IF ( abs(sumwght - one).LT.eps) THEN
WRITE (iofile,'(1x,f12.10,1x,'' sumwght .eq. one'')')
WRITE (6,'(1x,f12.10,1x,'' sumwght .eq. one'')')
+ sumwght
DO i=1,nkpt
WRITE (iofile,'(3(f10.7,1x),f12.10,1x,i4,3x,
WRITE (6,'(3(f10.7,1x),f12.10,1x,i4,3x,
+ ''vkxyz, wghtkp'')') (vkxyz(ii,i),ii=1,3),wghtkp(i), i
ENDDO
nkstar = ntet
ELSE
WRITE (iofile,'(1x,f12.10,1x,'' sumwght .ne. one'')')
WRITE (6,'(1x,f12.10,1x,'' sumwght .ne. one'')')
+ sumwght
CALL juDFT_error("sumwght",calledby="kpttet")
ENDIF
END IF ! end of generation of mid-tetrahedron k-points
!
! ---> set denominators for more accurate k-point representation
!
DO i=1,4
divis(i) = real(nkpt)
ENDDO
IF ( nreg.EQ.1 .AND. nfulst.EQ.1 ) THEN
! ---> generate full stars for all representative k-points
! - for nreg=1 and nfulst=1:
! - determine order of full star ifstar(kpn).le.nsym
! - assign nkpt= sum {ifstar(ik)} (ik=1,ntet)
! - assign vkxyz(ix,kpn) = vkstar(ix,ikpn(is,ik));
! ix=1,3; kpn=1,nkpt; ik=1,ntet; is=1,ifstar(ik)
! - calculate wghtkp(kpn)=wghtkp_old(ik)/ifstar(ik)
! kpn=1,nkpt; ik=1,ntet
CALL fulstar(
> iofile,iokpt,kpri,ktest,
> ccr,nsym,
> vkxyz,nkstar,mkpt,mface,mdir,
= nkpt,vkxyz,wghtkp)
divis(4) = divis(4) * nsym
ENDIF
RETURN
END SUBROUTINE kpttet
......
This diff is collapsed.
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