Commit 14aa0f3a authored by Daniel Wortmann's avatar Daniel Wortmann

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

parents c4f64811 fe07424d
...@@ -4,11 +4,8 @@ ...@@ -4,11 +4,8 @@
! vacuum, and mt regions c.l.fu ! vacuum, and mt regions c.l.fu
! ******************************************************** ! ********************************************************
CONTAINS CONTAINS
SUBROUTINE cdntot(& SUBROUTINE cdntot(stars,atoms,sym,vacuum,input,cell,oneD,&
& stars,atoms,sym,& den,l_printData,qtot,qistot)
& vacuum,input,cell,oneD,&
& qpw,rho,rht,l_printData,&
& qtot,qistot)
USE m_intgr, ONLY : intgr3 USE m_intgr, ONLY : intgr3
USE m_constants USE m_constants
...@@ -19,27 +16,20 @@ ...@@ -19,27 +16,20 @@
USE m_convol USE m_convol
USE m_xmlOutput USE m_xmlOutput
IMPLICIT NONE IMPLICIT NONE
! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_vacuum),INTENT(IN):: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
LOGICAL,INTENT(IN) :: l_printData TYPE(t_potden),INTENT(IN) :: den
REAL, INTENT (OUT):: qtot,qistot LOGICAL,INTENT(IN) :: l_printData
! .. REAL,INTENT(OUT) :: qtot,qistot
! .. Array Arguments ..
COMPLEX, INTENT (IN) :: qpw(stars%ng3,input%jspins)
REAL, INTENT (IN) :: rho(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT (IN) :: rht(vacuum%nmzd,2,input%jspins)
!-odim
!+odim
! ..
! .. Local Scalars .. ! .. Local Scalars ..
! COMPLEX x
COMPLEX x(stars%ng3) COMPLEX x(stars%ng3)
REAL q,qis,w,mtCharge REAL q,qis,w,mtCharge
INTEGER i,ivac,j,jspin,n,nz INTEGER i,ivac,j,jspin,n,nz
...@@ -66,7 +56,7 @@ ...@@ -66,7 +56,7 @@
! -----mt charge ! -----mt charge
CALL timestart("MT") CALL timestart("MT")
DO 10 n = 1,atoms%ntype DO 10 n = 1,atoms%ntype
CALL intgr3(rho(:,0,n,jspin),atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),w) CALL intgr3(den%mt(:,0,n,jspin),atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),w)
qmt(n) = w*sfp_const qmt(n) = w*sfp_const
q = q + atoms%neq(n)*qmt(n) q = q + atoms%neq(n)*qmt(n)
10 CONTINUE 10 CONTINUE
...@@ -77,9 +67,9 @@ ...@@ -77,9 +67,9 @@
DO nz = 1,vacuum%nmz DO nz = 1,vacuum%nmz
IF (oneD%odi%d1) THEN IF (oneD%odi%d1) THEN
rht1(nz,ivac,jspin) = (cell%z1+(nz-1)*vacuum%delz)*& rht1(nz,ivac,jspin) = (cell%z1+(nz-1)*vacuum%delz)*&
& rht(nz,ivac,jspin) & den%vacz(nz,ivac,jspin)
ELSE ELSE
rht1(nz,ivac,jspin) = rht(nz,ivac,jspin) rht1(nz,ivac,jspin) = den%vacz(nz,ivac,jspin)
END IF END IF
END DO END DO
CALL qsf(vacuum%delz,rht1(1,ivac,jspin),q2,vacuum%nmz,0) CALL qsf(vacuum%delz,rht1(1,ivac,jspin),q2,vacuum%nmz,0)
...@@ -93,7 +83,7 @@ ...@@ -93,7 +83,7 @@
END IF END IF
! -----is region ! -----is region
IF (.not.judft_was_Argument("-oldfix")) THEN IF (.not.judft_was_Argument("-oldfix")) THEN
CALL convol(stars,x,qpw(:,jspin),stars%ufft) CALL convol(stars,x,den%pw(:,jspin),stars%ufft)
qis = x(1)*cell%omtil qis = x(1)*cell%omtil
ELSE ELSE
qis = 0. qis = 0.
...@@ -104,14 +94,14 @@ ...@@ -104,14 +94,14 @@
! > symor,tau,mrot,rmt,sk3,bmat,ig2,ig, ! > symor,tau,mrot,rmt,sk3,bmat,ig2,ig,
! > kv3(1,j), ! > kv3(1,j),
! < x) ! < x)
! qis = qis + qpw(j,jspin)*x*nstr(j) ! qis = qis + den%pw(j,jspin)*x*nstr(j)
! 30 CONTINUE ! 30 CONTINUE
CALL pwint_all(& CALL pwint_all(&
& stars,atoms,sym,oneD,& & stars,atoms,sym,oneD,&
& cell,& & cell,&
& x) & x)
DO j = 1,stars%ng3 DO j = 1,stars%ng3
qis = qis + qpw(j,jspin)*x(j)*stars%nstr(j) qis = qis + den%pw(j,jspin)*x(j)*stars%nstr(j)
ENDDO ENDDO
endif endif
qistot = qistot + qis qistot = qistot + qis
......
...@@ -980,6 +980,16 @@ CONTAINS ...@@ -980,6 +980,16 @@ CONTAINS
!-for !-for
END DO ! end of loop ispin = jsp_start,jsp_end END DO ! end of loop ispin = jsp_start,jsp_end
CALL closeXMLElement('mtCharges') CALL closeXMLElement('mtCharges')
IF(vacuum%nvac.EQ.1) THEN
den%vacz(:,2,:) = den%vacz(:,1,:)
IF (sym%invs) THEN
den%vacxy(:,:,2,:) = CONJG(den%vacxy(:,:,1,:))
ELSE
den%vacxy(:,:,2,:) = den%vacxy(:,:,1,:)
END IF
END IF
END IF ! end of (mpi%irank==0) END IF ! end of (mpi%irank==0)
!+t3e !+t3e
!Note: no deallocation anymore, we rely on Fortran08 :-) !Note: no deallocation anymore, we rely on Fortran08 :-)
...@@ -988,5 +998,6 @@ CONTAINS ...@@ -988,5 +998,6 @@ CONTAINS
IF ((banddos%dos.OR.banddos%vacdos).AND.(banddos%ndir/=-2)) CALL juDFT_end("DOS OK",mpi%irank) IF ((banddos%dos.OR.banddos%vacdos).AND.(banddos%ndir/=-2)) CALL juDFT_end("DOS OK",mpi%irank)
IF (vacuum%nstm.EQ.3) CALL juDFT_end("VACWAVE OK",mpi%irank) IF (vacuum%nstm.EQ.3) CALL juDFT_end("VACWAVE OK",mpi%irank)
END IF END IF
END SUBROUTINE cdnval END SUBROUTINE cdnval
END MODULE m_cdnval END MODULE m_cdnval
...@@ -8,7 +8,7 @@ MODULE m_magMoms ...@@ -8,7 +8,7 @@ MODULE m_magMoms
CONTAINS CONTAINS
SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,chmom,qa21) SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,stdn,svdn,chmom,qa21)
USE m_types USE m_types
USE m_xmlOutput USE m_xmlOutput
...@@ -24,11 +24,28 @@ SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,chmom,qa21) ...@@ -24,11 +24,28 @@ SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,chmom,qa21)
REAL, INTENT(INOUT) :: chmom(atoms%ntype,dimension%jspd) REAL, INTENT(INOUT) :: chmom(atoms%ntype,dimension%jspd)
COMPLEX, INTENT(IN) :: qa21(atoms%ntype) COMPLEX, INTENT(IN) :: qa21(atoms%ntype)
REAL, INTENT(IN) :: stdn(atoms%ntype,dimension%jspd)
REAL, INTENT(IN) :: svdn(atoms%ntype,dimension%jspd)
INTEGER :: iType, j, iRepAtom INTEGER :: iType, j, iRepAtom
REAL :: smom REAL :: sval,stot,scor,smom
CHARACTER(LEN=20) :: attributes(4) CHARACTER(LEN=20) :: attributes(4)
WRITE (6,FMT=8000)
WRITE (16,FMT=8000)
DO iType = 1,atoms%ntype
sval = svdn(iType,1) - svdn(iType,input%jspins)
stot = stdn(iType,1) - stdn(iType,input%jspins)
scor = stot - sval
WRITE (6,FMT=8010) iType,stot,sval,scor,svdn(iType,1),stdn(iType,1)
WRITE (16,FMT=8010) iType,stot,sval,scor,svdn(iType,1),stdn(iType,1)
END DO
8000 FORMAT (/,/,10x,'spin density at the nucleus:',/,10x,'type',t25,&
'input%total',t42,'valence',t65,'core',t90,&
'majority valence and input%total density',/)
8010 FORMAT (i13,2x,3e20.8,5x,2e20.8)
WRITE (6,FMT=8020) WRITE (6,FMT=8020)
WRITE (16,FMT=8020) WRITE (16,FMT=8020)
......
...@@ -11,8 +11,8 @@ MODULE m_qfix ...@@ -11,8 +11,8 @@ MODULE m_qfix
! qfix file no longer supported! ! qfix file no longer supported!
CONTAINS CONTAINS
SUBROUTINE qfix( stars,atoms,sym,vacuum,& SUBROUTINE qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,&
sphhar,input,cell,oneD,den,l_printData,force_fix,fix) den,l_noco,l_printData,force_fix,fix)
USE m_types USE m_types
USE m_cdntot USE m_cdntot
...@@ -29,7 +29,7 @@ CONTAINS ...@@ -29,7 +29,7 @@ CONTAINS
TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden),INTENT(INOUT) :: den TYPE(t_potden),INTENT(INOUT) :: den
LOGICAL,INTENT(IN) :: l_printData,force_fix LOGICAL,INTENT(IN) :: l_noco,l_printData,force_fix
REAL, INTENT (OUT) :: fix REAL, INTENT (OUT) :: fix
! .. Local Scalars .. ! .. Local Scalars ..
...@@ -51,14 +51,12 @@ CONTAINS ...@@ -51,14 +51,12 @@ CONTAINS
! qfix==0 means no qfix was given in inp.xml. ! qfix==0 means no qfix was given in inp.xml.
! In this case do nothing except when forced to fix! ! In this case do nothing except when forced to fix!
CALL cdntot( stars,atoms,sym, vacuum,input,cell,oneD,& CALL cdntot(stars,atoms,sym,vacuum,input,cell,oneD,den,.TRUE.,qtot,qis)
den%pw,den%mt,den%vacz,.TRUE., qtot,qis)
!The total nucleii charge !The total nucleii charge
zc=SUM(atoms%neq(:)*atoms%zatom(:)) zc=SUM(atoms%neq(:)*atoms%zatom(:))
zc = zc + 2*input%efield%sigma zc = zc + 2*input%efield%sigma
IF (fixtotal) THEN IF (fixtotal) THEN
!-roa !-roa
fix = zc/qtot fix = zc/qtot
...@@ -76,23 +74,27 @@ CONTAINS ...@@ -76,23 +74,27 @@ CONTAINS
den%vacxy(:vacuum%nmzxy,:oneD%odi%nq2-1,:vacuum%nvac,:) den%vacxy(:vacuum%nmzxy,:oneD%odi%nq2-1,:vacuum%nvac,:)
END IF END IF
WRITE (6,FMT=8000) zc,fix WRITE (6,FMT=8000) zc,fix
IF (ABS(fix-1.0)<1.E-6) RETURN !no second calculation of cdntot as nothing was fixed
CALL openXMLElementNoAttributes('fixedCharges')
CALL cdntot( stars,atoms,sym, vacuum,input,cell,oneD,&
den%pw,den%mt,den%vacz,l_printData, qtot,qis)
CALL closeXMLElement('fixedCharges')
!+roa
ELSE ELSE
fix = (zc - qtot) / qis + 1. fix = (zc - qtot) / qis + 1.
den%pw(:stars%ng3,:) = fix*den%pw(:stars%ng3,:) den%pw(:stars%ng3,:) = fix*den%pw(:stars%ng3,:)
WRITE (6,FMT=8001) zc,fix WRITE (6,FMT=8001) zc,fix
IF (ABS(fix-1.0)<1.E-6) RETURN !no second calculation of cdntot as nothing was fixed
CALL openXMLElementNoAttributes('fixedCharges')
CALL cdntot( stars,atoms,sym, vacuum,input,cell,oneD,&
den%pw,den%mt,den%vacz,l_printData, qtot,qis)
CALL closeXMLElement('fixedCharges')
ENDIF ENDIF
IF (l_noco) THEN
!fix also the off-diagonal part of the density matrix
den%pw(:stars%ng3,3) = fix*den%pw(:stars%ng3,3)
IF (input%film.AND.fixtotal) THEN
den%vacz(:,:,3:4) = fix*den%vacz(:,:,3:4)
den%vacxy(:,:,:,3) = fix*den%vacxy(:,:,:,3)
END IF
END IF
IF (ABS(fix-1.0)<1.E-6) RETURN !no second calculation of cdntot as nothing was fixed
CALL openXMLElementNoAttributes('fixedCharges')
CALL cdntot(stars,atoms,sym,vacuum,input,cell,oneD,den,l_printData,qtot,qis)
CALL closeXMLElement('fixedCharges')
IF (fix>1.1) CALL juDFT_WARN("You lost too much charge") IF (fix>1.1) CALL juDFT_WARN("You lost too much charge")
IF (fix<.9) CALL juDFT_WARN("You gained too much charge") IF (fix<.9) CALL juDFT_WARN("You gained too much charge")
......
...@@ -70,19 +70,19 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ...@@ -70,19 +70,19 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
TYPE(t_noco) :: noco_new TYPE(t_noco) :: noco_new
!Local Scalars !Local Scalars
REAL fix,qtot,scor,stot,sval,dummy REAL fix,qtot,dummy
INTEGER ivac,j,jspin,jspmax,k,iType INTEGER jspin,jspmax
LOGICAL l_enpara LOGICAL l_enpara
!Local Arrays !Local Arrays
REAL stdn(atoms%ntype,dimension%jspd),svdn(atoms%ntype,dimension%jspd),alpha_l(atoms%ntype) REAL stdn(atoms%ntype,dimension%jspd),svdn(atoms%ntype,dimension%jspd)
REAL chmom(atoms%ntype,dimension%jspd),clmom(3,atoms%ntype,dimension%jspd) REAL chmom(atoms%ntype,dimension%jspd),clmom(3,atoms%ntype,dimension%jspd)
INTEGER,ALLOCATABLE :: igq_fft(:) INTEGER,ALLOCATABLE :: igq_fft(:)
REAL ,ALLOCATABLE :: qvac(:,:,:,:),qvlay(:,:,:,:,:) REAL ,ALLOCATABLE :: qvac(:,:,:,:),qvlay(:,:,:,:,:)
!pk non-collinear (start) !pk non-collinear (start)
INTEGER igq2_fft(0:stars%kq1_fft*stars%kq2_fft-1) INTEGER igq2_fft(0:stars%kq1_fft*stars%kq2_fft-1)
COMPLEX,ALLOCATABLE :: qa21(:), cdomvz(:,:) COMPLEX,ALLOCATABLE :: qa21(:)
!pk non-collinear (end) !pk non-collinear (end)
IF (mpi%irank.EQ.0) THEN IF (mpi%irank.EQ.0) THEN
...@@ -117,88 +117,49 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ...@@ -117,88 +117,49 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
DO jspin = 1,jspmax DO jspin = 1,jspmax
CALL timestart("cdngen: cdnval") CALL timestart("cdngen: cdnval")
CALL cdnval(eig_id,& CALL cdnval(eig_id,&
mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atoms,enpara,stars, vacuum,dimension,& mpi,kpts,jspin,sliceplot,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,obsolete,igq_fft,vTot,oneD,coreSpecInput,& sphhar,sym,obsolete,igq_fft,vTot,oneD,coreSpecInput,&
outDen,results,qvac,qvlay,qa21, chmom,clmom) outDen,results,qvac,qvlay,qa21,chmom,clmom)
CALL timestop("cdngen: cdnval") CALL timestop("cdngen: cdnval")
END DO END DO
IF (mpi%irank.EQ.0) THEN IF (mpi%irank.EQ.0) THEN
IF (l_enpara) CLOSE (40) IF (l_enpara) CLOSE (40)
CALL cdntot(stars,atoms,sym, vacuum,input,cell,oneD, outDen%pw,outDen%mt,outDen%vacz,.TRUE., qtot,dummy) CALL cdntot(stars,atoms,sym, vacuum,input,cell,oneD,outDen,.TRUE.,qtot,dummy)
CALL closeXMLElement('valenceDensity') CALL closeXMLElement('valenceDensity')
END IF ! mpi%irank = 0 END IF ! mpi%irank = 0
CALL cdncore(results,mpi,dimension,oneD,sliceplot,input,vacuum,noco,sym,& CALL cdncore(results,mpi,dimension,oneD,sliceplot,input,vacuum,noco,sym,&
stars,cell,sphhar,atoms,vTot,outDen,stdn,svdn) stars,cell,sphhar,atoms,vTot,outDen,stdn,svdn)
IF (mpi%irank.EQ.0) THEN IF (sliceplot%slice) THEN
!block 2 unnecessary for slicing: begin IF (mpi%irank.EQ.0) THEN
IF (.NOT.sliceplot%slice) THEN
CALL openXMLElementNoAttributes('allElectronCharges')
CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD,outDen,.TRUE.,.true.,fix)
CALL closeXMLElement('allElectronCharges')
!pk non-collinear (start)
IF (noco%l_noco) THEN
!fix also the off-diagonal part of the density matrix
outDen%pw(:stars%ng3,3) = fix*outDen%pw(:stars%ng3,3)
IF (input%film) THEN
outDen%vacz(:,:,3:4) = fix*outDen%vacz(:,:,3:4)
outDen%vacxy(:,:,:,3) = fix*outDen%vacxy(:,:,:,3)
END IF
END IF
!pk non-collinear (end)
!spin densities at the nucleus
!and magnetic moment in the spheres
IF (input%jspins.EQ.2) THEN
WRITE (6,FMT=8000)
WRITE (16,FMT=8000)
DO iType = 1,atoms%ntype
sval = svdn(iType,1) - svdn(iType,input%jspins)
stot = stdn(iType,1) - stdn(iType,input%jspins)
scor = stot - sval
WRITE (6,FMT=8010) iType,stot,sval,scor,svdn(iType,1),stdn(iType,1)
WRITE (16,FMT=8010) iType,stot,sval,scor,svdn(iType,1),stdn(iType,1)
END DO
noco_new = noco
CALL magMoms(dimension,input,atoms,noco_new,vTot,chmom,qa21)
!Generate and save the new nocoinp file if the directions of the local
!moments are relaxed or a constraint B-field is calculated.
IF (ANY(noco%l_relax(:atoms%ntype)).OR.noco%l_constr) THEN
CALL genNewNocoInp(input,atoms,jij,noco,noco_new)
END IF
IF (noco%l_soc) CALL orbMagMoms(dimension,atoms,noco,clmom)
END IF
!block 2 unnecessary for slicing: end
END IF ! .NOT.sliceplot%slice
8000 FORMAT (/,/,10x,'spin density at the nucleus:',/,10x,'type',t25,&
'input%total',t42,'valence',t65,'core',t90,&
'majority valence and input%total density',/)
8010 FORMAT (i13,2x,3e20.8,5x,2e20.8)
IF(vacuum%nvac.EQ.1) THEN
outDen%vacz(:,2,:) = outDen%vacz(:,1,:)
IF (sym%invs) THEN
outDen%vacxy(:,:,2,:) = CONJG(outDen%vacxy(:,:,1,:))
ELSE
outDen%vacxy(:,:,2,:) = outDen%vacxy(:,:,1,:)
END IF
END IF
IF (sliceplot%slice) THEN
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,& CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
1,-1.0,0.0,.FALSE.,outDen,'cdn_slice') 1,-1.0,0.0,.FALSE.,outDen,'cdn_slice')
END IF END IF
CALL juDFT_end("slice OK",mpi%irank)
END IF
ENDIF ! mpi%irank.EQ.0 IF (mpi%irank.EQ.0) THEN
CALL openXMLElementNoAttributes('allElectronCharges')
CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,outDen,noco%l_noco,.TRUE.,.true.,fix)
CALL closeXMLElement('allElectronCharges')
IF (sliceplot%slice) CALL juDFT_end("slice OK",mpi%irank) IF (input%jspins.EQ.2) THEN
noco_new = noco
!Calculate and write out spin densities at the nucleus and magnetic moments in the spheres
CALL magMoms(dimension,input,atoms,noco_new,vTot,stdn,svdn,chmom,qa21)
!Generate and save the new nocoinp file if the directions of the local
!moments are relaxed or a constraint B-field is calculated.
IF (ANY(noco%l_relax(:atoms%ntype)).OR.noco%l_constr) THEN
CALL genNewNocoInp(input,atoms,jij,noco,noco_new)
END IF
IF (noco%l_soc) CALL orbMagMoms(dimension,atoms,noco,clmom)
END IF
END IF ! mpi%irank.EQ.0
#ifdef CPP_MPI #ifdef CPP_MPI
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,outDen) CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,outDen)
...@@ -207,8 +168,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ...@@ -207,8 +168,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
DEALLOCATE (qvac,qvlay,qa21) DEALLOCATE (qvac,qvlay,qa21)
DEALLOCATE (igq_fft) DEALLOCATE (igq_fft)
RETURN
END SUBROUTINE cdngen END SUBROUTINE cdngen
END MODULE m_cdngen END MODULE m_cdngen
...@@ -184,7 +184,7 @@ CONTAINS ...@@ -184,7 +184,7 @@ CONTAINS
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,& CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,fermiEnergyTemp,l_qfix,inDen) 0,fermiEnergyTemp,l_qfix,inDen)
CALL timestart("Qfix") CALL timestart("Qfix")
CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD,inDen,.FALSE.,.false.,fix) CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD,inDen,noco%l_noco,.FALSE.,.false.,fix)
CALL timestop("Qfix") CALL timestop("Qfix")
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,& CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,-1.0,0.0,.FALSE.,inDen) 0,-1.0,0.0,.FALSE.,inDen)
......
...@@ -243,7 +243,7 @@ SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,& ...@@ -243,7 +243,7 @@ SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,&
CALL closeXMLElement('densityConvergence') CALL closeXMLElement('densityConvergence')
!fix charge of the new density !fix charge of the new density
CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD,inDen,.FALSE.,.false., fix) CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD,inDen,noco%l_noco,.FALSE.,.false., fix)
IF(atoms%n_u.NE.n_u_keep) THEN IF(atoms%n_u.NE.n_u_keep) THEN
inDen%mmpMat = n_mmpTemp inDen%mmpMat = n_mmpTemp
......
...@@ -153,7 +153,7 @@ SUBROUTINE pldngen(sym,stars,atoms,sphhar,vacuum,& ...@@ -153,7 +153,7 @@ SUBROUTINE pldngen(sym,stars,atoms,sphhar,vacuum,&
den%vacz(:,:,4) = AIMAG(cdomvz(:,:)) den%vacz(:,:,4) = AIMAG(cdomvz(:,:))
den%vacxy(:,:,:,3) = cdomvxy den%vacxy(:,:,:,3) = cdomvxy
END IF END IF
CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,den,.FALSE.,.true.,fix) CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,den,noco%l_noco,.FALSE.,.true.,fix)
rho(:,0:,1:,:input%jspins) = den%mt(:,0:,1:,:input%jspins) rho(:,0:,1:,:input%jspins) = den%mt(:,0:,1:,:input%jspins)
qpw(1:,:input%jspins) = den%pw(1:,:input%jspins) qpw(1:,:input%jspins) = den%pw(1:,:input%jspins)
rht(1:,1:,:input%jspins) = den%vacz(1:,1:,:input%jspins) rht(1:,1:,:input%jspins) = den%vacz(1:,1:,:input%jspins)
......
...@@ -204,7 +204,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& ...@@ -204,7 +204,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
IF (mpi%irank == 0) THEN IF (mpi%irank == 0) THEN
! Check the normalization of total density ! Check the normalization of total density
CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,den,.FALSE.,.true.,fix) CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,den,.FALSE.,.FALSE.,.true.,fix)
z=SUM(atoms%neq(:)*atoms%zatom(:)) z=SUM(atoms%neq(:)*atoms%zatom(:))
IF (ABS(fix*z-z)>0.5) THEN IF (ABS(fix*z-z)>0.5) THEN
CALL judft_warn("Starting density not charge neutral",hint= & CALL judft_warn("Starting density not charge neutral",hint= &
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment