Commit 6940229d authored by Daniel Wortmann's avatar Daniel Wortmann

More updates to fleurinput

parent b9549d3e
......@@ -10,7 +10,7 @@ CONTAINS
TYPE(t_cell),INTENT(OUT)::cell
TYPE(t_sym),INTENT(OUT)::sym
TYPE(t_atoms),INTENT(OUT)::atoms
TYPE(t_input),INTENT(OUT)::input
TYPE(t_input),INTENT(OUT)::input !mpi_bc done
TYPE(t_noco),INTENT(OUT)::noco
TYPE(t_vacuum),INTENT(OUT)::vacuum
TYPE(t_field),INTENT(OUT)::field
......
......@@ -106,11 +106,73 @@ MODULE m_types_atoms
PROCEDURE :: nsp => calc_nsp_atom
PROCEDURE :: same_species
PROCEDURE :: read_xml => read_xml_atoms
procedure :: mpi_bc=>mpi_bc_atoms
END TYPE t_atoms
PUBLIC :: t_atoms
CONTAINS
subroutine mpi_bc_atoms(this,mpi_comm,irank)
use m_mpi_bc_tool
class(t_atoms),INTENT(INOUT)::this
integer,INTENT(IN):: mpi_comm
INTEGER,INTENT(IN),OPTIONAL::irank
INTEGER ::rank
if (present(irank)) THEN
rank=0
else
rank=irank
end if
call mpi_bc(this% ntype,rank,mpi_comm)
call mpi_bc(this% nat,rank,mpi_comm)
call mpi_bc(this%nlod,rank,mpi_comm)
call mpi_bc(this%llod,rank,mpi_comm)
call mpi_bc(this%nlotot,rank,mpi_comm)
call mpi_bc(this% lmaxd,rank,mpi_comm)
call mpi_bc(this%n_u,rank,mpi_comm)
call mpi_bc(this% jmtd,rank,mpi_comm)
call mpi_bc(this%nz,rank,mpi_comm)
call mpi_bc(this%neq,rank,mpi_comm)
call mpi_bc(this%jri,rank,mpi_comm)
call mpi_bc(this%lmax,rank,mpi_comm)
call mpi_bc(this%lnonsph,rank,mpi_comm)
call mpi_bc(this%ncv,rank,mpi_comm)
call mpi_bc(this%nlo,rank,mpi_comm)
call mpi_bc(this%llo,rank,mpi_comm)
call mpi_bc(this%lapw_l,rank,mpi_comm)
call mpi_bc(this%lo1l,rank,mpi_comm)
call mpi_bc(this%ulo_der,rank,mpi_comm)
call mpi_bc(this%nlol,rank,mpi_comm)
call mpi_bc(this%l_dulo,rank,mpi_comm)
call mpi_bc(this%ngopr,rank,mpi_comm)
call mpi_bc(this%ntypsy,rank,mpi_comm)
call mpi_bc(this%nlhtyp,rank,mpi_comm)
call mpi_bc(this%invsat,rank,mpi_comm)
call mpi_bc(this% l_geo,rank,mpi_comm)
call mpi_bc(this%rmt,rank,mpi_comm)
call mpi_bc(this%dx,rank,mpi_comm)
call mpi_bc(this%volmts,rank,mpi_comm)
call mpi_bc(this%rmsh,rank,mpi_comm)
call mpi_bc(this%zatom,rank,mpi_comm)
call mpi_bc(this%bmu,rank,mpi_comm)
call mpi_bc(this%pos,rank,mpi_comm)
call mpi_bc(this%taual,rank,mpi_comm)
call mpi_bc(this% namex,rank,mpi_comm)
call mpi_bc(this% icorr,rank,mpi_comm)
call mpi_bc(this% igrd,rank,mpi_comm)
call mpi_bc(this% krla,rank,mpi_comm)
call mpi_bc(this% relcor,rank,mpi_comm)
call mpi_bc(this% relax,rank,mpi_comm)
call mpi_bc(this% nflip,rank,mpi_comm)
!this needs work
!TYPE(t_econfig),ALLOCATABLE::econf(:)
!TYPE(t_utype), ALLOCATABLE::lda_u(:)
end subroutine mpi_bc_atoms
LOGICAL FUNCTION same_species(atoms,n,nn)
USE m_judft
IMPLICIT NONE
......
......@@ -35,6 +35,29 @@ MODULE m_types_cell
END TYPE t_cell
PUBLIC t_cell
CONTAINS
subroutine mpi_bc(this,mpi_comm,irank)
use m_mpi_bc_tool
class(t_cell),INTENT(INOUT)::this
integer,INTENT(IN):: mpi_comm
INTEGER,INTENT(IN),OPTIONAL::irank
INTEGER ::rank
if (present(irank)) THEN
rank=0
else
rank=irank
end if
call mpi_bc(this%omtil,rank,mpi_comm)
call mpi_bc(this%area,rank,mpi_comm)
call mpi_bc(this%amat,rank,mpi_comm)
call mpi_bc(this%bmat,rank,mpi_comm)
call mpi_bc(this%bbmat,rank,mpi_comm)
call mpi_bc(this%aamat,rank,mpi_comm)
call mpi_bc(this%z1,rank,mpi_comm)
call mpi_bc(this%vol,rank,mpi_comm)
call mpi_bc(this%volint,rank,mpi_comm)
end subroutine mpi_bc
SUBROUTINE init(cell)
!initialize cell, only input is cell%amat and cell%z1 in case of a film
USE m_constants,ONLY:tpi_const
......
This diff is collapsed.
......@@ -50,10 +50,43 @@ MODULE m_types_sym
PROCEDURE :: print_xml
PROCEDURE :: closure
PROCEDURE :: read_xml
PROCEDURE :: mpi_bc => mpi_bc_sym
PROCEDURE,PRIVATE :: check_close
END TYPE t_sym
CONTAINS
subroutine mpi_bc(this,mpi_comm,irank)
use m_mpi_bc_tool
class(t_sym),INTENT(INOUT)::this
integer,INTENT(IN):: mpi_comm
INTEGER,INTENT(IN),OPTIONAL::irank
INTEGER ::rank
if (present(irank)) THEN
rank=0
else
rank=irank
end if
call mpi_bc(this%nop,rank,mpi_comm)
call mpi_bc(this%mrot,rank,mpi_comm)
call mpi_bc(this%tau,rank,mpi_comm)
call mpi_bc(this%symor,rank,mpi_comm)
call mpi_bc(this%invs2,rank,mpi_comm)
call mpi_bc(this%invs,rank,mpi_comm)
call mpi_bc(this%zrfs,rank,mpi_comm)
call mpi_bc(this%invtab,rank,mpi_comm)
call mpi_bc(this%multab,rank,mpi_comm)
call mpi_bc(this%nop2,rank,mpi_comm)
call mpi_bc(this%d_wgn,rank,mpi_comm)
call mpi_bc(this%invsatnr,rank,mpi_comm)
call mpi_bc(this%invarop,rank,mpi_comm)
call mpi_bc(this%invarind,rank,mpi_comm)
call mpi_bc(this%nsymt,rank,mpi_comm)
call mpi_bc(this%nsym,rank,mpi_comm)
end subroutine mpi_bc
SUBROUTINE read_xml(this,xml)
USE m_types_xml
USE m_calculator
......@@ -248,6 +281,8 @@ CONTAINS
sym%nop2 = 0
ENDIF
!Generated wigner symbols for LDA+U
IF (ALLOCATED(sym%d_wgn)) DEALLOCATE(sym%d_wgn)
ALLOCATE(sym%d_wgn(-3:3,-3:3,3,sym%nop))
......
......@@ -13,118 +13,118 @@ MODULE m_types_wannier
! type for wannier-functions
!
TYPE,EXTENDS(t_fleurinput_base):: t_wann
INTEGER :: wan90version
INTEGER :: oc_num_orbs
INTEGER :: wan90version =3
INTEGER :: oc_num_orbs =0
INTEGER, ALLOCATABLE :: oc_orbs(:)
LOGICAL :: l_unformatted
LOGICAL :: l_oc_f
LOGICAL :: l_ndegen
LOGICAL :: l_orbitalmom
LOGICAL :: l_orbcomp
LOGICAL :: l_orbcomprs
LOGICAL :: l_denmat
LOGICAL :: l_perturbrs
LOGICAL :: l_perturb
LOGICAL :: l_nedrho
LOGICAL :: l_anglmomrs
LOGICAL :: l_anglmom
LOGICAL :: l_spindisp
LOGICAL :: l_spindisprs
LOGICAL :: l_socspicom
LOGICAL :: l_socspicomrs
LOGICAL :: l_offdiposoprs
LOGICAL :: l_offdiposop
LOGICAL :: l_torque
LOGICAL :: l_torquers
LOGICAL :: l_atomlist
INTEGER :: atomlist_num
LOGICAL :: l_unformatted =.false.
LOGICAL :: l_oc_f=.false.
LOGICAL :: l_ndegen=.false.
LOGICAL :: l_orbitalmom=.false.
LOGICAL :: l_orbcomp=.false.
LOGICAL :: l_orbcomprs=.false.
LOGICAL :: l_denmat=.false.
LOGICAL :: l_perturbrs=.false.
LOGICAL :: l_perturb=.false.
LOGICAL :: l_nedrho=.false.
LOGICAL :: l_anglmomrs=.false.
LOGICAL :: l_anglmom=.false.
LOGICAL :: l_spindisp=.false.
LOGICAL :: l_spindisprs=.false.
LOGICAL :: l_socspicom=.false.
LOGICAL :: l_socspicomrs=.false.
LOGICAL :: l_offdiposoprs=.false.
LOGICAL :: l_offdiposop=.false.
LOGICAL :: l_torque=.false.
LOGICAL :: l_torquers=.false.
LOGICAL :: l_atomlist=.false.
INTEGER :: atomlist_num=0
INTEGER, ALLOCATABLE :: atomlist(:)
LOGICAL :: l_berry
LOGICAL :: l_perpmagrs
LOGICAL :: l_perpmag
LOGICAL :: l_perpmagat
LOGICAL :: l_perpmagatrs
LOGICAL :: l_socmatrs
LOGICAL :: l_socmat
LOGICAL :: l_soctomom
LOGICAL :: l_kptsreduc2
LOGICAL :: l_nablapaulirs
LOGICAL :: l_nablars
LOGICAL :: l_surfcurr
LOGICAL :: l_updown
LOGICAL :: l_ahe
LOGICAL :: l_she
LOGICAL :: l_rmat
LOGICAL :: l_nabla
LOGICAL :: l_socodi
LOGICAL :: l_pauli
LOGICAL :: l_pauliat
LOGICAL :: l_potmat
LOGICAL :: l_projgen
LOGICAL :: l_plot_symm
LOGICAL :: l_socmmn0
LOGICAL :: l_bzsym
LOGICAL :: l_hopping
LOGICAL :: l_kptsreduc
LOGICAL :: l_prepwan90
LOGICAL :: l_plot_umdat
LOGICAL :: l_wann_plot
LOGICAL :: l_bynumber
LOGICAL :: l_stopopt
LOGICAL :: l_matrixmmn
LOGICAL :: l_matrixamn
LOGICAL :: l_projmethod
LOGICAL :: l_wannierize
LOGICAL :: l_plotw90
LOGICAL :: l_byindex
LOGICAL :: l_byenergy
LOGICAL :: l_proj_plot
LOGICAL :: l_bestproj
LOGICAL :: l_ikptstart
LOGICAL :: l_lapw
LOGICAL :: l_plot_lapw
LOGICAL :: l_fermi
LOGICAL :: l_dipole
LOGICAL :: l_dipole2
LOGICAL :: l_dipole3
LOGICAL :: l_mmn0
LOGICAL :: l_mmn0at
LOGICAL :: l_manyfiles
LOGICAL :: l_collectmanyfiles
LOGICAL :: l_ldauwan
LOGICAL :: l_lapw_kpts
LOGICAL :: l_lapw_gfleur
LOGICAL :: l_kpointgen
LOGICAL :: l_w90kpointgen
LOGICAL :: l_finishnocoplot
LOGICAL :: l_finishgwf
LOGICAL :: l_skipkov
LOGICAL :: l_matrixuHu
LOGICAL :: l_matrixuHu_dmi
INTEGER :: ikptstart
INTEGER :: band_min(1:2)
INTEGER :: band_max(1:2)
INTEGER :: gfthick
INTEGER :: gfcut
INTEGER :: unigrid(6)
INTEGER :: mhp(3)
LOGICAL :: l_berry=.false.
LOGICAL :: l_perpmagrs=.false.
LOGICAL :: l_perpmag=.false.
LOGICAL :: l_perpmagat=.false.
LOGICAL :: l_perpmagatrs=.false.
LOGICAL :: l_socmatrs=.false.
LOGICAL :: l_socmat=.false.
LOGICAL :: l_soctomom=.false.
LOGICAL :: l_kptsreduc2=.false.
LOGICAL :: l_nablapaulirs=.false.
LOGICAL :: l_nablars=.false.
LOGICAL :: l_surfcurr=.false.
LOGICAL :: l_updown=.false.
LOGICAL :: l_ahe=.false.
LOGICAL :: l_she=.false.
LOGICAL :: l_rmat=.false.
LOGICAL :: l_nabla=.false.
LOGICAL :: l_socodi=.false.
LOGICAL :: l_pauli=.false.
LOGICAL :: l_pauliat=.false.
LOGICAL :: l_potmat=.false.
LOGICAL :: l_projgen=.false.
LOGICAL :: l_plot_symm=.false.
LOGICAL :: l_socmmn0=.false.
LOGICAL :: l_bzsym=.false.
LOGICAL :: l_hopping=.false.
LOGICAL :: l_kptsreduc=.false.
LOGICAL :: l_prepwan90=.false.
LOGICAL :: l_plot_umdat=.false.
LOGICAL :: l_wann_plot=.false.
LOGICAL :: l_bynumber=.false.
LOGICAL :: l_stopopt=.false.
LOGICAL :: l_matrixmmn=.false.
LOGICAL :: l_matrixamn=.false.
LOGICAL :: l_projmethod=.false.
LOGICAL :: l_wannierize=.false.
LOGICAL :: l_plotw90=.false.
LOGICAL :: l_byindex=.false.
LOGICAL :: l_byenergy=.false.
LOGICAL :: l_proj_plot=.false.
LOGICAL :: l_bestproj=.false.
LOGICAL :: l_ikptstart=.false.
LOGICAL :: l_lapw=.false.
LOGICAL :: l_plot_lapw=.false.
LOGICAL :: l_fermi=.false.
LOGICAL :: l_dipole=.false.
LOGICAL :: l_dipole2=.false.
LOGICAL :: l_dipole3=.false.
LOGICAL :: l_mmn0=.false.
LOGICAL :: l_mmn0at=.false.
LOGICAL :: l_manyfiles=.false.
LOGICAL :: l_collectmanyfiles=.false.
LOGICAL :: l_ldauwan=.false.
LOGICAL :: l_lapw_kpts=.false.
LOGICAL :: l_lapw_gfleur=.false.
LOGICAL :: l_kpointgen=.false.
LOGICAL :: l_w90kpointgen=.false.
LOGICAL :: l_finishnocoplot=.false.
LOGICAL :: l_finishgwf=.false.
LOGICAL :: l_skipkov=.false.
LOGICAL :: l_matrixuHu=.false.
LOGICAL :: l_matrixuHu_dmi=.false.
INTEGER :: ikptstart=1
INTEGER :: band_min(1:2)=-1
INTEGER :: band_max(1:2)=-1
INTEGER :: gfthick=0
INTEGER :: gfcut=0
INTEGER :: unigrid(6)=0
INTEGER :: mhp(3)=0
!---> gwf
LOGICAL :: l_ms
LOGICAL :: l_sgwf
LOGICAL :: l_socgwf
LOGICAL :: l_gwf
LOGICAL :: l_bs_comf
LOGICAL :: l_exist
LOGICAL :: l_opened
LOGICAL :: l_cleverskip
LOGICAL :: l_dim(3)
REAL :: scale_param
REAL :: aux_latt_const
REAL :: hdwf_t1
REAL :: hdwf_t2
INTEGER :: nparampts
CHARACTER(len=20) :: fn_eig
CHARACTER(len=20) :: param_file
LOGICAL :: l_ms=.false.
LOGICAL :: l_sgwf=.false.
LOGICAL :: l_socgwf=.false.
LOGICAL :: l_gwf=.false.
LOGICAL :: l_bs_comf=.false.
LOGICAL :: l_exist=.false.
LOGICAL :: l_opened=.false.
LOGICAL :: l_cleverskip=.false.
LOGICAL :: l_dim(3)=.false.
REAL :: scale_param=1.0
REAL :: aux_latt_const=8.0
REAL :: hdwf_t1=0.0
REAL :: hdwf_t2=0.0
INTEGER :: nparampts=0
CHARACTER(len=20) :: fn_eig=''
CHARACTER(len=20) :: param_file='qpts'
REAL, ALLOCATABLE :: param_vec(:, :)
REAL, ALLOCATABLE :: param_alpha(:, :)
CHARACTER(LEN=20), ALLOCATABLE :: jobList(:)
......
MODULE m_convn
use m_juDFT
use m_juDFT
implicit none
CONTAINS
SUBROUTINE convn(&
& dimension,atoms,stars)
& atoms,stars)
!
! ***********************************************************
! determines the optimum values for the convergence parameter
......@@ -15,7 +16,6 @@
USE m_types
IMPLICIT NONE
! ..
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_atoms),INTENT(INOUT) :: atoms
TYPE(t_stars),INTENT(IN) :: stars
! .. Local Scalars ..
......@@ -62,11 +62,6 @@
l = nc - 1
WRITE (6,FMT=8020) n,nc,l
40 CONTINUE
l = dimension%ncvd - 1
WRITE (6,FMT=8030) dimension%ncvd,l
DO 50 n = 1,atoms%ntype
atoms%ncv(n) = min0(atoms%ncv(n),dimension%ncvd)
50 CONTINUE
RETURN
60 WRITE (6,FMT=8040) n,sck
CALL juDFT_error("ncv",calledby="convn")
......
MODULE m_convndim
use m_juDFT
CONTAINS
SUBROUTINE convn_dim(
> gmaxr,
< ncvd)
c ***********************************************************
c determines the optimum values for the convergence parameter
c for each atom type using the criterion discussed in
c m. weinert, j. math. phys. 22, 2433 (1981). each sphere
c and l component may have different values. (psqpw changed
c to allow this option).
c m. weinert july 1982
c ***********************************************************
IMPLICIT NONE
REAL gmaxr
INTEGER ncvd
REAL z0,z(17)
INTEGER i,n1
c .. data statements ..
DATA z/6.9e0,8.1e0,9.3e0,10.5e0,11.6e0,12.7e0,13.9e0,15.0e0,
+ 16.1e0,17.2e0,18.3e0,19.4e0,20.5e0,21.6e0,22.7e0,23.7e0,
+ 24.8e0/,z0/5.7e0/
c ..
IF (gmaxr.LT.z0) THEN
WRITE (6,'('' gmax.r too small:'',f10.5)') gmaxr
CALL juDFT_error("convn",calledby="convn_dim")
END IF
IF (gmaxr.GT.z(17)) THEN
n1 = 0.9e0* (gmaxr-z(17))
ncvd = 18 + n1
ELSE
DO i = 1,17
IF (gmaxr.LE.z(i)) THEN
ncvd = i
END IF
END DO
END IF
END SUBROUTINE convn_dim
END MODULE m_convndim
......@@ -73,7 +73,6 @@ SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,&
CALL MPI_BCAST(dimension%nstd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%kimax,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%kimax2,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(dimension%ncvd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(dimension%nvd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(dimension%neigd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(dimension%nv2d,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
......
......@@ -17,7 +17,6 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
USE m_constants
USE m_lapwdim
USE m_ylm
USE m_convndim
USE m_chkmt
USE m_localsym
USE m_strgndim
......@@ -269,7 +268,6 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
dimension%nspd=(atoms%lmaxd+1+mod(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)
rmtmax = maxval(atoms%rmt(:))
rmtmax = rmtmax*stars%gmax
CALL convn_dim(rmtmax,dimension%ncvd)
dimension%msh = 0
ALLOCATE(atoms%rmsh(atoms%jmtd,atoms%ntype))
ALLOCATE(atoms%volmts(atoms%ntype))
......@@ -502,10 +500,54 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,kpts,&
ELSE
CALL strgn2(stars,sym,atoms,vacuum,sphhar,input,cell,xcpot)
END IF
CALL timestop("strgn")
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 timestop("strgn")
!Adjust kpoints in case of DOS
IF ( banddos%dos .AND. banddos%ndir == -3 ) THEN
WRITE(*,*) 'Recalculating k point grid to cover the full BZ.'
!CALL gen_bz(kpts,sym)
kpts%nkpt = kpts%nkptf
DEALLOCATE(kpts%bk,kpts%wtkpt)
ALLOCATE(kpts%bk(3,kpts%nkptf),kpts%wtkpt(kpts%nkptf))
kpts%bk(:,:) = kpts%bkf(:,:)
IF (kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3).NE.kpts%nkptf) THEN
IF(kpts%l_gamma) THEN
kpts%wtkpt = 1.0 / (kpts%nkptf-1)
DO i = 1, kpts%nkptf
IF(ALL(kpts%bk(:,i).EQ.0.0)) THEN
kpts%wtkpt(i) = 0.0
END IF
END DO
ELSE
CALL juDFT_error("nkptf does not match product of nkpt3(i).",calledby="fleur_init")
END IF
ELSE
kpts%wtkpt = 1.0 / kpts%nkptf
END IF
END IF
! Other small stuff
IF( sym%invs .OR. noco%l_soc ) THEN
sym%nsym = sym%nop
ELSE
! combine time reversal symmetry with the spatial symmetry opera
! thus the symmetry operations are doubled
sym%nsym = 2*sym%nop
END IF
input%strho = .FALSE.
INQUIRE(file="cdn1",exist=l_opti)
......
......@@ -42,7 +42,6 @@
USE m_inv3
USE m_rwsymfile
USE m_strgndim
USE m_convndim
USE m_inpeigdim
USE m_ylm
IMPLICIT NONE
......@@ -184,7 +183,6 @@
! not as accurate, but saves much time
rmtmax = rmtmax*stars%gmax
CALL convn_dim(rmtmax,dimension%ncvd)
!
! determine core mesh
!
......
......@@ -80,8 +80,6 @@
8200 FORMAT(6x,'parameter (msh=',i4,',nstd=',i2,')')
WRITE (6,'(6x,''Max. l-value for pseudocharge exp.'')')
WRITE (6,8210) dimension%ncvd
8210 FORMAT (6x,'parameter (ncvd=',i3,')')
......
......@@ -119,7 +119,6 @@
OPEN (16,status='SCRATCH')
ENDIF
CALL initWannierDefaults(wann)
IF (mpi%irank.EQ.0) THEN
CALL fleur_input_read_xml()
......@@ -153,95 +152,8 @@
DIMENSION%nbasfcn = DIMENSION%nvd + atoms%nat*atoms%nlod*(2*atoms%llod+1)
DIMENSION%lmd = atoms%lmaxd* (atoms%lmaxd+2)
DIMENSION%lmplmd = (DIMENSION%lmd* (DIMENSION%lmd+3))/2
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)
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 )
ENDDO
ENDDO
IF (noco%l_noco) DIMENSION%nbasfcn = 2*DIMENSION%nbasfcn
IF( sym%invs .OR. noco%l_soc ) THEN
sym%nsym = sym%nop
ELSE
! combine time reversal symmetry with the spatial symmetry opera
! thus the symmetry operations are doubled
sym%nsym = 2*sym%nop
END IF
SUBROUTINE init_hybrid()
IF (xcpot%is_hybrid().OR.input%l_rdmft) THEN
IF (input%film.OR.oneD%odi%d1) THEN
CALL juDFT_error("2D film and 1D calculations not implemented for HF/EXX/PBE0/HSE", &
calledby ="fleur", hint="Use a supercell or a different functional")
END IF
! IF( ANY( atoms%l_geo ) )&
! & CALL juDFT_error("Forces not implemented for HF/PBE0/HSE ",&
! & calledby ="fleur")
!calculate whole Brilloun zone
!CALL gen_bz(kpts,sym)
CALL gen_map(atoms,sym,oneD,hybrid)
! calculate d_wgn
ALLOCATE (hybrid%d_wgn2(-atoms%lmaxd:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,0:atoms%lmaxd,sym%nsym))
CALL d_wigner(sym%nop,sym%mrot,cell%bmat,atoms%lmaxd,hybrid%d_wgn2(:,:,1:,:sym%nop))
hybrid%d_wgn2(:,:,0,:) = 1
DO isym = sym%nop+1,sym%nsym
iisym = isym - sym%nop
DO l = 0,atoms%lmaxd
DO m2 = -l,l
DO m1 = -l,-1
cdum = hybrid%d_wgn2( m1,m2,l,iisym)
hybrid%d_wgn2( m1,m2,l,isym) = hybrid%d_wgn2(-m1,m2,l,iisym)*(-1)**m1
hybrid%d_wgn2(-m1,m2,l,isym) = cdum *(-1)**m1
END DO
hybrid%d_wgn2(0,m2,l,isym) = hybrid%d_wgn2(0,m2,l,iisym)
END DO
END DO
END DO
ELSE
hybrid%l_calhf = .FALSE.
ALLOCATE(hybrid%map(0,0),hybrid%tvec(0,0,0),hybrid%d_wgn2(0,0,0,0))
IF(input%l_rdmft) THEN
hybrid%l_calhf = .FALSE.
END IF
ENDIF
END SUBROUTINE init_hybrid
IF ( banddos%dos .AND. banddos%ndir == -3 ) THEN
WRITE(*,*) 'Recalculating k point grid to cover the full BZ.'
!CALL gen_bz(kpts,sym)
kpts%nkpt = kpts%nkptf
DEALLOCATE(kpts%bk,kpts%wtkpt)
ALLOCATE(kpts%bk(3,kpts%nkptf),kpts%wtkpt(kpts%nkptf))
kpts%bk(:,:) = kpts%bkf(:,:)
IF (kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3).NE.kpts%nkptf) THEN
IF(kpts%l_gamma) THEN
kpts%wtkpt = 1.0 / (kpts%nkptf-1)
DO i = 1, kpts%nkptf
IF(ALL(kpts%bk(:,i).EQ.0.0)) THEN
kpts%wtkpt(i) = 0.0
END IF
END DO
ELSE
CALL juDFT_error("nkptf does not match product of nkpt3(i).",calledby="fleur_init")
END IF
ELSE
kpts%wtkpt = 1.0 / kpts%nkptf
END IF
END IF