Commit fd97e91c authored by Matthias Redies's avatar Matthias Redies

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents 0243bf82 b5433f1a
......@@ -233,7 +233,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
! valence density in the atomic spheres
CALL eigVecCoeffs%init(input,atoms,noco,jspin,noccbd)
IF (gfinp%n.GT.0.AND.(input%tria.OR.input%gfTet)) THEN
IF (gfinp%n.GT.0.AND..FALSE.) THEN! (input%tria.OR.input%gfTet)) THEN
CALL timestart("TetrahedronWeights")
ALLOCATE(dosWeights(gfinp%ne,noccbd),source=0.0)
ALLOCATE(resWeights(gfinp%ne,noccbd),source=0.0)
......@@ -279,7 +279,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF(l_coreSpec) CALL corespec_dos(atoms,usdus,ispin,atoms%lmaxd*(atoms%lmaxd+2),kpts%nkpt,ikpt,input%neig,&
noccbd,results%ef,banddos%sig_dos,eig,we,eigVecCoeffs)
END DO ! end loop over ispin
IF (gfinp%n.GT.0.AND.(input%tria.OR.input%gfTet)) DEALLOCATE(dosWeights,resWeights,dosBound)
IF (gfinp%n.GT.0.AND..FALSE.) DEALLOCATE(dosWeights,resWeights,dosBound)
IF (noco%l_mperp) CALL denCoeffsOffdiag%calcCoefficients(atoms,sphhar,sym,eigVecCoeffs,we,noccbd)
IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf).AND.(banddos%ndir.GT.0)) THEN
......
......@@ -33,7 +33,7 @@ CONTAINS
INTEGER:: jsp
IF (atoms%n_u+atoms%n_hia>0) THEN
CALL u_setup(sym,atoms,sphhar,input,noco,enpara%el0(0:,:,:),inDen,vTot,mpi,results)
CALL u_setup(sym,atoms,sphhar,input,noco,hub1inp,enpara%el0(0:,:,:),inDen,vTot,mpi,results)
END IF
......@@ -44,7 +44,7 @@ CONTAINS
DO jsp=1,MERGE(4,input%jspins,noco%l_mtNocoPot)
!CALL tlmplm_cholesky(sphhar,atoms,DIMENSION,enpara, jsp,1,mpi,vTot%mt(:,0,1,jsp),input,vTot%mmpMat, td,ud)
CALL tlmplm_cholesky(sphhar,atoms,sym,noco,enpara,jsp,mpi,vTot,input,td,ud)
CALL tlmplm_cholesky(sphhar,atoms,sym,noco,enpara,jsp,mpi,vTot,input,hub1inp,td,ud)
IF (input%l_f) CALL write_tlmplm(td,vTot%mmpMat,atoms%n_u+atoms%n_hia>0,jsp,jsp,input%jspins)
END DO
CALL timestop("tlmplm")
......
......@@ -6,7 +6,7 @@
MODULE m_radovlp
CONTAINS
SUBROUTINE rad_ovlp(atoms,usdus,input,vr,epar, uun21,udn21,dun21,ddn21)
SUBROUTINE rad_ovlp(atoms,usdus,input,hub1inp,vr,epar, uun21,udn21,dun21,ddn21)
!***********************************************************************
! calculates the overlap of the radial basis functions with different
! spin directions. These overlapp integrals are needed to calculate
......@@ -22,6 +22,7 @@ MODULE m_radovlp
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_hub1inp),INTENT(IN) ::hub1inp
TYPE(t_usdus),INTENT(INOUT):: usdus
! .. Array Arguments ..
......@@ -52,7 +53,7 @@ MODULE m_radovlp
!In the case of a spin-polarized calculation with Hubbard 1 we want to treat
!the correlated orbitals with a non-spin-polarized basis
IF(l_hia.AND.input%jspins.EQ.2.AND..NOT.input%l_dftspinpol) THEN
IF(l_hia.AND.input%jspins.EQ.2.AND..NOT.hub1inp%l_dftspinpol) THEN
vrTmp = (vr(:,0,iType,1) + vr(:,0,iType,2))/2.0
ELSE
vrTmp = vr(:,0,iType,ispin)
......
......@@ -7,7 +7,7 @@ MODULE m_tlmplm
!*********************************************************************
CONTAINS
SUBROUTINE tlmplm(n,sphhar,atoms,sym,enpara,&
jspin,jsp,mpi,v,input,td,ud)
jspin,jsp,mpi,v,input,hub1inp,td,ud)
USE m_constants
USE m_intgr, ONLY : intgr3
USE m_genMTBasis
......@@ -16,13 +16,14 @@ CONTAINS
USE m_types
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_enpara),INTENT(IN) :: enpara
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_enpara),INTENT(IN) :: enpara
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_potden),INTENT(IN) :: v
TYPE(t_hub1inp),INTENT(IN) :: hub1inp
TYPE(t_tlmplm),INTENT(INOUT) :: td
TYPE(t_usdus),INTENT(INOUT) :: ud
......@@ -55,7 +56,7 @@ CONTAINS
IF (jsp<3) vr0(:,0)=0.0
DO i=MERGE(1,jspin,jspin>2),MERGE(2,jspin,jspin>2)
CALL genMTBasis(atoms,enpara,v,mpi,n,i,ud,f(:,:,:,i),g(:,:,:,i),flo,input%l_dftspinpol)
CALL genMTBasis(atoms,enpara,v,mpi,n,i,ud,f(:,:,:,i),g(:,:,:,i),flo,hub1inp%l_dftspinpol)
ENDDO
IF (jspin>2) THEN
jspin1=1
......
......@@ -9,7 +9,7 @@ MODULE m_tlmplm_cholesky
!*********************************************************************
CONTAINS
SUBROUTINE tlmplm_cholesky(sphhar,atoms,sym,noco,enpara,&
jspin,mpi,v,input,td,ud)
jspin,mpi,v,input,hub1inp,td,ud)
USE m_tlmplm
USE m_types
USE m_radovlp
......@@ -21,6 +21,7 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_enpara),INTENT(IN) :: enpara
TYPE(t_hub1inp),INTENT(IN) :: hub1inp
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: jspin!physical spin&spin index for data
......@@ -53,7 +54,7 @@ CONTAINS
IF(jsp>=3) THEN
ALLOCATE(uun21(0:atoms%lmaxd,atoms%ntype),udn21(0:atoms%lmaxd,atoms%ntype),&
dun21(0:atoms%lmaxd,atoms%ntype),ddn21(0:atoms%lmaxd,atoms%ntype) )
CALL rad_ovlp(atoms,ud,input,v%mt,enpara%el0, uun21,udn21,dun21,ddn21)
CALL rad_ovlp(atoms,ud,input,hub1inp,v%mt,enpara%el0, uun21,udn21,dun21,ddn21)
ENDIF
td%tdulo(:,:,:,jsp) = CMPLX(0.0,0.0)
......@@ -66,9 +67,9 @@ CONTAINS
!$OMP PRIVATE(temp,i,l,lm,lmin,lmin0,lmp)&
!$OMP PRIVATE(lmplm,lp,m,mp,n)&
!$OMP PRIVATE(OK,s,in,info)&
!$OMP SHARED(atoms,jspin,jsp,sym,sphhar,enpara,td,ud,v,mpi,input,uun21,udn21,dun21,ddn21)
!$OMP SHARED(atoms,jspin,jsp,sym,sphhar,enpara,td,ud,v,mpi,input,hub1inp,uun21,udn21,dun21,ddn21)
DO n = 1,atoms%ntype
CALL tlmplm(n,sphhar,atoms,sym,enpara,jspin,jsp,mpi,v,input,td,ud)
CALL tlmplm(n,sphhar,atoms,sym,enpara,jspin,jsp,mpi,v,input,hub1inp,td,ud)
OK=.FALSE.
cholesky_loop:DO WHILE(.NOT.OK)
td%h_loc(:,:,n,jsp)=0.0
......@@ -183,7 +184,7 @@ CONTAINS
ENDIF
ENDDO
!$OMP END PARALLEL DO
IF (noco%l_constr) CALL tlmplm_constrained(atoms,v,enpara,input,ud,noco,td)
IF (noco%l_constr) CALL tlmplm_constrained(atoms,v,enpara,input,hub1inp,ud,noco,td)
......@@ -193,7 +194,7 @@ CONTAINS
SUBROUTINE tlmplm_constrained(atoms,v,enpara,input,ud,noco,td)
SUBROUTINE tlmplm_constrained(atoms,v,enpara,input,hub1inp,ud,noco,td)
USE m_radovlp
USE m_types
IMPLICIT NONE
......@@ -204,6 +205,7 @@ CONTAINS
TYPE(t_tlmplm),INTENT(INOUT):: td
TYPE(t_usdus),INTENT(INOUT) :: ud
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_hub1inp),INTENT(IN) :: hub1inp
REAL, ALLOCATABLE :: uun21(:,:),udn21(:,:),dun21(:,:),ddn21(:,:)
COMPLEX :: c
......@@ -212,7 +214,7 @@ CONTAINS
ALLOCATE(uun21(0:atoms%lmaxd,atoms%ntype),udn21(0:atoms%lmaxd,atoms%ntype),&
dun21(0:atoms%lmaxd,atoms%ntype),ddn21(0:atoms%lmaxd,atoms%ntype) )
CALL rad_ovlp(atoms,ud,input,v%mt,enpara%el0, uun21,udn21,dun21,ddn21)
CALL rad_ovlp(atoms,ud,input,hub1inp,v%mt,enpara%el0, uun21,udn21,dun21,ddn21)
DO n = 1,atoms%ntype
!If we do a constraint calculation, we have to calculate the
......
......@@ -9,7 +9,7 @@ MODULE m_sorad
! generates radial spin-orbit matrix elements
!*********************************************************************
CONTAINS
SUBROUTINE sorad(atoms,input,ntyp,vr,enpara,spav,rsoc,usdus)
SUBROUTINE sorad(atoms,input,ntyp,vr,enpara,spav,rsoc,usdus,hub1inp)
USE m_constants, ONLY : c_light
USE m_intgr, ONLY : intgr0
......@@ -24,6 +24,7 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus),INTENT(INOUT) :: usdus
TYPE(t_rsoc),INTENT(INOUT) :: rsoc
TYPE(t_hub1inp),OPTIONAL,INTENT(IN) :: hub1inp
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ntyp
......@@ -60,10 +61,11 @@ CONTAINS
ENDIF
ENDDO
DO jspin = 1,input%jspins
IF(l_hia.AND.input%jspins.EQ.2.AND..NOT.input%l_dftspinpol) THEN
vrTmp = (vr(:,1)+vr(:,2))/2.0
ELSE
vrTmp = vr(:,jspin)
vrTmp = vr(:,jspin)
IF(l_hia.AND.input%jspins.EQ.2) THEN
IF(PRESENT(hub1inp)) THEN
IF(.NOT.hub1inp%l_dftspinpol) vrTmp = (vr(:,1)+vr(:,2))/2.0
ENDIF
ENDIF
!
!---> calculate normalized function at e: p and q
......
......@@ -26,7 +26,7 @@ CONTAINS
TYPE(t_usdus),INTENT(INOUT) :: usdus
TYPE(t_rsoc),INTENT(OUT) :: rsoc
LOGICAL,INTENT(IN) :: l_angles
TYPE(t_hub1inp),OPTIONAL,INTENT(IN) :: hub1inp
TYPE(t_hub1inp),OPTIONAL, INTENT(IN) :: hub1inp
TYPE(t_hub1data),OPTIONAL,INTENT(INOUT) :: hub1data
! ..
! ..
......@@ -53,7 +53,7 @@ CONTAINS
!Calculate radial soc-matrix elements
DO n = 1,atoms%ntype
CALL sorad(atoms,input,n,vr(:,0,n,:),enpara,noco%l_spav,rsoc,usdus)
CALL sorad(atoms,input,n,vr(:,0,n,:),enpara,noco%l_spav,rsoc,usdus,hub1inp)
END DO
......@@ -73,7 +73,7 @@ CONTAINS
rsoc%rsoploplop(n,:,:,:,:) = rsoc%rsoploplop(n,:,:,:,:)*noco%socscale(n)
ENDIF
ENDDO
!Read in SOC-parameter for shell with hubbard 1
IF(PRESENT(hub1inp).AND.mpi%irank.EQ.0) THEN
DO i_hia = 1, atoms%n_hia
......
......@@ -13,23 +13,6 @@ MODULE m_types_atoms
IMPLICIT NONE
PRIVATE
TYPE t_gfelementtype
SEQUENCE
!defines the l and atomType elements for given greens function element (used for mapping index in types_greensf)
INTEGER :: l=-1
INTEGER :: lp=-1
INTEGER :: atomType=0
INTEGER :: atomTypep=0
END TYPE t_gfelementtype
TYPE t_j0calctype
INTEGER :: atomType=0 !atom Type for which to calculate J0
INTEGER :: l_min=-1 !Minimum l considered
INTEGER :: l_max=-1 !Maximum l considered
LOGICAL :: l_avgexc=.FALSE. !Determines wether we average over the exchange splittings for all l
LOGICAL :: l_eDependence=.FALSE. !Switch to output J0 with variating fermi energy (only with contourDOS)
END TYPE t_j0calctype
TYPE t_utype
SEQUENCE
REAL :: u=0.0, j=0.0 ! the actual U and J parameters
......@@ -53,10 +36,6 @@ MODULE m_types_atoms
INTEGER ::n_u=0
! no of lda+hubbard1s
INTEGER :: n_hia=0
! no of j0 calculations
INTEGER :: n_j0=0
! no of greens function calculations (in total)
INTEGER :: n_gf=0
! dimensions
INTEGER :: jmtd=-1
INTEGER :: msh=0 !core state mesh was in dimension
......@@ -115,11 +94,6 @@ MODULE m_types_atoms
!lda+hubbard1 information is attached behind lda+u
!so the dimension actually used is atoms%n_u+atoms%n_hia
TYPE(t_utype), ALLOCATABLE::lda_u(:)
!greens function information(4*ntype)
TYPE(t_gfelementtype), ALLOCATABLE::gfelem(:)
!j0 calc information(4*ntype)
TYPE(t_j0calctype), ALLOCATABLE::j0(:)
INTEGER, ALLOCATABLE :: relax(:, :) !<(3,ntype)
!flipSpinTheta and flipSpinPhi are the angles which are given
!in the input to rotate the charge den by these polar angles.
......@@ -133,7 +107,6 @@ CONTAINS
PROCEDURE :: init=>init_atoms
PROCEDURE :: nsp => calc_nsp_atom
PROCEDURE :: same_species
PROCEDURE :: add_gfjob
PROCEDURE :: read_xml => read_xml_atoms
PROCEDURE :: mpi_bc=>mpi_bc_atoms
END TYPE t_atoms
......@@ -280,8 +253,6 @@ SUBROUTINE read_xml_atoms(this,xml)
ALLOCATE(this%label(this%nat))
ALLOCATE(this%pos(3,this%nat))
ALLOCATE(this%rmt(this%ntype))
ALLOCATE(this%j0(this%ntype))
ALLOCATE(this%gfelem(4*This%ntype))
ALLOCATE(this%econf(this%ntype))
ALLOCATE(this%ncv(this%ntype)) ! For what is this?
ALLOCATE(this%lapw_l(this%ntype)) ! Where do I put this?
......@@ -579,47 +550,4 @@ SUBROUTINE init_atoms(this,cell)
WHERE (ABS(this%pos(3,:)-this%taual(3,:))>0.5) this%taual(3,:) = this%taual(3,:) / cell%amat(3,3)
this%pos(:,:) = MATMUL(cell%amat,this%taual(:,:))
END SUBROUTINE init_atoms
SUBROUTINE add_gfjob(this,nType,lmin,lmax,l_off,l_inter,l_nn)
USE m_juDFT
CLASS(t_atoms), INTENT(INOUT) :: this
INTEGER, INTENT(IN) :: nType
INTEGER, INTENT(IN) :: lmin
INTEGER, INTENT(IN) :: lmax
LOGICAL, INTENT(IN) :: l_off !l!=lp
LOGICAL, INTENT(IN) :: l_inter
LOGICAL, INTENT(IN) :: l_nn
INTEGER l,lp,i_gf
LOGICAL l_found
IF(l_inter) CALL juDFT_error("Intersite greens function not yet implemented",calledby="add_gfjob")
!TODO: add the nearest neighbours jobs
DO l = lmin, lmax
DO lp = MERGE(lmin,l,l_off), MERGE(lmax,l,l_off)
!Check if this job has already been added
l_found = .FALSE.
DO i_gf = 1, this%n_gf
IF(this%gfelem(i_gf)%l.NE.l) CYCLE
IF(this%gfelem(i_gf)%lp.NE.lp) CYCLE
IF(this%gfelem(i_gf)%atomType.NE.nType) CYCLE
IF(this%gfelem(i_gf)%atomTypep.NE.nType) CYCLE
l_found = .TRUE.
ENDDO
IF(l_found) CYCLE !This job is already in the array
this%n_gf = this%n_gf + 1
this%gfelem(this%n_gf)%l = l
this%gfelem(this%n_gf)%atomType = nType
this%gfelem(this%n_gf)%lp = lp
this%gfelem(this%n_gf)%atomTypep = nType !For now
ENDDO
ENDDO
END SUBROUTINE add_gfjob
END MODULE m_types_atoms
......@@ -27,8 +27,6 @@ MODULE m_types_input
INTEGER :: coretail_lmax =0
INTEGER :: itmax =15
REAL :: minDistance=1.0e-5
REAL :: minoccDistance=1.0e-2 !Distances for the density matrix in DFT+Hubbard 1 case
REAL :: minmatDistance=1.0e-3
INTEGER :: maxiter=99
INTEGER :: imix=7
INTEGER :: gw=0
......@@ -71,27 +69,6 @@ MODULE m_types_input
REAL :: ldauMixParam=0.05
REAL :: ldauSpinf=1.0
LOGICAL :: ldauAdjEnpara=.false.
LOGICAL :: l_dftspinpol=.false.
LOGICAL :: l_gfsphavg=.false.
LOGICAL :: l_gfmperp=.false.
LOGICAL :: l_resolvent=.false.
LOGICAL :: l_hist=.false.
INTEGER :: gf_ne
REAL :: gf_ellow
REAL :: gf_elup
INTEGER :: gf_mode=-1
INTEGER :: gf_n
REAL :: gf_alpha
REAL :: gf_et
REAL :: gf_eb
INTEGER :: gf_n1
INTEGER :: gf_n2
INTEGER :: gf_n3
INTEGER :: gf_nmatsub
REAL :: gf_sigma
LOGICAL :: gf_anacont=.false.
LOGICAL :: gf_dosfermi=.false.
LOGICAL :: gfTet=.false. !This switch will be true iff the tetrahedron were calculated from the equdistant grid
LOGICAL :: l_rdmft=.FALSE.
REAL :: rdmftOccEps=0.0
INTEGER :: rdmftStatesBelow=0
......
......@@ -34,7 +34,7 @@ MODULE m_calc_tria
!IF(.NOT.l_tria) CALL juDFT_warn("Triangles may not cover whol BZ",calledby="calc_tria")
input%gfTet = .TRUE.
!input%gfTet = .TRUE.
!Write to types_kpts (the same arrays as in bulk case)
kpts%ntet = ntria
IF(ALLOCATED(kpts%ntetra)) DEALLOCATE(kpts%ntetra)
......
......@@ -40,7 +40,9 @@ SUBROUTINE greensfImag(atoms,gfinp,sym,input,ispin,nbands,dosWeights,resWeights,
COMPLEX weight
COMPLEX, ALLOCATABLE :: im(:,:)
l_tria = (input%tria.OR.input%gfTet).AND..NOT.input%l_hist
!Temporary until input%tria/input%gauss are sorted out
!l_tria = (input%tria.OR.input%gfTet).AND..NOT.input%l_hist
l_tria=.false.
IF(l_tria.AND.(ANY(ind.GT.gfinp%ne).OR.ANY(ind.LT.1))) THEN
CALL juDFT_error("Invalid index",calledby="greensfImag")
......
......@@ -51,8 +51,9 @@ MODULE m_greensfImag21
IF(.NOT.gfinp%l_sphavg) CALL juDFT_error("NOCO-offdiagonal + Radial dependence of onsite-GF not implemented",calledby="onsite21")
l_tria = (input%tria.OR.input%gfTet).AND..NOT.input%l_hist
!Temporary until input%tria/input%gauss are sorted out
!l_tria = (input%tria.OR.input%gfTet).AND..NOT.input%l_hist
l_tria=.false.
!Get the information on the real axis energy mesh
CALL gfinp%eMesh(ef,del,eb)
......
This diff is collapsed.
......@@ -30,13 +30,14 @@ CONTAINS
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_kpts), INTENT(IN) :: kpts
INTEGER, INTENT(IN) :: nk
INTEGER, INTENT(OUT) :: nsymop
INTEGER, INTENT(INOUT) :: nsymop
INTEGER, INTENT(INOUT) :: rrot(:,:,:) ! 3,3,sym%nsym
INTEGER, INTENT(INOUT) :: psym(:) ! Note: psym is only filled up to index nsymop
INTEGER :: i
REAL :: rotkpt(3)
nsymop = 0
! calculate rotations in reciprocal space
DO i = 1, sym%nsym
IF (i <= sym%nop) THEN
......@@ -96,7 +97,7 @@ CONTAINS
! - scalars -
INTEGER, INTENT(IN) :: nk
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(OUT) :: nkpt_EIBZ
INTEGER, INTENT(INOUT) :: nkpt_EIBZ
INTEGER, INTENT(IN) :: nsymop
! - arrays -
......@@ -146,7 +147,7 @@ CONTAINS
COMPLEX, ALLOCATABLE :: rep_d(:, :, :)
LOGICAL, ALLOCATABLE :: symequivalent(:, :)
parent = 0; nsest = 0; indx_sest = 0;
parent = 0; nsest = 0; indx_sest = 0; nkpt_EIBZ =0;
WRITE (6, '(A)') new_line('n')//new_line('n')//'### subroutine: symm ###'
......@@ -214,7 +215,7 @@ CONTAINS
! determine the factor n_q, that means the number of symmetrie operations of the little group of bk(:,nk)
! which keep q (in EIBZ) invariant
allocate(n_q(nkpt_EIBZ), source=0)
ic = 0
n_q = 0
DO ikpt = 1, kpts%nkptf
......
......@@ -545,15 +545,17 @@ CONTAINS
! Returns the spherical harmonics Y_lm(^rvec) for l = 0,...,ll in Y(1,...,(ll+1)**2).
SUBROUTINE harmonicsr(Y, rvec, ll)
use m_judft
use m_constants, only: CMPLX_NOT_INITALIZED
IMPLICIT NONE
INTEGER, INTENT(IN) :: ll
REAL, INTENT(IN) :: rvec(:)
COMPLEX, INTENT(OUT) :: Y((ll + 1)**2)
COMPLEX, INTENT(INOUT) :: Y((ll + 1)**2)
REAL :: stheta, ctheta, sphi, cphi, r, rvec1(3)
INTEGER :: l, lm
COMPLEX :: c
COMPLEX, PARAMETER :: img = (0.0, 1.0)
Y = CMPLX_NOT_INITALIZED
Y(1) = 0.282094791773878
IF (ll == 0) RETURN
......
......@@ -768,7 +768,7 @@ CONTAINS
IMPLICIT NONE
INTEGER, INTENT(IN) :: n
COMPLEX, INTENT(IN) :: carr(n)
COMPLEX, INTENT(OUT) :: cfac
COMPLEX, INTENT(INOUT) :: cfac
REAL :: rdum, rmax
INTEGER :: i
......@@ -810,7 +810,7 @@ CONTAINS
INTEGER, INTENT(IN) :: maxlcutm
INTEGER, INTENT(IN) :: nbasp
LOGICAL, INTENT(IN) :: writevec
INTEGER, INTENT(OUT) :: igptm_out
INTEGER, INTENT(INOUT) :: igptm_out
! - arrays -
INTEGER, INTENT(IN) :: rrot(:,:), invrrot(:,:)
INTEGER, INTENT(IN) :: lcutm(atoms%ntype),&
......@@ -825,7 +825,7 @@ CONTAINS
COMPLEX, INTENT(IN) :: dwgn(-maxlcutm:maxlcutm,&
-maxlcutm:maxlcutm,&
0:maxlcutm)
COMPLEX, INTENT(OUT) :: vecout(nbasm(ikpt0))
COMPLEX, INTENT(INOUT) :: vecout(nbasm(ikpt0))
! - private scalars -
INTEGER :: itype, ieq, ic, l, n, i, nn, i1, i2, j1, j2
......@@ -841,6 +841,8 @@ CONTAINS
COMPLEX :: vecin1(nbasm(ikpt0))
COMPLEX :: carr(mpdata%n_g(ikpt0))
igptm_out=-1;vecout=CMPLX_NOT_INITALIZED
IF (iop <= sym%nop) THEN
isym = iop
trs = .false.
......
......@@ -35,7 +35,7 @@ CONTAINS
INTEGER, INTENT(IN) :: bandi, bandf, bandoi, bandof
INTEGER, INTENT(IN) :: jsp, nk, iq
INTEGER, INTENT(IN) :: nbasm_mt
INTEGER, INTENT(OUT) :: nkqpt
INTEGER, INTENT(INOUT) :: nkqpt
! - arrays -
REAL, INTENT(INOUT) :: cprod(hybdat%maxbasm1, bandoi:bandof, bandf - bandi + 1)
......@@ -46,7 +46,7 @@ CONTAINS
CALL timestart("wavefproducts_inv5")
cprod = 0.0
cprod = 0.0;nkqpt=-1
kqpthlp = kpts%bkf(:, nk) + kpts%bkf(:, iq)
! kqpt can lie outside the first BZ, transfer it back
kqpt = kpts%to_first_bz(kqpthlp)
......
......@@ -3,7 +3,7 @@ MODULE m_fleurinput_postprocess
IMPLICIT NONE
CONTAINS
SUBROUTINE fleurinput_postprocess(Cell,Sym,Atoms,Input,Noco,Vacuum,&
Banddos,Oned,Xcpot,Kpts)
Banddos,Oned,Xcpot,Kpts,gfinp)
USE m_juDFT
USE m_types_fleurinput
use m_make_sym
......@@ -22,14 +22,15 @@ CONTAINS
TYPE(t_banddos),INTENT(IN) ::banddos
TYPE(t_oneD),INTENT(INOUT) ::oneD
CLASS(t_xcpot),ALLOCATABLE,INTENT(INOUT)::xcpot
TYPE(t_kpts),INTENT(IN)::kpts
TYPE(t_kpts),INTENT(IN) ::kpts
TYPE(t_gfinp),INTENT(IN) ::gfinp
call cell%init(DOT_PRODUCT(atoms%volmts(:),atoms%neq(:)))
call atoms%init(cell)
CALL sym%init(cell,input%film)
call vacuum%init(sym)
CALL make_sym(sym,cell,atoms,noco,oneD,input)
CALL make_sym(sym,cell,atoms,noco,oneD,input,gfinp)
call make_xcpot(xcpot,atoms,input)
call oneD%init(atoms)
......@@ -37,7 +38,7 @@ CONTAINS
! Check muffin tin radii, only checking, dont use new parameters
CALL chkmt(atoms,input,vacuum,cell,oneD,.TRUE.)
!adjust positions by displacements
CALL apply_displacements(cell,input,vacuum,oneD,sym,noco,atoms)
CALL apply_displacements(cell,input,vacuum,oneD,sym,noco,atoms,gfinp)
END SUBROUTINE fleurinput_postprocess
......
......@@ -9,7 +9,7 @@ MODULE m_make_sym
PRIVATE
PUBLIC make_sym
CONTAINS
SUBROUTINE make_sym(sym,cell,atoms,noco,oneD,input)
SUBROUTINE make_sym(sym,cell,atoms,noco,oneD,input,gfinp)
!Generates missing symmetry info.
!tau,mrot and nop have to be specified alread
USE m_dwigner
......@@ -22,12 +22,14 @@ CONTAINS
USE m_types_noco
USE m_types_oneD
use m_types_input
USE m_types_gfinp
TYPE(t_sym),INTENT(INOUT) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_oneD),INTENT(INOUT):: oneD
TYPE(t_input),INTENT(IN) :: input
TYPE(t_gfinp),INTENT(IN) :: gfinp
integer :: nsymt
integer,allocatable::nrot(:),locops(:,:)
......@@ -44,7 +46,7 @@ CONTAINS
!Generated wigner symbols for LDA+U (includes DFT+HubbardI)
IF (ALLOCATED(sym%d_wgn)) DEALLOCATE(sym%d_wgn)
ALLOCATE(sym%d_wgn(-3:3,-3:3,3,sym%nop))
IF (atoms%n_u+atoms%n_hia.GT.0) THEN
IF (atoms%n_u+gfinp%n.GT.0) THEN
CALL d_wigner(sym%nop,sym%mrot,cell%bmat,3,sym%d_wgn)
END IF
......@@ -57,12 +59,12 @@ CONTAINS
IF (.NOT.oneD%odd%d1) THEN
CALL mapatom(sym,atoms,cell,input,noco)
CALL mapatom(sym,atoms,cell,input,noco,gfinp)
allocate(oneD%ngopr1(atoms%nat))
oneD%ngopr1 = sym%ngopr
ELSE
CALL juDFT_error("The oneD version is broken here. Compare call to mapatom with old version")
CALL mapatom(sym,atoms,cell,input,noco)
CALL mapatom(sym,atoms,cell,input,noco,gfinp)
!CALL od_mapatom(oneD,atoms,sym,cell)
END IF
......
......@@ -5,7 +5,7 @@
! atom into its equivalent atoms c.l.fu
!*******************************************************************
CONTAINS
SUBROUTINE mapatom(sym,atoms,cell,input,noco)
SUBROUTINE mapatom(sym,atoms,cell,input,noco,gfinp)
!
! if (l_f) setup multab,invtab,invarop,invarind for force_a12 & 21
!***********************************************************************
......@@ -34,6 +34,7 @@
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_gfinp),INTENT(IN) :: gfinp
! .. Local Scalars ..
REAL s3,norm
......@@ -120,7 +121,7 @@
!
! search for operations which leave taual invariant
!
IF (input%l_f.OR.(atoms%n_u+atoms%n_gf.GT.0)) THEN
IF (input%l_f.OR.(atoms%n_u+gfinp%n.GT.0)) THEN
DO j3 = -2,2
sr(3) = gaminv(3) + real(j3)
DO j2 = -2,2
......@@ -159,7 +160,7 @@
!------------------------- FORCE PART -------------------------------
!+gu this is the remainder of spgset necessary for force calculations
!
IF (input%l_f.OR.(atoms%n_u.GT.0).OR.(atoms%n_gf.GT.0)) THEN
IF (input%l_f.OR.(atoms%n_u+gfinp%n.GT.0)) THEN
WRITE (6,FMT=&
& '(//,"list of operations which leave taual invariant",/)')
......
......@@ -372,8 +372,6 @@
WRITE (6,9060)
atoms%n_u = 0
atoms%n_hia = 0
atoms%n_gf = 0
atoms%n_j0 = 0
DO n=1,atoms%ntype
!
READ (UNIT=5,FMT=7140,END=99,ERR=99) noel(n),atoms%nz(n),&
......
......@@ -127,7 +127,7 @@ CONTAINS
END DO
END SUBROUTINE read_displacements
SUBROUTINE apply_displacements(cell,input,vacuum,oneD,sym,noco,atoms)
SUBROUTINE apply_displacements(cell,input,vacuum,oneD,sym,noco,atoms,gfinp)
USE m_types
USE m_chkmt
USE m_constants
......@@ -138,6 +138,7 @@ CONTAINS
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_sym),INTENT(INOUT) :: sym
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_gfinp),INTENT(IN) :: gfinp
TYPE(t_atoms),INTENT(INOUT):: atoms
......@@ -174,7 +175,7 @@ CONTAINS
END IF
END DO