Commit 5370997f authored by Daniel Wortmann's avatar Daniel Wortmann

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

parents fdac2fb9 ac09716d
......@@ -25,4 +25,5 @@ cdn/qpw_to_nmt.f90
cdn/slab_dim.f90
cdn/slabgeom.f90
cdn/vacden.F90
cdn/genNewNocoInp.f90
)
......@@ -2,7 +2,7 @@ MODULE m_cdnval
use m_juDFT
CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atoms,enpara,stars,&
vacuum,dimension,sphhar,sym,obsolete,igq_fft,vr,vz,oneD,coreSpecInput,den,results,&
vacuum,dimension,sphhar,sym,obsolete,igq_fft,vTot,oneD,coreSpecInput,den,results,&
qvac,qvlay,qa21, chmom,clmom)
!
! ***********************************************************
......@@ -53,8 +53,6 @@ CONTAINS
USE m_rhomtlo
USE m_rhonmtlo
USE m_mcdinit
USE m_sphpts
USE m_points
USE m_sympsi
USE m_enpara, ONLY : w_enpara,mix_enpara
USE m_eparas ! energy parameters and partial charges
......@@ -68,7 +66,7 @@ CONTAINS
USE m_forcea8
USE m_forcea12
USE m_forcea21
USE m_checkdop ! check continuity of density on MT radius R
USE m_checkdopall
USE m_int21 ! integrate (spin) off-diagonal radial functions
USE m_int21lo ! -"- for u_lo
USE m_rhomt21 ! calculate (spin) off-diagonal MT-density coeff's
......@@ -83,7 +81,6 @@ CONTAINS
USE m_Ekwritesl ! and write to file.
USE m_abcrot2
USE m_doswrite
USE m_cylpts
USE m_cdnread, ONLY : cdn_read0, cdn_read
USE m_corespec, only : l_cs ! calculation of core spectra (EELS)
USE m_corespec_io, only : corespec_init
......@@ -94,24 +91,25 @@ CONTAINS
USE m_types
USE m_xmlOutput
IMPLICIT NONE
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_enpara),INTENT(INOUT) :: enpara
TYPE(t_obsolete),INTENT(IN) :: obsolete
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_sliceplot),INTENT(IN) :: sliceplot
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_enpara),INTENT(INOUT) :: enpara
TYPE(t_obsolete),INTENT(IN) :: obsolete
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_sliceplot),INTENT(IN) :: sliceplot
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_coreSpecInput),INTENT(IN) :: coreSpecInput
TYPE(t_potden),INTENT(IN) :: vTot
TYPE(t_potden),INTENT(INOUT) :: den
! .. Scalar Arguments ..
......@@ -120,8 +118,6 @@ CONTAINS
! .. Array Arguments ..
COMPLEX, INTENT(INOUT) :: qa21(atoms%ntype)
INTEGER, INTENT (IN) :: igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1)
REAL, INTENT (IN) :: vz(vacuum%nmzd,2)
REAL, INTENT (IN) :: vr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd)
REAL, INTENT (OUT) :: chmom(atoms%ntype,dimension%jspd),clmom(3,atoms%ntype,dimension%jspd)
REAL, INTENT (INOUT) :: qvac(dimension%neigd,2,kpts%nkpt,dimension%jspd)
REAL, INTENT (INOUT) :: qvlay(dimension%neigd,vacuum%layerd,2,kpts%nkpt,dimension%jspd)
......@@ -133,17 +129,17 @@ CONTAINS
! .. Local Scalars ..
TYPE(t_lapw):: lapw
INTEGER :: llpd
REAL wronk,sign,emcd_lo,emcd_up
REAL wronk,emcd_lo,emcd_up
INTEGER i,ie,iv,ivac,j,k,l,l1,lh ,n,ilo,isp,nat,&
nbands,noded,nodeu,noccbd,nslibd,na,&
ikpt,npd ,jsp_start,jsp_end,ispin
ikpt,jsp_start,jsp_end,ispin
INTEGER skip_t,skip_tt
INTEGER n_size,i_rec,n_rank ,ncored,n_start,n_end,noccbd_l
COMPLEX,parameter:: czero=(0.0,0.0)
LOGICAL l_fmpl,l_mcd,l_evp,l_orbcomprot
! ...Local Arrays ..
INTEGER n_bands(0:dimension%neigd),ncore(atoms%ntype)
REAL cartk(3),xp(3,dimension%nspd),e_mcd(atoms%ntype,input%jspins,dimension%nstd)
REAL cartk(3),e_mcd(atoms%ntype,input%jspins,dimension%nstd)
REAL eig(dimension%neigd)
REAL vz0(2)
REAL uuilon(atoms%nlod,atoms%ntype),duilon(atoms%nlod,atoms%ntype)
......@@ -373,7 +369,7 @@ CONTAINS
DO l = 0,atoms%lmax(n)
DO ispin =jsp_start,jsp_end
CALL radfun(&
l,n,ispin,enpara%el0(l,n,ispin),vr(1,0,n,ispin),atoms,&
l,n,ispin,enpara%el0(l,n,ispin),vTot%mt(1,0,n,ispin),atoms,&
f(1,1,l,ispin),g(1,1,l,ispin),usdus,&
nodeu,noded,wronk)
IF (input%cdinf.AND.mpi%irank==0) WRITE (6,FMT=8002) l,&
......@@ -391,14 +387,14 @@ CONTAINS
IF (l_mcd) THEN
CALL mcd_init(&
atoms,input,dimension,&
vr(:,0,:,:),g,f,emcd_up,emcd_lo,n,jspin,&
vTot%mt(:,0,:,:),g,f,emcd_up,emcd_lo,n,jspin,&
ncore,e_mcd,m_mcd)
ncored = max(ncore(n),ncored)
END IF
IF(l_cs) CALL corespec_rme(atoms,input,n,dimension%nstd,&
input%jspins,jspin,results%ef,&
dimension%msh,vr(:,0,:,:),f,g)
dimension%msh,vTot%mt(:,0,:,:),f,g)
!
!---> generate the extra wavefunctions for the local orbitals,
......@@ -406,7 +402,7 @@ CONTAINS
!
IF ( atoms%nlo(n) > 0 ) THEN
DO ispin = jsp_start,jsp_end
CALL radflo(atoms,n,ispin, enpara%ello0(1,1,ispin),vr(:,0,n,ispin), f(1,1,0,ispin),&
CALL radflo(atoms,n,ispin, enpara%ello0(1,1,ispin),vTot%mt(:,0,n,ispin), f(1,1,0,ispin),&
g(1,1,0,ispin),mpi, usdus, uuilon,duilon,ulouilopn, flo(:,:,:,ispin))
END DO
END IF
......@@ -430,7 +426,7 @@ CONTAINS
'wronskian')
8002 FORMAT (i3,f10.5,2 (5x,1p,2e16.7,i5),1p,2e16.7)
IF (input%film) vz0(:) = vz(vacuum%nmz,:)
IF (input%film) vz0(:) = vTot%vacz(vacuum%nmz,:,jspin)
nsld=1
!+q_sl
IF ((banddos%ndir.EQ.-3).AND.banddos%dos) THEN
......@@ -573,7 +569,7 @@ CONTAINS
sym,atoms,vacuum,stars,ikpt,lapw%nv(jspin),&
input,jspin,kpts,&
cell,kpts%wtkpt(ikpt),lapw%k1(:,jspin),lapw%k2(:,jspin),&
enpara%evac0(1,jspin),vz,vz0,&
enpara%evac0(1,jspin),vTot%vacz(:,:,jspin),vz0,&
gvac1d,gvac2d)
END IF
......@@ -677,7 +673,7 @@ CONTAINS
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL timestart("cdnval: vacden")
CALL vacden(vacuum,dimension,stars,oneD, kpts,input, cell,atoms,noco,banddos,&
gvac1d,gvac2d, we,ikpt,jspin,vz,vz0, noccbd,lapw, enpara%evac0,eig,&
gvac1d,gvac2d, we,ikpt,jspin,vTot%vacz(:,:,jspin),vz0, noccbd,lapw, enpara%evac0,eig,&
den,qvac,qvlay, qstars,zMat)
CALL timestop("cdnval: vacden")
END IF
......@@ -940,7 +936,7 @@ CONTAINS
CALL cdnmt(&
dimension%jspd,atoms,sphhar,llpd,&
noco,l_fmpl,jsp_start,jsp_end,&
enpara%el0,enpara%ello0,vr(:,0,:,:),uu,du,dd,uunmt,udnmt,dunmt,ddnmt,&
enpara%el0,enpara%ello0,vTot%mt(:,0,:,:),uu,du,dd,uunmt,udnmt,dunmt,ddnmt,&
usdus,usdus%uloulopn,aclo,bclo,cclo,acnmt,bcnmt,ccnmt,&
orb,orbl,orblo,mt21,lo21,uloulopn21,uloulop21,&
uunmt21,ddnmt21,udnmt21,dunmt21,&
......@@ -953,7 +949,7 @@ CONTAINS
CALL mix_enpara(&
ispin,atoms,vacuum,obsolete,input,&
enpara,&
vr(:,0,:,:),vz,pvac(1,ispin),&
vTot%mt(:,0,:,:),vTot%vacz(:,:,jspin),pvac(1,ispin),&
svac(1,ispin),&
ener(0,1,ispin),sqal(0,1,ispin),&
enerlo(1,1,ispin),&
......@@ -967,54 +963,17 @@ CONTAINS
!---> check continuity of charge density
IF (input%cdinf) THEN
CALL timestart("cdnval: cdninf-stuff")
WRITE (6,FMT=8210) ispin
8210 FORMAT (/,5x,'check continuity of cdn for spin=',i2)
IF (input%film .AND. .NOT.oneD%odi%d1) THEN
!---> vacuum boundaries
npd = min(dimension%nspd,25)
CALL points(xp,npd)
DO ivac = 1,vacuum%nvac
sign = 3. - 2.*ivac
DO j = 1,npd
xp(3,j) = sign*cell%z1/cell%amat(3,3)
END DO
CALL checkdop(&
xp,npd,0,0,ivac,1,ispin,.true.,dimension,atoms,&
sphhar,stars,sym,&
vacuum,cell,oneD,&
den%pw,den%mt,den%vacxy,den%vacz)
END DO
ELSE IF (oneD%odi%d1) THEN
!-odim
npd = min(dimension%nspd,25)
CALL cylpts(xp,npd,cell%z1)
CALL checkdop(&
xp,npd,0,0,ivac,1,ispin,.true.,dimension,atoms,&
sphhar,stars,sym,&
vacuum,cell,oneD,&
den%pw,den%mt,den%vacxy,den%vacz)
!+odim
END IF
!---> m.t. boundaries
nat = 1
DO n = 1, atoms%ntype
CALL sphpts(xp,dimension%nspd,atoms%rmt(n),atoms%pos(1,atoms%nat))
CALL checkdop(&
xp,dimension%nspd,n,nat,0,-1,ispin,.true.,&
dimension,atoms,sphhar,stars,sym,&
vacuum,cell,oneD,&
den%pw,den%mt,den%vacxy,den%vacz)
nat = nat + atoms%neq(n)
END DO
CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,&
cell,den,ispin)
CALL timestop("cdnval: cdninf-stuff")
END IF
!+for
!---> forces of equ. A8 of Yu et al.
IF ((input%l_f)) THEN
CALL timestart("cdnval: force_a8")
CALL force_a8(input,atoms,sphhar, ispin, vr(:,:,:,ispin),den%mt,&
CALL force_a8(input,atoms,sphhar, ispin, vTot%mt(:,:,:,ispin),den%mt,&
f_a12,f_a21,f_b4,f_b8,results%force)
CALL timestop("cdnval: force_a8")
END IF
......
!--------------------------------------------------------------------------------
! Copyright (c) 2018 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_genNewNocoInp
CONTAINS
SUBROUTINE genNewNocoInp(input,atoms,jij,noco,noco_new)
USE m_juDFT
USE m_types
USE m_constants
USE m_rwnoco
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_noco),INTENT(INOUT) :: noco_new
INTEGER :: iAtom, iType
REAL :: alphdiff
IF (.NOT.noco%l_mperp) THEN
CALL juDFT_error ("genNewNocoInp without noco%l_mperp" ,calledby ="genNewNocoInp")
END IF
iAtom = 1
DO iType = 1, atoms%ntype
IF (noco%l_ss) THEN
alphdiff = 2.0*pi_const*(noco%qss(1)*atoms%taual(1,iAtom) + &
noco%qss(2)*atoms%taual(2,iAtom) + &
noco%qss(3)*atoms%taual(3,iAtom) )
noco_new%alph(iType) = noco%alph(iType) - alphdiff
DO WHILE (noco_new%alph(iType) > +pi_const)
noco_new%alph(iType)= noco_new%alph(iType) - 2.0*pi_const
END DO
DO WHILE (noco_new%alph(iType) < -pi_const)
noco_new%alph(iType)= noco_new%alph(iType) + 2.0*pi_const
END DO
ELSE
noco_new%alph(iType) = noco%alph(iType)
END IF
iatom= iatom + atoms%neq(iType)
END DO
OPEN (24,file='nocoinp',form='formatted', status='old')
REWIND (24)
CALL rw_noco_write(atoms,jij,noco_new, input)
CLOSE (24)
END SUBROUTINE genNewNocoInp
END MODULE m_genNewNocoInp
......@@ -9,6 +9,7 @@ cdn_mt/abcof.F90
cdn_mt/abcof3.F90
cdn_mt/abcrot2.f90
cdn_mt/cdnmt.f90
cdn_mt/cdncore.F90
cdn_mt/magMoms.f90
cdn_mt/orbMagMoms.f90
cdn_mt/orb_comp2.f90
......
!--------------------------------------------------------------------------------
! Copyright (c) 2018 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_cdncore
CONTAINS
SUBROUTINE cdncore(results,mpi,dimension,oneD,sliceplot,input,vacuum,noco,sym,&
stars,cell,sphhar,atoms,vTot,outDen,stdn,svdn)
USE m_constants
USE m_cdn_io
USE m_cdnovlp
USE m_cored
USE m_coredr
USE m_types
USE m_xmlOutput
USE m_magMoms
USE m_orbMagMoms
#ifdef CPP_MPI
USE m_mpi_bc_coreden
#endif
IMPLICIT NONE
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_sliceplot),INTENT(IN) :: sliceplot
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: vTot
TYPE(t_potden),INTENT(INOUT) :: outDen
REAL, INTENT(INOUT) :: stdn(atoms%ntype,dimension%jspd)
REAL, INTENT(INOUT) :: svdn(atoms%ntype,dimension%jspd)
INTEGER :: jspin, n, iType
REAL :: seig, rhoint, momint
LOGICAL, PARAMETER :: l_st=.FALSE.
REAL :: rh(dimension%msh,atoms%ntype,dimension%jspd)
REAL :: qint(atoms%ntype,dimension%jspd)
REAL :: tec(atoms%ntype,DIMENSION%jspd)
REAL :: rhTemp(dimension%msh,atoms%ntype,dimension%jspd)
results%seigc = 0.0
IF (mpi%irank.EQ.0) THEN
DO jspin = 1,input%jspins
DO n = 1,atoms%ntype
svdn(n,jspin) = outDen%mt(1,0,n,jspin) / (sfp_const*atoms%rmsh(1,n)*atoms%rmsh(1,n))
END DO
END DO
END IF
IF (input%kcrel.EQ.0) THEN
! Generate input file ecore for subsequent GW calculation
! 11.2.2004 Arno Schindlmayr
IF ((input%gw.eq.1 .or. input%gw.eq.3).AND.(mpi%irank.EQ.0)) THEN
OPEN (15,file='ecore',status='unknown', action='write',form='unformatted')
END IF
rh = 0.0
tec = 0.0
qint = 0.0
IF (input%frcor) THEN
IF (mpi%irank.EQ.0) THEN
CALL readCoreDensity(input,atoms,dimension,rh,tec,qint)
END IF
#ifdef CPP_MPI
CALL mpi_bc_coreDen(mpi,atoms,input,dimension,rh,tec,qint)
#endif
END IF
END IF
IF (.NOT.sliceplot%slice) THEN
!add in core density
IF (mpi%irank.EQ.0) THEN
IF (input%kcrel.EQ.0) THEN
DO jspin = 1,input%jspins
CALL cored(input,jspin,atoms,outDen%mt,dimension,sphhar,vTot%mt(:,0,:,jspin), qint,rh,tec,seig)
rhTemp(:,:,jspin) = rh(:,:,jspin)
results%seigc = results%seigc + seig
END DO
ELSE
CALL coredr(input,atoms,seig, outDen%mt,dimension,sphhar,vTot%mt(:,0,:,:),qint,rh)
results%seigc = results%seigc + seig
END IF
END IF
DO jspin = 1,input%jspins
IF (mpi%irank.EQ.0) THEN
DO n = 1,atoms%ntype
stdn(n,jspin) = outDen%mt(1,0,n,jspin) / (sfp_const*atoms%rmsh(1,n)*atoms%rmsh(1,n))
END DO
END IF
IF ((noco%l_noco).AND.(mpi%irank.EQ.0)) THEN
IF (jspin.EQ.2) THEN
!pk non-collinear (start)
!add the coretail-charge to the constant interstitial
!charge (star 0), taking into account the direction of
!magnetisation of this atom
DO iType = 1,atoms%ntype
rhoint = (qint(iType,1) + qint(iType,2)) /cell%volint/input%jspins/2.0
momint = (qint(iType,1) - qint(iType,2)) /cell%volint/input%jspins/2.0
!rho_11
outDen%pw(1,1) = outDen%pw(1,1) + rhoint + momint*cos(noco%beta(iType))
!rho_22
outDen%pw(1,2) = outDen%pw(1,2) + rhoint - momint*cos(noco%beta(iType))
!real part rho_21
outDen%pw(1,3) = outDen%pw(1,3) + cmplx(0.5*momint *cos(noco%alph(iType))*sin(noco%beta(iType)),0.0)
!imaginary part rho_21
outDen%pw(1,3) = outDen%pw(1,3) + cmplx(0.0,-0.5*momint *sin(noco%alph(iType))*sin(noco%beta(iType)))
END DO
!pk non-collinear (end)
END IF
ELSE
IF (input%ctail) THEN
!+gu hope this works as well
CALL cdnovlp(mpi,sphhar,stars,atoms,sym,dimension,vacuum,&
cell,input,oneD,l_st,jspin,rh(:,:,jspin),&
outDen%pw,outDen%vacxy,outDen%mt,outDen%vacz)
ELSE IF (mpi%irank.EQ.0) THEN
DO iType = 1,atoms%ntype
outDen%pw(1,jspin) = outDen%pw(1,jspin) + qint(iType,jspin)/input%jspins/cell%volint
END DO
END IF
END IF
END DO
END IF
IF (input%kcrel.EQ.0) THEN
IF (mpi%irank.EQ.0) THEN
CALL writeCoreDensity(input,atoms,dimension,rhTemp,tec,qint)
END IF
IF ((input%gw.eq.1 .or. input%gw.eq.3).AND.(mpi%irank.EQ.0)) CLOSE(15)
END IF
END SUBROUTINE cdncore
END MODULE m_cdncore
......@@ -20,6 +20,7 @@ global/savewigner.f
set(fleur_F90 ${fleur_F90}
global/constants.f90
global/checkdop.F90
global/checkdopall.f90
global/chkmt.f90
global/convn.f90
global/enpara.f90
......
MODULE m_checkdop
CONTAINS
SUBROUTINE checkdop(&
& p,np,n,na,ivac,iflag,jsp,cdn,&
& p,np,n,na,ivac,iflag,jsp,&
& DIMENSION,atoms,sphhar,stars,sym,&
& vacuum,cell,oneD,&
& fpw,fr,fxy,fz)
& vacuum,cell,oneD,potden)
! ************************************************************
! subroutines checks the continuity of coulomb *
! potential or valence charge density *
......@@ -14,6 +13,7 @@
! YM: this routine doesn't really work in the vacuum in 1D case yet
! ************************************************************
USE m_juDFT
USE m_starf, ONLY : starf2,starf3
USE m_angle
USE m_ylm
......@@ -23,32 +23,37 @@
IMPLICIT NONE
! ..
! .. Scalar Arguments ..
TYPE(t_dimension),INTENT(IN):: dimension
type(t_sphhar),intent(in):: sphhar
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_vacuum),INTENT(IN):: vacuum
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_dimension),INTENT(IN) :: dimension
type(t_sphhar),intent(in) :: sphhar
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden),INTENT(IN) :: potden
INTEGER, INTENT (IN) :: iflag,ivac,n,na,np,jsp
LOGICAL, INTENT (IN) :: cdn
INTEGER, INTENT (IN) :: iflag,ivac,n,na,np,jsp
!-odim
!+odim
! .. Array Arguments ..
REAL, INTENT (IN) :: p(3,DIMENSION%nspd)
REAL, INTENT (IN) :: fr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,DIMENSION%jspd),fz(vacuum%nmzd,2,DIMENSION%jspd)
COMPLEX, INTENT (IN) :: fpw(stars%ng3,DIMENSION%jspd),fxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,DIMENSION%jspd)
REAL, INTENT (IN) :: p(3,DIMENSION%nspd)
! ..
! .. Local Scalars ..
REAL av,dms,rms,s,ir2,help,phi
INTEGER i,j,k,lh,mem,nd,lm,ll1,nopa ,gz,m
COMPLEX ic
LOGICAL l_cdn
! ..
! .. Local Arrays ..
COMPLEX sf2(stars%ng2),sf3(stars%ng3),ylm( (atoms%lmaxd+1)**2 )
REAL rcc(3),v1(DIMENSION%nspd),v2(DIMENSION%nspd),x(3),ri(3)
l_cdn = .FALSE. ! By default we assume that the input is a potential.
IF (potden%potdenType.LE.0) CALL juDFT_error('unknown potden type', calledby='checkdop')
IF (potden%potdenType.GT.1000) l_cdn = .TRUE. ! potdenTypes > 1000 are reserved for densities
! ..
! ..
#ifdef __TOS_BGQ__
......@@ -75,11 +80,11 @@
ENDIF
v1(j) = 0.0
DO k = 1,stars%ng3
v1(j) = v1(j) + REAL(fpw(k,jsp)*sf3(k))*stars%nstr(k)
v1(j) = v1(j) + REAL(potden%pw(k,jsp)*sf3(k))*stars%nstr(k)
ENDDO
ENDDO
! ---> vacuum part
IF (cdn) THEN
IF (l_cdn) THEN
WRITE (6,FMT=9000) ivac
WRITE (16,FMT=9000) ivac
ELSE
......@@ -91,18 +96,18 @@
CALL starf2(&
& sym%nop2,stars%ng2,stars%kv2,sym%mrot,sym%symor,sym%tau,p(1,j),sym%invtab,&
& sf2)!keep
v2(j) = fz(1,ivac,jsp)
v2(j) = potden%vacz(1,ivac,jsp)
DO k = 2,stars%ng2
v2(j) = v2(j) + REAL(fxy(1,k-1,ivac,jsp)*sf2(k))*stars%nstr2(k)
v2(j) = v2(j) + REAL(potden%vacxy(1,k-1,ivac,jsp)*sf2(k))*stars%nstr2(k)
ENDDO
ELSE
!-odim
v2(j) = fz(1,ivac,jsp)
v2(j) = potden%vacz(1,ivac,jsp)
phi = angle(p(1,j),p(2,j))
DO k = 2,oneD%odi%nq2
m = oneD%odi%kv(2,k)
gz = oneD%odi%kv(1,k)
v2(j) = v2(j) + REAL(fxy(1,k-1,ivac,jsp)*&
v2(j) = v2(j) + REAL(potden%vacxy(1,k-1,ivac,jsp)*&
& EXP(ic*m*phi)*EXP(ic*cell%bmat(3,3)*gz*p(3,j)))*oneD%odi%nst2(k)
ENDDO
!+odim
......@@ -136,11 +141,11 @@
!
v1(j) = 0.0
DO k = 1,stars%ng3
v1(j) = v1(j) + REAL(fpw(k,jsp)*sf3(k))*stars%nstr(k)
v1(j) = v1(j) + REAL(potden%pw(k,jsp)*sf3(k))*stars%nstr(k)
ENDDO
ENDDO
! ----> m.t. part
IF (cdn) THEN
IF (l_cdn) THEN
WRITE (6,FMT=9010) n
WRITE (16,FMT=9010) n
ELSE
......@@ -148,7 +153,7 @@
WRITE (16,FMT=8010) n
ENDIF
ir2 = 1.0
IF (cdn) ir2 = 1.0 / ( atoms%rmt(n)*atoms%rmt(n) )
IF (l_cdn) ir2 = 1.0 / ( atoms%rmt(n)*atoms%rmt(n) )
nd = atoms%ntypsy(na)
nopa = atoms%ngopr(na)
IF (oneD%odi%d1) THEN
......@@ -190,7 +195,7 @@
lm = ll1 + sphhar%mlh(mem,lh,nd)
s = s + REAL( sphhar%clnu(mem,lh,nd)* ylm(lm) )
ENDDO
help = help + fr(atoms%jri(n),lh,n,jsp) * s
help = help + potden%mt(atoms%jri(n),lh,n,jsp) * s
ENDDO
v2(j) = help * ir2
IF (j.LE.8) THEN
......
!--------------------------------------------------------------------------------
! Copyright (c) 2018 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_checkdopall
CONTAINS
SUBROUTINE checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,&
cell,potden,ispin)
USE m_sphpts
USE m_checkdop
USE m_types
USE m_cylpts
USE m_points
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input