Commit ff0cec65 authored by Daniel Wortmann's avatar Daniel Wortmann

Fixed bugs and updated more tests

parent be8a712f
...@@ -58,20 +58,20 @@ CONTAINS ...@@ -58,20 +58,20 @@ CONTAINS
call mpi_bc(this%vol,rank,mpi_comm) call mpi_bc(this%vol,rank,mpi_comm)
call mpi_bc(this%volint,rank,mpi_comm) call mpi_bc(this%volint,rank,mpi_comm)
end subroutine mpi_bc_cell end subroutine mpi_bc_cell
SUBROUTINE init(cell,volmts) SUBROUTINE init(cell,volmts)
!initialize cell, only input is cell%amat and cell%z1 in case of a film !initialize cell, only input is cell%amat and cell%z1 in case of a film
USE m_constants,ONLY:tpi_const USE m_constants,ONLY:tpi_const
CLASS (t_cell),INTENT(INOUT):: cell CLASS (t_cell),INTENT(INOUT):: cell
real,intent(in):: volmts !Volume of all MT-spheres real,intent(in):: volmts !Volume of all MT-spheres
CALL inv3(cell%amat,cell%bmat,cell%omtil) CALL inv3(cell%amat,cell%bmat,cell%omtil)
IF (cell%omtil<0) CALL judft_warn("Negative volume! You are using a left-handed coordinate system") IF (cell%omtil<0) CALL judft_warn("Negative volume! You are using a left-handed coordinate system")
cell%omtil=ABS(cell%omtil) cell%omtil=ABS(cell%omtil)
cell%bmat=tpi_const*cell%bmat cell%bmat=tpi_const*cell%bmat
IF (cell%z1>0) THEN IF (cell%z1>0) THEN
cell%vol = (cell%omtil/cell%amat(3,3))*cell%z1 cell%vol = (cell%omtil/cell%amat(3,3))*cell%z1*2
cell%area = cell%omtil/cell%amat(3,3) cell%area = cell%omtil/cell%amat(3,3)
ELSE ELSE
cell%vol = cell%omtil cell%vol = cell%omtil
...@@ -109,7 +109,7 @@ CONTAINS ...@@ -109,7 +109,7 @@ CONTAINS
b(3,1) = (a(2,1)*a(3,2)-a(2,2)*a(3,1))/d b(3,1) = (a(2,1)*a(3,2)-a(2,2)*a(3,1))/d
b(3,2) = (a(1,2)*a(3,1)-a(1,1)*a(3,2))/d b(3,2) = (a(1,2)*a(3,1)-a(1,1)*a(3,2))/d
b(3,3) = (a(1,1)*a(2,2)-a(1,2)*a(2,1))/d b(3,3) = (a(1,1)*a(2,2)-a(1,2)*a(2,1))/d
END SUBROUTINE inv3 END SUBROUTINE inv3
END SUBROUTINE init END SUBROUTINE init
...@@ -118,20 +118,21 @@ CONTAINS ...@@ -118,20 +118,21 @@ CONTAINS
use m_types_xml use m_types_xml
class(t_cell),intent(INout)::this class(t_cell),intent(INout)::this
type(t_xml),intent(in) ::xml type(t_xml),intent(in) ::xml
! Read in lattice parameters ! Read in lattice parameters
character(len=200)::valueString,path character(len=200)::valueString,path
REAL:: scale,dvac,dtild REAL:: scale,dvac,dtild
if (xml%GetNumberOfNodes('/fleurInput/cell/filmLattice')==1) then if (xml%GetNumberOfNodes('/fleurInput/cell/filmLattice')==1) then
path= '/fleurInput/cell/filmLattice' path= '/fleurInput/cell/filmLattice'
this%z1=evaluateFirstOnly(xml%GetAttributeValue(trim(path)//'/@dvac'))/2 this%z1=evaluateFirstOnly(xml%GetAttributeValue(trim(path)//'/@dVac'))/2
dtild=evaluateFirstOnly(xml%GetAttributeValue(trim(path)//'/@dtilda')) dvac=this%z1*2
else dtild=evaluateFirstOnly(xml%GetAttributeValue(trim(path)//'/@dTilda'))
else
dvac=0.0 dvac=0.0
path = '/fleurInput/cell/bulkLattice' path = '/fleurInput/cell/bulkLattice'
endif endif
scale=evaluateFirstOnly(xml%GetAttributeValue(trim(path)//'/@scale')) scale=evaluateFirstOnly(xml%GetAttributeValue(trim(path)//'/@scale'))
path=trim(path)//'/bravaisMatrix' path=trim(path)//'/bravaisMatrix'
valueString = TRIM(ADJUSTL(xml%GetAttributeValue(TRIM(ADJUSTL(path))//'/row-1'))) valueString = TRIM(ADJUSTL(xml%GetAttributeValue(TRIM(ADJUSTL(path))//'/row-1')))
...@@ -146,12 +147,12 @@ CONTAINS ...@@ -146,12 +147,12 @@ CONTAINS
this%amat(1,3) = evaluateFirst(valueString) this%amat(1,3) = evaluateFirst(valueString)
this%amat(2,3) = evaluateFirst(valueString) this%amat(2,3) = evaluateFirst(valueString)
this%amat(3,3) = evaluateFirst(valueString) this%amat(3,3) = evaluateFirst(valueString)
IF (dvac>0) THEN IF (dvac>0) THEN
this%amat(3,3)=2*this%z1 this%amat(3,3)=dtild
ENDIF ENDIF
this%amat=this%amat*scale this%amat=this%amat*scale
END SUBROUTINE read_xml_cell END SUBROUTINE read_xml_cell
END MODULE m_types_cell END MODULE m_types_cell
...@@ -19,7 +19,7 @@ MODULE m_types_oneD ...@@ -19,7 +19,7 @@ MODULE m_types_oneD
INTEGER :: kimax2 INTEGER :: kimax2
INTEGER :: nop=0, nat=0 INTEGER :: nop=0, nat=0
END TYPE od_dim END TYPE od_dim
TYPE od_inp TYPE od_inp
LOGICAL :: d1 LOGICAL :: d1
INTEGER :: mb, M, k3, m_cyl INTEGER :: mb, M, k3, m_cyl
...@@ -31,7 +31,7 @@ MODULE m_types_oneD ...@@ -31,7 +31,7 @@ MODULE m_types_oneD
INTEGER, POINTER :: kv(:, :) !(2,n2d) INTEGER, POINTER :: kv(:, :) !(2,n2d)
INTEGER, POINTER :: nst2(:) !(n2d) INTEGER, POINTER :: nst2(:) !(n2d)
END TYPE od_inp END TYPE od_inp
TYPE od_sym TYPE od_sym
INTEGER :: nop, nat INTEGER :: nop, nat
INTEGER, POINTER :: ngopr(:) !(nat) INTEGER, POINTER :: ngopr(:) !(nat)
...@@ -40,13 +40,13 @@ MODULE m_types_oneD ...@@ -40,13 +40,13 @@ MODULE m_types_oneD
INTEGER, POINTER :: invtab(:) !(nop) INTEGER, POINTER :: invtab(:) !(nop)
INTEGER, POINTER :: multab(:, :) !(nop,nop) INTEGER, POINTER :: multab(:, :) !(nop,nop)
END TYPE od_sym END TYPE od_sym
TYPE od_lda TYPE od_lda
INTEGER :: nn2d INTEGER :: nn2d
INTEGER, POINTER :: igf(:, :) !(0:nn2d-1,2) INTEGER, POINTER :: igf(:, :) !(0:nn2d-1,2)
REAL, POINTER :: pgf(:) !(0:nn2d-1) REAL, POINTER :: pgf(:) !(0:nn2d-1)
END TYPE od_lda END TYPE od_lda
TYPE od_gga TYPE od_gga
INTEGER :: nn2d INTEGER :: nn2d
REAL, POINTER :: pgfx(:) ! (0:nn2d-1) REAL, POINTER :: pgfx(:) ! (0:nn2d-1)
...@@ -111,11 +111,11 @@ MODULE m_types_oneD ...@@ -111,11 +111,11 @@ MODULE m_types_oneD
class(t_oned),intent(inout)::this class(t_oned),intent(inout)::this
type(t_xml),intent(in) ::xml type(t_xml),intent(in) ::xml
! Read in optional 1D parameters if present ! Read in optional 1D parameters if present
character(len=100):: xpathA character(len=100):: xpathA
integer :: numberNodes integer :: numberNodes
xPathA = '/fleurInput/calculationSetup/oneDParams' xPathA = '/fleurInput/calculationSetup/oneDParams'
numberNodes = xml%GetNumberOfNodes(xPathA) numberNodes = xml%GetNumberOfNodes(xPathA)
...@@ -138,10 +138,30 @@ MODULE m_types_oneD ...@@ -138,10 +138,30 @@ MODULE m_types_oneD
USE m_types_atoms USE m_types_atoms
CLASS(t_oned),INTENT(inout)::oneD CLASS(t_oned),INTENT(inout)::oneD
TYPE(t_atoms),INTENT(in)::atoms TYPE(t_atoms),INTENT(in)::atoms
oneD%odd%nq2 = oneD%odd%n2d
oneD%odd%kimax2 = oneD%odd%nq2 - 1
oneD%odd%nat = atoms%nat
oneD%odi%d1 = oneD%odd%d1 ; oneD%odi%mb = oneD%odd%mb ; oneD%odi%M = oneD%odd%M
oneD%odi%k3 = oneD%odd%k3 ; oneD%odi%chi = oneD%odd%chi ; oneD%odi%rot = oneD%odd%rot
oneD%odi%invs = oneD%odd%invs ; oneD%odi%zrfs = oneD%odd%zrfs
oneD%odi%n2d = oneD%odd%n2d ; oneD%odi%nq2 = oneD%odd%nq2 ; oneD%odi%nn2d = oneD%odd%nn2d
oneD%odi%kimax2 = oneD%odd%kimax2 ; oneD%odi%m_cyl = oneD%odd%m_cyl
oneD%odi%ig => oneD%ig1 ; oneD%odi%kv => oneD%kv1 ; oneD%odi%nst2 => oneD%nstr1
oneD%ods%nop = oneD%odd%nop ; oneD%ods%nat = oneD%odd%nat
oneD%ods%mrot => oneD%mrot1 ; oneD%ods%tau => oneD%tau1 ; oneD%ods%ngopr => oneD%ngopr1
oneD%ods%invtab => oneD%invtab1 ; oneD%ods%multab => oneD%multab1
oneD%odl%nn2d = oneD%odd%nn2d
oneD%odl%igf => oneD%igfft1 ; oneD%odl%pgf => oneD%pgfft1
oneD%odg%nn2d = oneD%odd%nn2d
oneD%odg%pgfx => oneD%pgft1x ; oneD%odg%pgfy => oneD%pgft1y
oneD%odg%pgfxx => oneD%pgft1xx ; oneD%odg%pgfyy => oneD%pgft1yy ; oneD%odg%pgfxy => oneD%pgft1xy
oneD%odd%nq2 = oneD%odd%n2d
! Initialize missing 1D code arrays ! Initialize missing 1D code arrays
if (associated(oneD%ig1)) return
ALLOCATE (oneD%ig1(-oneD%odd%k3:oneD%odd%k3,-oneD%odd%M:oneD%odd%M)) ALLOCATE (oneD%ig1(-oneD%odd%k3:oneD%odd%k3,-oneD%odd%M:oneD%odd%M))
ALLOCATE (oneD%kv1(2,oneD%odd%n2d),oneD%nstr1(oneD%odd%n2d)) ALLOCATE (oneD%kv1(2,oneD%odd%n2d),oneD%nstr1(oneD%odd%n2d))
ALLOCATE (oneD%ngopr1(atoms%nat),oneD%mrot1(3,3,oneD%odd%nop),oneD%tau1(3,oneD%odd%nop)) ALLOCATE (oneD%ngopr1(atoms%nat),oneD%mrot1(3,3,oneD%odd%nop),oneD%tau1(3,oneD%odd%nop))
......
...@@ -32,6 +32,7 @@ MODULE m_types_vacuum ...@@ -32,6 +32,7 @@ MODULE m_types_vacuum
CONTAINS CONTAINS
PROCEDURE :: read_xml PROCEDURE :: read_xml
PROCEDURE :: mpi_bc => mpi_bc_vacuum PROCEDURE :: mpi_bc => mpi_bc_vacuum
PROCEDURE :: init =>vacuum_init
END TYPE t_vacuum END TYPE t_vacuum
CONTAINS CONTAINS
...@@ -65,14 +66,14 @@ MODULE m_types_vacuum ...@@ -65,14 +66,14 @@ MODULE m_types_vacuum
CALL mpi_bc(this%locy(2),rank,mpi_comm) CALL mpi_bc(this%locy(2),rank,mpi_comm)
CALL mpi_bc(this%starcoeff,rank,mpi_comm) CALL mpi_bc(this%starcoeff,rank,mpi_comm)
CALL mpi_bc(this%izlay,rank,mpi_comm) CALL mpi_bc(this%izlay,rank,mpi_comm)
END SUBROUTINE mpi_bc_vacuum END SUBROUTINE mpi_bc_vacuum
SUBROUTINE read_xml(this,xml) SUBROUTINE read_xml(this,xml)
USE m_types_xml USE m_types_xml
CLASS(t_vacuum),INTENT(INOUT)::this CLASS(t_vacuum),INTENT(INOUT)::this
TYPE(t_xml),INTENT(IN)::xml TYPE(t_xml),INTENT(IN)::xml
CHARACTER(len=100)::xpatha CHARACTER(len=100)::xpatha
IF (xml%GetNumberOfNodes('/fleurInput/cell/filmLattice')==1) THEN IF (xml%GetNumberOfNodes('/fleurInput/cell/filmLattice')==1) THEN
this%dvac = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/cell/filmLattice/@dVac')) this%dvac = evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/cell/filmLattice/@dVac'))
...@@ -93,6 +94,15 @@ MODULE m_types_vacuum ...@@ -93,6 +94,15 @@ MODULE m_types_vacuum
END IF END IF
this%layerd = this%layers this%layerd = this%layers
ALLOCATE(this%izlay(this%layerd,2)) ALLOCATE(this%izlay(this%layerd,2))
ENDIF ENDIF
END SUBROUTINE read_xml END SUBROUTINE read_xml
subroutine vacuum_init(this,sym)
use m_types_sym
CLASS(t_vacuum),INTENT(INOUT)::this
TYPE(t_sym),INTENT(IN)::sym
if (sym%invs.or.sym%zrfs) this%nvac=1
end subroutine vacuum_init
END MODULE m_types_vacuum END MODULE m_types_vacuum
...@@ -32,7 +32,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,& ...@@ -32,7 +32,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
USE m_od_kptsgen USE m_od_kptsgen
USE m_relaxio USE m_relaxio
IMPLICIT NONE IMPLICIT NONE
TYPE(t_mpi) ,INTENT (IN) :: mpi TYPE(t_mpi) ,INTENT (IN) :: mpi
...@@ -40,7 +40,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,& ...@@ -40,7 +40,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
TYPE(t_forcetheo_data),INTENT(IN):: forcetheo_data TYPE(t_forcetheo_data),INTENT(IN):: forcetheo_data
TYPE(t_input), INTENT(INOUT) :: input TYPE(t_input), INTENT(INOUT) :: input
TYPE(t_sym), INTENT(INOUT) :: sym TYPE(t_sym), INTENT(INOUT) :: sym
TYPE(t_stars), INTENT(INOUT) :: stars TYPE(t_stars), INTENT(INOUT) :: stars
TYPE(t_atoms), INTENT(INOUT) :: atoms TYPE(t_atoms), INTENT(INOUT) :: atoms
TYPE(t_vacuum), INTENT(INOUT) :: vacuum TYPE(t_vacuum), INTENT(INOUT) :: vacuum
TYPE(t_kpts), INTENT(INOUT) :: kpts TYPE(t_kpts), INTENT(INOUT) :: kpts
...@@ -57,17 +57,17 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,& ...@@ -57,17 +57,17 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
TYPE(t_sphhar) ,INTENT (OUT) :: sphhar TYPE(t_sphhar) ,INTENT (OUT) :: sphhar
TYPE(t_field), INTENT(INOUT) :: field TYPE(t_field), INTENT(INOUT) :: field
LOGICAL, INTENT (IN) :: l_kpts LOGICAL, INTENT (IN) :: l_kpts
INTEGER :: i, j, n, na, n1, n2, iType, l, ilo, ikpt INTEGER :: i, j, n, na, n1, n2, iType, l, ilo, ikpt
INTEGER :: minNeigd, nv, nv2, kq1, kq2, kq3, jrc, jsp, ii INTEGER :: minNeigd, nv, nv2, kq1, kq2, kq3, jrc, jsp, ii
INTEGER :: ios, ntst, ierr INTEGER :: ios, ntst, ierr
REAL :: rmtmax, zp, radius, dr REAL :: rmtmax, zp, radius, dr
LOGICAL :: l_vca, l_test LOGICAL :: l_vca, l_test
INTEGER, ALLOCATABLE :: jri1(:), lmax1(:) INTEGER, ALLOCATABLE :: jri1(:), lmax1(:)
REAL, ALLOCATABLE :: rmt1(:), dx1(:) REAL, ALLOCATABLE :: rmt1(:), dx1(:)
#ifdef CPP_MPI #ifdef CPP_MPI
INCLUDE 'mpif.h' INCLUDE 'mpif.h'
#endif #endif
...@@ -78,17 +78,17 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,& ...@@ -78,17 +78,17 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
call cell%init(DOT_PRODUCT(atoms%volmts(:),atoms%neq(:))) call cell%init(DOT_PRODUCT(atoms%volmts(:),atoms%neq(:)))
call atoms%init(cell) call atoms%init(cell)
CALL sym%init(cell,input%film) CALL sym%init(cell,input%film)
call vacuum%init(sym)
CALL enpara%init_enpara(atoms,input%jspins,input%film,enparaXML) CALL enpara%init_enpara(atoms,input%jspins,input%film,enparaXML)
CALL make_sym(sym,cell,atoms,noco,oneD,input) CALL make_sym(sym,cell,atoms,noco,oneD,input)
call make_forcetheo(forcetheo_data,cell,sym,atoms,forcetheo) call make_forcetheo(forcetheo_data,cell,sym,atoms,forcetheo)
call make_xcpot(xcpot,atoms,input) call make_xcpot(xcpot,atoms,input)
IF (mpi%irank.EQ.0) call check_input_switches(banddos,vacuum,noco,atoms,input) IF (mpi%irank.EQ.0) call check_input_switches(banddos,vacuum,noco,atoms,input)
! Generate missing general parameters ! Generate missing general parameters
minNeigd = MAX(5,NINT(0.75*input%zelec) + 1) minNeigd = MAX(5,NINT(0.75*input%zelec) + 1)
IF (noco%l_soc.and.(.not.noco%l_noco)) minNeigd = 2 * minNeigd IF (noco%l_soc.and.(.not.noco%l_noco)) minNeigd = 2 * minNeigd
IF (noco%l_soc.and.noco%l_ss) minNeigd=(3*minNeigd)/2 IF (noco%l_soc.and.noco%l_ss) minNeigd=(3*minNeigd)/2
...@@ -99,9 +99,9 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,& ...@@ -99,9 +99,9 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
ENDIF ENDIF
dimension%neigd = minNeigd dimension%neigd = minNeigd
END IF END IF
CALL lapw_dim(kpts,cell,input,noco,oneD,forcetheo,DIMENSION) CALL lapw_dim(kpts,cell,input,noco,oneD,forcetheo,DIMENSION)
IF(dimension%neigd.EQ.-1) THEN IF(dimension%neigd.EQ.-1) THEN
dimension%neigd = dimension%nvd + atoms%nlotot dimension%neigd = dimension%nvd + atoms%nlotot
END IF END IF
...@@ -111,7 +111,6 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,& ...@@ -111,7 +111,6 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
CALL ylmnorm_init(atoms%lmaxd) CALL ylmnorm_init(atoms%lmaxd)
call oneD%init(atoms) call oneD%init(atoms)
...@@ -120,18 +119,18 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,& ...@@ -120,18 +119,18 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
! Check muffin tin radii ! Check muffin tin radii
l_test = .TRUE. ! only checking, dont use new parameters l_test = .TRUE. ! only checking, dont use new parameters
CALL chkmt(atoms,input,vacuum,cell,oneD,l_test) CALL chkmt(atoms,input,vacuum,cell,oneD,l_test)
!adjust positions by displacements !adjust positions by displacements
CALL apply_displacements(cell,input,vacuum,oneD,sym,noco,atoms) CALL apply_displacements(cell,input,vacuum,oneD,sym,noco,atoms)
call make_sphhar(atoms,sphhar,sym,cell,oneD) call make_sphhar(atoms,sphhar,sym,cell,oneD)
CALL make_stars(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot,oneD,noco,mpi) CALL make_stars(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot,oneD,noco,mpi)
! Store structure data ! Store structure data
CALL storeStructureIfNew(input,stars, atoms, cell, vacuum, oneD, sym, mpi,sphhar,noco) CALL storeStructureIfNew(input,stars, atoms, cell, vacuum, oneD, sym, mpi,sphhar,noco)
!Adjust kpoints in case of DOS !Adjust kpoints in case of DOS
IF ( banddos%dos .AND. banddos%ndir == -3 ) THEN IF ( banddos%dos .AND. banddos%ndir == -3 ) THEN
WRITE(*,*) 'Recalculating k point grid to cover the full BZ.' WRITE(*,*) 'Recalculating k point grid to cover the full BZ.'
!CALL gen_bz(kpts,sym) !CALL gen_bz(kpts,sym)
...@@ -141,14 +140,14 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,& ...@@ -141,14 +140,14 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
kpts%bk(:,:) = kpts%bkf(:,:) kpts%bk(:,:) = kpts%bkf(:,:)
kpts%wtkpt = 1.0 / kpts%nkptf kpts%wtkpt = 1.0 / kpts%nkptf
END IF END IF
CALL prp_xcfft(stars,input,cell,xcpot) CALL prp_xcfft(stars,input,cell,xcpot)
IF (.NOT.sliceplot%iplot) THEN IF (.NOT.sliceplot%iplot) THEN
IF (mpi%irank.EQ.0) THEN IF (mpi%irank.EQ.0) THEN
CALL convn(atoms,stars) CALL convn(atoms,stars)
CALL e_field(atoms,DIMENSION,stars,sym,vacuum,cell,input,field%efield) CALL e_field(atoms,DIMENSION,stars,sym,vacuum,cell,input,field%efield)
...@@ -159,12 +158,13 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,& ...@@ -159,12 +158,13 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
#ifdef CPP_MPI #ifdef CPP_MPI
CALL MPI_BCAST(atoms%nat,1,MPI_INTEGER,0,mpi%mpi_comm,ierr) CALL MPI_BCAST(atoms%nat,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
#endif #endif
IF (.not.noco%l_noco) & IF (.not.noco%l_noco) &
CALL transform_by_moving_atoms(mpi,stars,atoms,vacuum, cell, sym, sphhar,input,oned,noco) CALL transform_by_moving_atoms(mpi,stars,atoms,vacuum, cell, sym, sphhar,input,oned,noco)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! End of input postprocessing (calculate missing parameters) !!! End of input postprocessing (calculate missing parameters)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
call oneD%init(atoms)
END SUBROUTINE postprocessInput END SUBROUTINE postprocessInput
......
...@@ -109,7 +109,7 @@ CONTAINS ...@@ -109,7 +109,7 @@ CONTAINS
INQUIRE(file='kpts',exist=l_exist) INQUIRE(file='kpts',exist=l_exist)
IF (.NOT.l_exist) CALL judft_error("Could not read 'kpts' file") IF (.NOT.l_exist) CALL judft_error("Could not read 'kpts' file")
OPEN(99,file='kpts') OPEN(99,file='kpts')
READ(99,*,iostat=ios) kpts%nkpt,scale,wscale READ(99,"(i5,2f20.10,3x,l1)",iostat=ios) kpts%nkpt,scale,wscale
ALLOCATE(kpts%bk(3,kpts%nkpt),kpts%wtkpt(kpts%nkpt)) ALLOCATE(kpts%bk(3,kpts%nkpt),kpts%wtkpt(kpts%nkpt))
DO n=1,kpts%nkpt DO n=1,kpts%nkpt
IF (.NOT.film) THEN IF (.NOT.film) THEN
...@@ -119,7 +119,12 @@ CONTAINS ...@@ -119,7 +119,12 @@ CONTAINS
kpts%bk(3,n)=0.0 kpts%bk(3,n)=0.0
ENDIF ENDIF
ENDDO ENDDO
CLOSE(99) !check for tetraeder
READ(99,*,err=100,end=100) kpts%ntet
ALLOCATE(kpts%ntetra(4,kpts%ntet),kpts%voltet(kpts%ntet))
read(99,*) kpts%ntetra
read(99,*) kpts%voltet
100 CLOSE(99)
IF (ios.NE.0) CALL judft_error("Error while reading 'kpts' file") IF (ios.NE.0) CALL judft_error("Error while reading 'kpts' file")
IF (scale>0.0) kpts%bk=kpts%bk/scale IF (scale>0.0) kpts%bk=kpts%bk/scale
IF (wscale>0.0) kpts%wtkpt=kpts%wtkpt/wscale IF (wscale>0.0) kpts%wtkpt=kpts%wtkpt/wscale
......
This diff is collapsed.
...@@ -46,16 +46,16 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& ...@@ -46,16 +46,16 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
TYPE(t_enpara) :: enpara TYPE(t_enpara) :: enpara
! Local Scalars ! Local Scalars
REAL d,del,fix,h,r,rnot,z,bm,qdel,va REAL d,del,fix,h,r,rnot,z,bm,qdel,va
REAL denz1(1,1),vacxpot(1,1),vacpot(1,1) REAL denz1(1,1),vacxpot(1,1),vacpot(1,1)
INTEGER i,ivac,iza,j,jr,k,n,n1,ispin INTEGER i,ivac,iza,j,jr,k,n,n1,ispin
INTEGER nw,ilo,natot,nat INTEGER nw,ilo,natot,nat
! Local Arrays ! Local Arrays
REAL, ALLOCATABLE :: vbar(:,:) REAL, ALLOCATABLE :: vbar(:,:)
REAL, ALLOCATABLE :: rat(:,:),eig(:,:,:),sigm(:) REAL, ALLOCATABLE :: rat(:,:),eig(:,:,:),sigm(:)
REAL, ALLOCATABLE :: rh(:,:,:),rh1(:,:,:),rhoss(:,:) REAL, ALLOCATABLE :: rh(:,:,:),rh1(:,:,:),rhoss(:,:)
REAL, ALLOCATABLE :: vacpar(:) REAL :: vacpar(2)
INTEGER lnum(29,atoms%ntype),nst(atoms%ntype) INTEGER lnum(29,atoms%ntype),nst(atoms%ntype)
INTEGER jrc(atoms%ntype) INTEGER jrc(atoms%ntype)
LOGICAL l_found(0:3),llo_found(atoms%nlod),l_enpara,l_st LOGICAL l_found(0:3),llo_found(atoms%nlod),l_enpara,l_st
REAL :: occ(MAXVAL(atoms%econf%num_states),2) REAL :: occ(MAXVAL(atoms%econf%num_states),2)
...@@ -95,7 +95,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& ...@@ -95,7 +95,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
r = atoms%rmsh(1,n) r = atoms%rmsh(1,n)
d = EXP(atoms%dx(n)) d = EXP(atoms%dx(n))
jrc(n) = 0 jrc(n) = 0
DO WHILE (r < atoms%rmt(n) + 20.0) DO WHILE (r < atoms%rmt(n) + 20.0)
IF (jrc(n) > atoms%msh) CALL juDFT_error("increase msh in fl7para!",calledby ="stden") IF (jrc(n) > atoms%msh) CALL juDFT_error("increase msh in fl7para!",calledby ="stden")
jrc(n) = jrc(n) + 1 jrc(n) = jrc(n) + 1
rat(jrc(n),n) = r rat(jrc(n),n) = r
...@@ -229,7 +229,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& ...@@ -229,7 +229,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
enpara%lchange = .TRUE. enpara%lchange = .TRUE.
enpara%llochg = .TRUE. enpara%llochg = .TRUE.
DO ispin = 1, input%jspins DO ispin = 1, input%jspins
! vacpar is taken as highest occupied level from atomic eigenvalues ! vacpar is taken as highest occupied level from atomic eigenvalues
! vacpar (+0.3) serves as fermi level for film or bulk ! vacpar (+0.3) serves as fermi level for film or bulk
...@@ -251,7 +251,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& ...@@ -251,7 +251,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
END DO END DO
! take energy-parameters from atomic calculation ! take energy-parameters from atomic calculation
DO i = nst(n), 1, -1 DO i = nst(n), 1, -1
IF (.NOT.input%film) eig(i,ispin,n) = eig(i,ispin,n) + 0.4 IF (.NOT.input%film) eig(i,ispin,n) = eig(i,ispin,n) + 0.4
IF (.NOT.l_found(lnum(i,n)).AND.(lnum(i,n).LE.3)) THEN IF (.NOT.l_found(lnum(i,n)).AND.(lnum(i,n).LE.3)) THEN
enpara%el0(lnum(i,n),n,ispin) = eig(i,ispin,n) enpara%el0(lnum(i,n),n,ispin) = eig(i,ispin,n)
...@@ -287,7 +287,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& ...@@ -287,7 +287,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
END DO ! ilo = 1, atoms%nlo(n) END DO ! ilo = 1, atoms%nlo(n)
END IF END IF
END IF ! .NOT.l_found(lnum(i,n)).AND.(lnum(i,n).LE.3) END IF ! .NOT.l_found(lnum(i,n)).AND.(lnum(i,n).LE.3)
END DO ! i = nst(n), 1, -1 END DO ! i = nst(n), 1, -1
END DO ! atom types END DO ! atom types