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
......@@ -9,8 +9,8 @@ MODULE m_postprocessInput
CONTAINS
SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
oneD,hybrid,cell,banddos,sliceplot,xcpot,forcetheo,&
noco,DIMENSION,enpara,sphhar,l_opti,noel,l_kpts)
oneD,hybrid,cell,banddos,sliceplot,xcpot,forcetheo,forcetheo_data,&
noco,DIMENSION,enpara,enparaxml,sphhar,l_opti,noel,l_kpts)
USE m_juDFT
USE m_types
......@@ -18,31 +18,29 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
USE m_lapwdim
USE m_ylm
USE m_chkmt
USE m_localsym
USE m_strgndim
USE m_od_chisym
USE m_dwigner
USE m_mapatom
USE m_cdn_io
USE m_strgn
USE m_od_strgn1
USE m_prpqfft
USE m_prpxcfft
USE m_stepf
use m_checks
use m_make_stars
use m_make_sphhar
USE m_convn
USE m_efield
USE m_od_mapatom
USE m_od_kptsgen
USE m_nocoInputCheck
USE m_types_forcetheo_extended
USE m_types_xcpot_libxc
USE m_types_xcpot_inbuild
USE m_types_xcpot_inbuild_nofunction
USE m_relaxio
USE m_prpqfftmap
IMPLICIT NONE
TYPE(t_mpi) ,INTENT (IN) :: mpi
CLASS(t_forcetheo),INTENT(OUT):: forcetheo
TYPE(t_forcetheo_data),INTENT(OUT):: forcetheo_data
CLASS(t_forcetheo),ALLOCATABLE,INTENT(OUT):: forcetheo
TYPE(t_forcetheo_data),INTENT(IN):: forcetheo_data
TYPE(t_input), INTENT(INOUT) :: input
TYPE(t_sym), INTENT(INOUT) :: sym
TYPE(t_stars), INTENT(INOUT) :: stars
......@@ -57,7 +55,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
CLASS(t_xcpot),ALLOCATABLE,INTENT(INOUT) :: xcpot
TYPE(t_noco), INTENT(INOUT) :: noco
TYPE(t_dimension),INTENT(INOUT) :: dimension
TYPE(t_enparaXML) ,INTENT(OUT):: enparaXML
TYPE(t_enparaXML) ,INTENT(IN):: enparaXML
TYPE(t_enpara) ,INTENT(OUT) :: enpara
TYPE(t_sphhar) ,INTENT (OUT) :: sphhar
TYPE(t_field), INTENT(INOUT) :: field
......@@ -73,9 +71,10 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
REAL :: bk(3)
LOGICAL :: l_vca, l_test,l_gga
INTEGER, ALLOCATABLE :: lmx1(:), nq1(:), nlhtp1(:)
INTEGER, ALLOCATABLE :: jri1(:), lmax1(:)
REAL, ALLOCATABLE :: rmt1(:), dx1(:)
INTEGER ::func_vxc_id_c,func_vxc_id_x,func_exc_id_c,func_exc_id_x
#ifdef CPP_MPI
INCLUDE 'mpif.h'
......@@ -92,7 +91,10 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
func_exc_id_x=xcpot%func_exc_id_x
DEALLOCATE(xcpot)
ALLOCATE(t_xcpot_libxc::xcpot)
CALL xcpot%init(func_vxc_id_x,func_vxc_id_c,func_exc_id_x,func_exc_id_c,input%jspins)
SELECT TYPE(xcpot)
CLASS is (t_xcpot_libxc)!just allocated like this
CALL xcpot%init(func_vxc_id_x,func_vxc_id_c,func_exc_id_x,func_exc_id_c,input%jspins)
END SELECT
ELSE
SELECT TYPE(xcpot)
CLASS is (t_xcpot_inbuild_nf)
......@@ -106,20 +108,28 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
SELECT CASE (forcetheo_data%mode)
CASE(1)
ALLOCATE(t_forcetheo_mae::forcetheo)
CALL forcetheo%init(forcetheo_data%theta,forcetheo_data%phi,cell,sym)
CASE(2)
ALLOCATE(t_forcetheo_dmi::forcetheo)
CALL forcetheo%init(forcetheo_data%qvec,forcetheo_data%theta,forcetheo_data%phi)
CASE(3)
ALLOCATE(t_forcetheo_jij::forcetheo)
CALL forcetheo%init(forcetheo_data%qvec,forcetheo_data%theta(1),atoms)
CASE(4)
ALLOCATE(t_forcetheo_ssdisp::forcetheo)
END SELECT
SELECT TYPE(forcetheo)
TYPE IS(t_forcetheo_mae)
CALL forcetheo%init(forcetheo_data%theta,forcetheo_data%phi,cell,sym)
TYPE IS(t_forcetheo_dmi)
CALL forcetheo%init(forcetheo_data%qvec,forcetheo_data%theta,forcetheo_data%phi)
TYPE IS(t_forcetheo_jij)
CALL forcetheo%init(forcetheo_data%qvec,forcetheo_data%theta(1),atoms)
TYPE IS(t_forcetheo_ssdisp)
CALL forcetheo%init(forcetheo_data%qvec)
END SELECT
!Generate enpara datatype
CALL enpara%init(atoms,input%jspins,input%film,enparaXML)
CALL enpara%init_enpara(atoms,input%jspins,input%film,enparaXML)
IF (mpi%irank.EQ.0) call check_input_switches(banddos,vacuum,noco,atoms,input)
......@@ -182,91 +192,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
cell%volint = cell%volint - atoms%volmts(iType)*atoms%neq(iType)
! 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))
! 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)
! Initialize missing 1D code arrays
......@@ -279,43 +205,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
! Initialize missing hybrid functionals arrays
ALLOCATE (hybrid%nindx(0:atoms%lmaxd,atoms%ntype))
! 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(:,:)