Commit 94daf088 authored by Daniel Wortmann's avatar Daniel Wortmann

Reactivated inpgen2

parent 4987702b
......@@ -20,7 +20,7 @@ include("cmake/filespecific.cmake")
include("cmake/ReportConfig.txt")
#add_subdirectory("inpgen2")
add_subdirectory("inpgen2")
#install(TARGETS fleur inpgen DESTINATION bin)
......
......@@ -205,16 +205,17 @@ MODULE m_types_atoms
SUBROUTINE read_xml_atoms(this,xml)
USE m_types_xml
use m_constants
IMPLICIT NONE
CLASS(t_atoms),INTENT(INOUT):: this
TYPE(t_xml),INTENT(IN) :: xml
CHARACTER(len=200):: xpaths,xpathg,xpath,valueString,lstring,nstring,core,valence
INTEGER :: i,j,numberNodes,ilo,lNumCount,nNumCount,l,n
INTEGER :: i,j,numberNodes,ilo,lNumCount,nNumCount,l,n,itype,na,jrc
INTEGER,ALLOCATABLE::lNumbers(:),nNumbers(:)
LOGICAL :: relaxx,relaxy,relaxz
INTEGER,ALLOCATABLE :: itmp(:,:)
REAL :: down,up
REAL :: down,up,dr,radius
CHARACTER(len=20) :: state
this%ntype= xml%get_ntype()
this%nat = xml%get_nat()
......@@ -412,33 +413,32 @@ MODULE m_types_atoms
END IF
END DO
atoms%jmtd = maxval(atoms%jri(:))
ALLOCATE(atoms%rmsh(atoms%jmtd,atoms%ntype))
ALLOCATE(atoms%volmts(atoms%ntype))
this%jmtd = maxval(this%jri(:))
ALLOCATE(this%rmsh(this%jmtd,this%ntype))
ALLOCATE(this%volmts(this%ntype))
na = 0
DO iType = 1, atoms%ntype
DO iType = 1, this%ntype
! Calculate mesh for valence states
radius = atoms%rmt(iType)*exp(atoms%dx(iType)*(1-atoms%jri(iType)))
dr = exp(atoms%dx(iType))
DO i = 1, atoms%jri(iType)
atoms%rmsh(i,iType) = radius
radius = this%rmt(iType)*exp(this%dx(iType)*(1-this%jri(iType)))
dr = exp(this%dx(iType))
DO i = 1, this%jri(iType)
this%rmsh(i,iType) = radius
radius = radius*dr
END DO
! Calculate mesh dimension for core states
radius = atoms%rmt(iType)
jrc = atoms%jri(iType)
DO WHILE (radius < atoms%rmt(iType) + 20.0)
radius = this%rmt(iType)
jrc = this%jri(iType)
DO WHILE (radius < this%rmt(iType) + 20.0)
jrc = jrc + 1
radius = radius*dr
END DO
dimension%msh = max(dimension%msh,jrc)
atoms%volmts(iType) = (fpi_const/3.0)*atoms%rmt(iType)**3
this%volmts(iType) = (fpi_const/3.0)*this%rmt(iType)**3
END DO
atoms%nlotot = 0
DO n = 1, atoms%ntype
DO l = 1,atoms%nlo(n)
atoms%nlotot = atoms%nlotot + atoms%neq(n) * ( 2*atoms%llo(l,n) + 1 )
this%nlotot = 0
DO n = 1, this%ntype
DO l = 1,this%nlo(n)
this%nlotot = this%nlotot + this%neq(n) * ( 2*this%llo(l,n) + 1 )
END DO
END DO
......
......@@ -18,7 +18,9 @@ init/compile_descr.F90
init/checks.F90
init/efield.f90
init/gen_map.f90
init/inpeig.f90
init/make_stars.f90
init/make_sphhar.f90
#init/inpeig.f90
init/mapatom.F90
init/od_mapatom.F90
init/od_strgn1.f90
......
......@@ -42,14 +42,17 @@ MODULE m_checks
#endif
END SUBROUTINE check_command_line
subroutine check_input_switches(banddos,vacuum,noco,atoms,input)
use m_types
SUBROUTINE check_input_switches(banddos,vacuum,noco,atoms,input)
USE m_nocoInputCheck
USE m_types
type(t_banddos),INTENT(IN)::banddos
type(t_vacuum),INTENT(IN) ::vacuum
type(t_noco),INTENT(IN) ::noco
type(t_atoms),INTENT(IN) ::atoms
type(t_input),INTENT(IN) ::input
integer :: i
! Check DOS related stuff (from inped)
IF ((banddos%ndir.LT.0).AND..NOT.banddos%dos) THEN
......@@ -85,6 +88,6 @@ MODULE m_checks
END DO
END IF
IF (noco%l_noco) CALL nocoInputCheck(atoms,input,vacuum,noco)
END SUBROUTINE check_input_switches
END MODULE m_checks
......@@ -52,8 +52,7 @@
IF(PRESENT(enpara)) THEN
IF (.NOT.input%l_inpXML) THEN
!read enpara file if present!
CALL enpara%init(atoms%ntype,atoms%nlod,atoms%lmaxd,input%jspins)
CALL enpara%READ(atoms%ntype,atoms%nlo,input%jspins,input%film,.false.)
CALL enpara%init_enpara(atoms,input%jspins,input%film)
END IF
END IF
!
......
!--------------------------------------------------------------------------------
! Copyright (c) 2017 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_make_sphhar
contains
subroutine make_sphhar(atoms,sphhar,sym,cell,oneD)
use m_types_setup
USE m_localsym
USE m_od_chisym
type(t_atoms),intent(inout)::atoms
type(t_sphhar),intent(inout)::sphhar
type(t_cell),intent(in)::cell
type(t_sym),intent(inout)::sym
type(t_oneD),intent(in)::oned
integer :: ii,i,j
INTEGER, ALLOCATABLE :: lmx1(:), nq1(:), nlhtp1(:)
! Dimensioning of lattice harmonics
ALLOCATE(atoms%nlhtyp(atoms%ntype),atoms%ntypsy(atoms%nat))
ALLOCATE(sphhar%clnu(1,1,1),sphhar%nlh(1),sphhar%llh(1,1),sphhar%nmem(1,1),sphhar%mlh(1,1,1))
sphhar%ntypsd = 0
IF (.NOT.oneD%odd%d1) THEN
CALL local_sym(atoms%lmaxd,atoms%lmax,sym%nop,sym%mrot,sym%tau,&
atoms%nat,atoms%ntype,atoms%neq,cell%amat,cell%bmat,&
atoms%taual,sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.true.,&
atoms%nlhtyp,atoms%ntypsy,sphhar%nlh,sphhar%llh,&
sphhar%nmem,sphhar%mlh,sphhar%clnu)
ELSE IF (oneD%odd%d1) THEN
WRITE(*,*) 'Note: I would be surprised if lattice harmonics generation works'
WRITE(*,*) 'Dimensioning of local arrays seems to be inconsistent with routine local_sym'
ALLOCATE (nq1(atoms%nat),lmx1(atoms%nat),nlhtp1(atoms%nat))
ii = 1
nq1=1
DO i = 1,atoms%ntype
DO j = 1,atoms%neq(i)
lmx1(ii) = atoms%lmax(i)
ii = ii + 1
END DO
END DO
CALL local_sym(atoms%lmaxd,lmx1,sym%nop,sym%mrot,sym%tau,&
atoms%nat,atoms%nat,nq1,cell%amat,cell%bmat,atoms%taual,&
sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.true.,nlhtp1,&
atoms%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,&
sphhar%mlh,sphhar%clnu)
ii = 1
DO i = 1,atoms%ntype
atoms%nlhtyp(i) = nlhtp1(ii)
ii = ii + atoms%neq(i)
END DO
DEALLOCATE (nq1,lmx1,nlhtp1)
END IF
DEALLOCATE(sphhar%clnu,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh)
ALLOCATE(sphhar%clnu(sphhar%memd,0:sphhar%nlhd,sphhar%ntypsd))
ALLOCATE(sphhar%llh(0:sphhar%nlhd,sphhar%ntypsd))
ALLOCATE(sphhar%mlh(sphhar%memd,0:sphhar%nlhd,sphhar%ntypsd))
ALLOCATE(sphhar%nlh(sphhar%ntypsd),sphhar%nmem(0:sphhar%nlhd,sphhar%ntypsd))
! Generate lattice harmonics
IF (.NOT.oneD%odd%d1) THEN
CALL local_sym(atoms%lmaxd,atoms%lmax,sym%nop,sym%mrot,sym%tau,&
atoms%nat,atoms%ntype,atoms%neq,cell%amat,cell%bmat,atoms%taual,&
sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.FALSE.,&
atoms%nlhtyp,atoms%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh,sphhar%clnu)
sym%nsymt = sphhar%ntypsd
oneD%mrot1(:,:,:) = sym%mrot(:,:,:)
oneD%tau1(:,:) = sym%tau(:,:)
ELSE IF (oneD%odd%d1) THEN
WRITE(*,*) 'Note: I would be surprised if lattice harmonics generation works'
WRITE(*,*) 'Dimensioning of local arrays seems to be inconsistent with routine local_sym'
CALL od_chisym(oneD%odd,oneD%mrot1,oneD%tau1,sym%zrfs,sym%invs,sym%invs2,cell%amat)
ALLOCATE (nq1(atoms%nat),lmx1(atoms%nat),nlhtp1(atoms%nat))
ii = 1
DO i = 1,atoms%ntype
DO j = 1,atoms%neq(i)
nq1(ii) = 1
lmx1(ii) = atoms%lmax(i)
ii = ii + 1
END DO
END DO
CALL local_sym(atoms%lmaxd,lmx1,sym%nop,sym%mrot,sym%tau,&
atoms%nat,atoms%nat,nq1,cell%amat,cell%bmat,atoms%taual,&
sphhar%nlhd,sphhar%memd,sphhar%ntypsd,.FALSE.,&
nlhtp1,atoms%ntypsy,sphhar%nlh,sphhar%llh,sphhar%nmem,sphhar%mlh,sphhar%clnu)
sym%nsymt = sphhar%ntypsd
ii = 1
DO i = 1,atoms%ntype
atoms%nlhtyp(i) = nlhtp1(ii)
ii = ii + atoms%neq(i)
END DO
DEALLOCATE (lmx1,nlhtp1)
END IF
end
end
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_make_stars
USE m_juDFT
IMPLICIT NONE
PRIVATE
PUBLIC :: make_stars
CONTAINS
SUBROUTINE make_stars(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot,oneD,noco,mpi)
USE m_od_strgn1
USE m_strgn
USE m_stepf
USE m_prpqfftmap
USE m_prpqfft
USE m_strgndim
use m_types_sym
use m_types_atoms
use m_types_vacuum
use m_types_sphhar
use m_types_input
use m_types_cell
use m_types_xcpot
use m_types_oned
USE m_types_mpi
use m_types_noco
class(t_stars),intent(INOUT) :: stars
type(t_sym),intent(in)::sym
type(t_atoms),intent(in)::atoms
type(t_vacuum),intent(in)::vacuum
type(t_sphhar),intent(in)::sphhar
type(t_input),intent(inout)::input
type(t_cell),intent(in)::cell
class(t_xcpot),intent(in)::xcpot
TYPE(t_oneD),INTENT(inout)::oneD
type(t_noco),intent(in)::noco
type(t_mpi),intent(in)::mpi
! Generate stars
! Dimensioning of stars
IF (input%film) THEN
CALL strgn1_dim(stars%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
sym%tau,sym%nop,sym%nop2,stars%mx1,stars%mx2,stars%mx3,&
stars%ng3,stars%ng2,oneD%odd)
ELSE
CALL strgn2_dim(stars%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
sym%tau,sym%nop,stars%mx1,stars%mx2,stars%mx3,&
stars%ng3,stars%ng2)
oneD%odd%n2d = stars%ng2
oneD%odd%nq2 = stars%ng2
oneD%odd%nop = sym%nop
END IF
stars%kimax2= (2*stars%mx1+1)* (2*stars%mx2+1)-1
stars%kimax = (2*stars%mx1+1)* (2*stars%mx2+1)* (2*stars%mx3+1)-1
IF (oneD%odd%d1) THEN
oneD%odd%k3 = stars%mx3
oneD%odd%nn2d = (2*(oneD%odd%k3)+1)*(2*(oneD%odd%M)+1)
ELSE
oneD%odd%k3 = 0
oneD%odd%M = 0
oneD%odd%nn2d = 1
oneD%odd%mb = 0
END IF
ALLOCATE (stars%ig(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2,-stars%mx3:stars%mx3))
ALLOCATE (stars%ig2(stars%ng3))
ALLOCATE (stars%kv2(2,stars%ng2),stars%kv3(3,stars%ng3))
ALLOCATE (stars%nstr2(stars%ng2),stars%nstr(stars%ng3))
ALLOCATE (stars%sk2(stars%ng2),stars%sk3(stars%ng3),stars%phi2(stars%ng2))
ALLOCATE (stars%igfft(0:stars%kimax,2),stars%igfft2(0:stars%kimax2,2))
ALLOCATE (stars%rgphs(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2,-stars%mx3:stars%mx3))
ALLOCATE (stars%pgfft(0:stars%kimax),stars%pgfft2(0:stars%kimax2))
ALLOCATE (stars%ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1),stars%ustep(stars%ng3))
stars%sk2(:) = 0.0
stars%phi2(:) = 0.0
! Initialize xc fft box
CALL prp_xcfft_box(xcpot%gmaxxc,cell%bmat,stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft)
! Missing xc functionals initializations
IF (xcpot%needs_grad()) THEN
ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),&
oneD%pgft1xy(0:oneD%odd%nn2d-1),&
oneD%pgft1y(0:oneD%odd%nn2d-1),oneD%pgft1yy(0:oneD%odd%nn2d-1))
ELSE
ALLOCATE (stars%ft2_gfx(0:1),stars%ft2_gfy(0:1))
ALLOCATE (oneD%pgft1x(0:1),oneD%pgft1xx(0:1),oneD%pgft1xy(0:1),&
oneD%pgft1y(0:1),oneD%pgft1yy(0:1))
END IF
oneD%odd%nq2 = oneD%odd%n2d
oneD%odi%nq2 = oneD%odd%nq2
CALL timestart("strgn")
IF (input%film) THEN
CALL strgn1(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot)
IF (oneD%odd%d1) THEN
CALL od_strgn1(xcpot,cell,sym,oneD)
END IF
ELSE
CALL strgn2(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot)
END IF
ALLOCATE (stars%igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1))
ALLOCATE (stars%igq2_fft(0:stars%kq1_fft*stars%kq2_fft-1))
! Set up pointer for backtransformation from g-vector in positive
! domain of carge density fftibox into stars
CALL prp_qfft_map(stars,sym,input,stars%igq2_fft,stars%igq_fft)
CALL prp_qfft(stars,cell,noco,input)
CALL timestop("strgn")
CALL timestart("stepf")
CALL stepf(sym,stars,atoms,oneD,input,cell,vacuum,mpi)
CALL timestop("stepf")
END SUBROUTINE make_stars
END MODULE m_make_stars
This diff is collapsed.
......@@ -22,10 +22,10 @@
! ..
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(INOUT) :: stars
TYPE(t_atoms),INTENT(INOUT) :: atoms
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_input),INTENT(IN) :: input
TYPE(t_cell),INTENT(INOUT) :: cell
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_mpi),INTENT(IN) :: mpi
! ..
......@@ -140,29 +140,6 @@
!
! --> set up stepfunction on fft-grid:
!
#ifdef CPP_MPI
CALL MPI_BCAST(atoms%ntype,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%nat,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%omtil,1,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%bmat,9,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sym%invs,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(oneD%odd%d1,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%film,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%z1,1,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%vol,1,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
IF(.NOT.ALLOCATED(atoms%neq)) ALLOCATE(atoms%neq(atoms%ntype))
IF(.NOT.ALLOCATED(atoms%volmts)) ALLOCATE(atoms%volmts(atoms%ntype))
IF(.NOT.ALLOCATED(atoms%taual)) ALLOCATE(atoms%taual(3,atoms%nat))
IF(.NOT.ALLOCATED(atoms%rmt)) ALLOCATE(atoms%rmt(atoms%ntype))
IF(.NOT.ALLOCATED(stars%ufft)) ALLOCATE(stars%ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1))
CALL MPI_BCAST(atoms%neq,size(atoms%neq),MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%volmts,size(atoms%volmts),CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%taual,size(atoms%taual),CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%rmt,size(atoms%rmt),CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
ALLOCATE ( bfft_local(0:ifftd-1), ufft_local(0:ifftd-1) )
bfft_local = 0.0
ufft_local = 0.0
#endif
ALLOCATE ( bfft(0:ifftd-1) )
im1=CEILING(1.5*stars%mx1); im2=CEILING(1.5*stars%mx2); im3=CEILING(1.5*stars%mx3)
......
......@@ -43,10 +43,8 @@ old_inp/rw_symfile.f
old_inp/spg2set.f
${FLEUR_SRC}/init/compile_descr.F90
${FLEUR_SRC}/global/constants.f90
${FLEUR_SRC}/global/sort.f90
${FLEUR_SRC}/math/inv3.f90
${FLEUR_SRC}/io/calculator.f
${FLEUR_SRC}/io/w_inpXML.f90
${FLEUR_SRC}/kpoints/divi.f
${FLEUR_SRC}/kpoints/bravais.f
......@@ -63,48 +61,30 @@ ${FLEUR_SRC}/math/util.F
${FLEUR_SRC}/math/matmul.f
${FLEUR_SRC}/init/strgn_dim.F
${FLEUR_SRC}/init/spgrot.f
${FLEUR_SRC}/init/convn_dim.f
${FLEUR_SRC}/io/types_xml.f90
#${FLEUR_SRC}/init/convn_dim.f
${FLEUR_SRC}/types/types_mat.F90
${FLEUR_SRC}/types/types_xcpot_inbuild_nofunction.F90
${FLEUR_SRC}/types/types_xcpot.F90
${FLEUR_SRC}/types/types_xcpot_data.F90
${FLEUR_SRC}/types/types_xcpot_libxc.F90
${FLEUR_SRC}/types/types_mpi.F90
${FLEUR_SRC}/types/types_forcetheo.F90
${FLEUR_SRC}/types/types_stars.f90
${FLEUR_SRC}/types/types_atoms.F90
${FLEUR_SRC}/types/types_lapw.F90
${FLEUR_SRC}/types/types_sphhar.f90
${FLEUR_SRC}/types/types_tlmplm.F90
${FLEUR_SRC}/types/types_misc.F90
${FLEUR_SRC}/types/types_mpimat.F90
${FLEUR_SRC}/types/types_potden.F90
${FLEUR_SRC}/types/types_forcetheo.F90
${FLEUR_SRC}/types/types_kpts.f90
${FLEUR_SRC}/types/types_wannier.f90
${FLEUR_SRC}/types/types_coreSpecInput.f90
${FLEUR_SRC}/types/types_enpara.F90
${FLEUR_SRC}/types/types_setup.F90
${FLEUR_SRC}/types/types_usdus.F90
${FLEUR_SRC}/types/types_cdnval.f90
${FLEUR_SRC}/types/types_field.F90
${FLEUR_SRC}/types/types_regionCharges.f90
${FLEUR_SRC}/types/types_dos.f90
${FLEUR_SRC}/types/types_denCoeffsOffdiag.f90
${FLEUR_SRC}/types/types_gpumat.F90
${FLEUR_SRC}/types/types_econfig.F90
${FLEUR_SRC}/types/types_cell.f90
${FLEUR_SRC}/types/types_sym.f90
${FLEUR_SRC}/types/types_input.f90
${FLEUR_SRC}/types/types_sliceplot.f90
${FLEUR_SRC}/types/types_oneD.f90
${FLEUR_SRC}/types/types_hybrid.f90
${FLEUR_SRC}/types/types_noco.f90
${FLEUR_SRC}/types/types_banddos.f90
${FLEUR_SRC}/types/types_vacuum.f90
${FLEUR_SRC}/types/types_dimension.f90
${FLEUR_SRC}/io/nocoInputCheck.F90
${FLEUR_SRC}/eigen/orthoglo.F90
......@@ -138,7 +118,6 @@ ${FLEUR_SRC}/math/inwint.f
${FLEUR_SRC}/math/outint.f
${FLEUR_SRC}/math/intgr.F90
${FLEUR_SRC}/global/find_enpara.f90
${FLEUR_SRC}/mpi/mpi_bc_tool.F90
${FLEUR_SRC}/math/d_wigner.F90
${FLEUR_SRC}/io/xsf_io.f90
${FLEUR_SRC}/init/boxdim.f
......@@ -151,3 +130,4 @@ target_compile_definitions(inpgen2 PUBLIC ${FLEUR_DEFINITIONS})
target_link_libraries(inpgen2 ${FLEUR_LIBRARIES})
target_link_libraries(inpgen2 ${FLEUR_LINK_LIBRARIES})
target_link_libraries(inpgen2 juDFT)
target_link_libraries(inpgen2 fleurinput)
......@@ -117,7 +117,7 @@ CONTAINS
ALLOCATE(atoms%ulo_der(atoms%nlod,atoms%ntype))
atoms%ulo_der=0
CALL enpara%init(atoms%ntype,atoms%nlod,atoms%lmaxd,2,.TRUE.)
CALL enpara%init_enpara(atoms,2,.TRUE.)
DO n=1,atoms%ntype
DO i=1,atoms%nlo(n)
DO l = 0, 3
......
......@@ -87,14 +87,14 @@ CONTAINS
!
stars%gmax = merge(stars%gmax,3.0*input%rkmax,stars%gmax>0)
stars%gmax = real(NINT(stars%gmax * 10 ) / 10.)
stars%gmaxInit = stars%gmax
input%gmax = stars%gmax
!
!xcpot
!
xcpot%gmaxxc = merge(xcpot%gmaxxc,3.0*input%rkmax,xcpot%gmaxxc>0)
xcpot%gmaxxc = real(NINT(xcpot%gmaxxc * 10 ) / 10.)
if (xcpot%icorr==0) call xcpot%init("pbe ",.false.,atoms%ntype)
if (xcpot%icorr==0) call xcpot%init(atoms%ntype)
!
!vacuum
......
This diff is collapsed.
......@@ -90,9 +90,9 @@
INTEGER, ALLOCATABLE :: lmx1(:), nq1(:), nlhtp1(:)
! added for HF and hybrid functionals
LOGICAL :: l_gamma=.false.
character(len=4) :: latnam
LOGICAL :: l_gamma=.false.
character(len=4) :: latnam,namgrp
real :: scalecell
EXTERNAL prp_xcfft_box!,parawrite
! ..
......@@ -130,7 +130,7 @@
CALL rw_inp('r',&
& atoms,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,oneD,hybrid,kpts,&
& noel,namex,relcor,a1,a2,a3,latnam,grid)
& noel,namex,relcor,a1,a2,a3,latnam,grid,namgrp,scalecell)
!---> pk non-collinear
!---> read the angle and spin-spiral information from nocoinp
......@@ -200,9 +200,9 @@
!
! ---> now, set the lattice harmonics, determine nlhd
!
cell%amat(:,1) = a1(:)*input%scaleCell
cell%amat(:,2) = a2(:)*input%scaleCell
cell%amat(:,3) = a3(:)*input%scaleCell
cell%amat(:,1) = a1(:)*scaleCell
cell%amat(:,2) = a2(:)*scaleCell
cell%amat(:,3) = a3(:)*scaleCell
CALL inv3(cell%amat,cell%bmat,cell%omtil)
IF (input%film) cell%omtil = cell%omtil/cell%amat(3,3)*vacuum%dvac
!-odim
......@@ -220,12 +220,12 @@
atoms%zatom(n) = real( atoms%nz(n) )
ENDDO
ALLOCATE (sym%mrot(3,3,sym%nop),sym%tau(3,sym%nop))
IF (sym%namgrp.EQ.'any ') THEN
IF (namgrp.EQ.'any ') THEN
nopd = sym%nop ; rw = 'R'
symfh = 94 ; symfn = 'sym.out'
CALL rw_symfile(rw,symfh,symfn,nopd,cell%bmat,sym%mrot,sym%tau,sym%nop,sym%nop2,sym%symor)
ELSE
CALL spg2set(sym%nop,sym%zrfs,sym%invs,sym%namgrp,latnam,sym%mrot,sym%tau,sym%nop2,sym%symor)
CALL spg2set(sym%nop,sym%zrfs,sym%invs,namgrp,latnam,sym%mrot,sym%tau,sym%nop2,sym%symor)
ENDIF
sphhar%ntypsd = 0
IF (.NOT.oneD%odd%d1) THEN
......@@ -290,7 +290,7 @@
!
! Dimensioning of the stars
!
IF (input%film.OR.(sym%namgrp.ne.'any ')) THEN
IF (input%film.OR.(namgrp.ne.'any ')) THEN
CALL strgn1_dim(stars%gmax,cell%bmat,sym%invs,sym%zrfs,sym%mrot,&
sym%tau,sym%nop,sym%nop2,stars%mx1,stars%mx2,stars%mx3,&
stars%ng3,stars%ng2,oneD%odd)
......@@ -336,7 +336,7 @@
WRITE (41,'(i5,f20.10)') kpts%nkpt,1.0
DO n = 1, kpts%nkpt
READ (15) q
WRITE (41,'(4f10.5)') MATMUL(TRANSPOSE(cell%amat),q)/input%scaleCell,1.0
WRITE (41,'(4f10.5)') MATMUL(TRANSPOSE(cell%amat),q)/scaleCell,1.0
READ (15)
ENDDO
CLOSE (15)
......
......@@ -65,7 +65,7 @@ CONTAINS
REAL :: a1(3),a2(3),a3(3)
REAL :: dtild, phi_add
LOGICAL :: l_found, l_kpts, l_exist, l_krla
character(len=4) :: latnam
character(len=4) :: latnam,namgrp
namex = ' '
relcor = ' '
......@@ -158,7 +158,7 @@ CONTAINS
CALL setup(atoms,kpts,&
sym,oneD,input,cell,&
enpara,latnam)
enpara,latnam,namgrp)
banddos%l_orb = .FALSE.
banddos%orbCompAtom = 0
......
......@@ -82,7 +82,8 @@
CHARACTER(8) llr(0:1)
INTEGER jri1(atoms%ntype),lmax1(atoms%ntype)
REAL rmt1(atoms%ntype),dx1(atoms%ntype)
character(len=5)::namgrp
real ::scalecell
! ..
! .. Data statements ..
DATA llr(0)/'absolute'/,llr(1)/'floating'/
......@@ -96,7 +97,7 @@
na = 0
CALL rw_inp('r',atoms,vacuum,input,stars,sliceplot,banddos,&
cell,sym,xcpot,noco,oneD,hybrid,kpts, noel,namex,relcor,a1,a2,a3,latnam,grid)
cell,sym,xcpot,noco,oneD,hybrid,kpts, noel,namex,relcor,a1,a2,a3,latnam,grid,namgrp,scalecell)
input%l_core_confpot=.TRUE. !this is the former CPP_CORE switch!
input%l_useapw=.FALSE. !this is the former CPP_APW switch!
......@@ -125,7 +126,7 @@
8010 FORMAT (/,/,4x,10a8,/,/)
!---> the menu for namgrp can be found in subroutine spgset
WRITE (6,FMT=8030) latnam,sym%namgrp,sym%invs,sym%zrfs,sym%invs2,input%jspins
WRITE (6,FMT=8030) latnam,namgrp,sym%invs,sym%zrfs,sym%invs2,input%jspins
8030 FORMAT (' lattice=',a3,/,' name of space group=',a4,/,' inversion symmetry= ',l1&
,/,' z-reflection symmetry=',l1,/,' vacuum-inversion symm=',l1,/,' jspins=',i1)
......@@ -143,9 +144,9 @@
CALL juDFT_error("latnam",calledby ="inped")
ENDIF
dtild=a3(3)
IF (input%scaleCell.EQ.0.0) input%scaleCell = 1.0
vacuum%dvac = input%scaleCell*vacuum%dvac
dtild = input%scaleCell*dtild
IF (scaleCell.EQ.0.0) scaleCell = 1.0
vacuum%dvac = scaleCell*vacuum%dvac
dtild = scaleCell*dtild
!+odim
IF (.NOT.oneD%odd%d1) THEN
IF ((dtild-vacuum%dvac.LT.0.0).AND.input%film) THEN
......@@ -168,10 +169,10 @@
IF (vacuum%nmz>vacuum%nmzd) CALL juDFT_error("nmzd",calledby ="inped")
vacuum%nmzxy = vacuum%nmzxyd
IF (vacuum%nmzxy>vacuum%nmzxyd) CALL juDFT_error("nmzxyd",calledby ="inped")
a1(:) = input%scaleCell*a1(:)
a2(:) = input%scaleCell*a2(:)
a3(:) = input%scaleCell*a3(:)
WRITE (6,FMT=8050) input%scaleCell
a1(:) = scaleCell*a1(:)
a2(:) = scaleCell*a2(:)
a3(:) = scaleCell*a3(:)
WRITE (6,FMT=8050) scaleCell
8050 FORMAT (' unit cell scaled by ',f10.6)
WRITE (6,FMT=8060) cell%z1
8060 FORMAT (' the vacuum begins at z=',f10.6)
......@@ -181,7 +182,7 @@
cell%amat(:,1) = a1(:)
cell%amat(:,2) = a2(:)
cell%amat(:,3) = a3(:)
call cell%init(-1.)
call cell%init()
!CALL inv3(cell%amat,cell%bmat,cell%omtil)
!cell%bmat(:,:) = tpi_const*cell%bmat(:,:)
!cell%bbmat=MATMUL(cell%bmat,TRANSPOSE(cell%bmat))
......@@ -219,8 +220,10 @@
f12.6,/,2x, 'the area of the two-dimensional unit cell=',f12.6)
WRITE (6,FMT=8120) namex,relcor
8120 FORMAT (1x,'exchange-correlation: ',a4,2x,a12,1x,'correction')
CALL xcpot%init(namex,relcor.EQ.'relativistic',atoms%ntype)
xcpot%l_inbuild=.true.
xcpot%inbuild_name=namex
xcpot%l_relativistic=relcor.EQ.'relativistic'
CALL xcpot%init(atoms%ntype)
!!$ xcpot%icorr = -99