Commit a991918f authored by Daniel Wortmann's avatar Daniel Wortmann

Changed qfix behaviour:

- do not use qfix file anymore
- do not run qfix if it is not specified in inp.xml
Fixes #96
parent b0b3033f
MODULE m_qfix
MODULE m_qfix
USE m_juDFT
! *******************************************************
! check total charge and renormalize c,l.fu
! *******************************************************
CONTAINS
SUBROUTINE qfix(&
& stars,atoms,sym,vacuum,&
& sphhar,input,cell,oneD,&
& qpw,rhtxy,rho,rht,l_printData,&
& fix)
!Calculate total charge
!Depending on variable input%qfix, the following will be done to fix the charge
!Input qfix can be 1 or 2
! qfix=0 (no qfix in inp.xml) means we usually do not run the code
! if force_fix is .true. we run the code and assume qfix=2
! in the call to qfix we will always run it
! qfix=1 (qfix=f in inp.xml) means we fix only in INT (only done in firstcall)
! qfix=2 (qfix=t in inp.xml) means we fix total charge
! qfix file no longer supported!
CONTAINS
SUBROUTINE qfix( stars,atoms,sym,vacuum,&
sphhar,input,cell,oneD,qpw,rhtxy,rho,rht,l_printData,force_fix,fix)
USE m_types
USE m_cdntot
IMPLICIT NONE
! ..
! .. Scalar Arguments ..
! ..
! .. Scalar Arguments ..
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
......@@ -23,99 +27,70 @@
TYPE(t_input),INTENT(IN) :: input
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell
LOGICAL,INTENT(IN) :: l_printData
LOGICAL,INTENT(IN) :: l_printData,force_fix
REAL, INTENT (OUT) :: fix
!-odim
!+odim
! ..
! .. Array Arguments ..
! ..
! .. Array Arguments ..
COMPLEX,INTENT (INOUT) :: qpw(stars%ng3,input%jspins)
COMPLEX,INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,input%jspins)
REAL, INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2,input%jspins)
! ..
! .. Local Scalars ..
LOGICAL fixtot,l99
REAL qtot,qis,zc
INTEGER ivac,j,jm,jspin,k,lh,n,nl,ns,na
! ..
CALL cdntot(&
& stars,atoms,sym,&
& vacuum,input,cell,oneD,&
& qpw,rho,rht,.FALSE.,&
& qtot,qis)
zc = 0.
DO 10 n = 1,atoms%ntype
zc = zc + atoms%neq(n)*atoms%zatom(n)
10 CONTINUE
!+roa (check via qfix file if total charge or only interstitial to fix)
fixtot=.TRUE.
INQUIRE(file='qfix',exist=l99)
IF (l99) then
OPEN (99,file='qfix',status='old',form='formatted')
READ (99,'(1x,l1)',end=1199) fixtot
IF (.NOT.fixtot ) THEN
REWIND (99)
WRITE (99,'(1x,l1,70a)') .TRUE.,&
& ' (1x,l1) F..fix interstitial T..fix total charge '
ENDIF
1199 CLOSE (99)
! ..
! .. Local Scalars ..
LOGICAL :: l_qfixfile,fixtotal
LOGICAL :: l_firstcall=.true.
REAL :: qtot,qis,zc
INTEGER :: jm,lh,n,na
! ..
fixtotal=.true. !this is the default
fix=1.0
if (l_firstcall) THEN
INQUIRE(file='qfix',exist=l_qfixfile)
IF (l_qfixfile) CALL judft_info("qfix file no longer supported, check the qfix option in inp.xml","INFO")
if (input%qfix==1) fixtotal=.false.
l_firstcall=.false.
ELSE
IF (input%qfix==0.AND..NOT.force_fix) RETURN
ENDIF
! qfix==0 means no qfix was given in inp.xml.
! In this case do nothing except when forced to fix!
CALL cdntot( stars,atoms,sym, vacuum,input,cell,oneD,&
qpw,rho,rht,.FALSE., qtot,qis)
!The total nucleii charge
zc=SUM(atoms%neq(:)*atoms%zatom(:))
zc = zc + 2*input%efield%sigma
IF ( fixtot ) THEN
!-roa
IF (fixtotal) THEN
!-roa
fix = zc/qtot
DO 100 jspin = 1,input%jspins
na = 1
DO 40 n = 1,atoms%ntype
ns = atoms%ntypsy(na)
lh = sphhar%nlh(ns)
DO n = 1,atoms%ntype
lh = sphhar%nlh(atoms%ntypsy(na))
jm = atoms%jri(n)
DO 30 nl = 0,lh
DO 20 j = 1,jm
rho(j,nl,n,jspin) = fix*rho(j,nl,n,jspin)
20 CONTINUE
30 CONTINUE
rho(:jm,0:lh,n,:) = fix*rho(:jm,0:lh,n,:)
na = na + atoms%neq(n)
40 CONTINUE
DO 50 k = 1,stars%ng3
qpw(k,jspin) = fix*qpw(k,jspin)
50 CONTINUE
ENDDO
qpw(:stars%ng3,:) = fix*qpw(:stars%ng3,:)
IF (input%film) THEN
DO 90 ivac = 1,vacuum%nvac
DO 60 n = 1,vacuum%nmz
rht(n,ivac,jspin) = fix*rht(n,ivac,jspin)
60 CONTINUE
DO 80 n = 1,vacuum%nmzxy
DO 70 k = 2,oneD%odi%nq2
rhtxy(n,k-1,ivac,jspin) = fix*&
& rhtxy(n,k-1,ivac,jspin)
70 CONTINUE
80 CONTINUE
90 CONTINUE
rht(:vacuum%nmz,:vacuum%nvac,:) = fix*rht(:vacuum%nmz,:vacuum%nvac,:)
rhtxy(:vacuum%nmzxy,:oneD%odi%nq2-1,:vacuum%nvac,:) = fix*&
rhtxy(:vacuum%nmzxy,:oneD%odi%nq2-1,:vacuum%nvac,:)
END IF
100 CONTINUE
WRITE (6,FMT=8000) zc,fix
CALL cdntot(&
& stars,atoms,sym,&
& vacuum,input,cell,oneD,&
& qpw,rho,rht,l_printData,&
& qtot,qis)
!+roa
IF (ABS(fix-1.0)<1.E-6) RETURN !no second calculation of cdntot as nothing was fixed
CALL cdntot( stars,atoms,sym, vacuum,input,cell,oneD,&
qpw,rho,rht,l_printData, qtot,qis)
!+roa
ELSE
fix = (zc - qtot) / qis + 1.
DO jspin = 1,input%jspins
DO k = 1,stars%ng3
qpw(k,jspin) = fix*qpw(k,jspin)
ENDDO
ENDDO
qpw(:stars%ng3,:) = fix*qpw(:stars%ng3,:)
WRITE (6,FMT=8001) zc,fix
CALL cdntot(&
& stars,atoms,sym,&
& vacuum,input,cell,oneD,&
& qpw,rho,rht,l_printData,&
& qtot,qis)
IF (ABS(fix-1.0)<1.E-6) RETURN !no second calculation of cdntot as nothing was fixed
CALL cdntot( stars,atoms,sym, vacuum,input,cell,oneD,&
qpw,rho,rht,l_printData, qtot,qis)
ENDIF
......@@ -123,9 +98,9 @@
IF (fix<.9) CALL juDFT_WARN("You gained too much charge")
8000 FORMAT (/,10x,'zc= ',f12.6,5x,'qfix= ',f10.6)
8001 FORMAT (/,' > broy only qis: ','zc= ',f12.6,5x,'qfix= ',f10.6)
!-roa
8000 FORMAT (/,10x,'zc= ',f12.6,5x,'qfix= ',f10.6)
8001 FORMAT (/,' > broy only qis: ','zc= ',f12.6,5x,'qfix= ',f10.6)
!-roa
END SUBROUTINE qfix
END MODULE m_qfix
END MODULE m_qfix
......@@ -98,6 +98,8 @@
!--------------------------------------------------------------------
OPEN (5,file='inp',form='formatted',status='old')
!default not read in in old inp-file
input%qfix=2
!
a1(:) = 0
a2(:) = 0
......
......@@ -345,7 +345,7 @@
! block 2 unnecessary for slicing: begin
IF (.NOT.sliceplot%slice) THEN
CALL openXMLElementNoAttributes('allElectronCharges')
CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD, qpw,rhtxy,rho,rht,.TRUE., fix)
CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD, qpw,rhtxy,rho,rht,.TRUE.,.true., fix)
CALL closeXMLElement('allElectronCharges')
!---> pk non-collinear
IF (noco%l_noco) THEN
......
......@@ -302,7 +302,7 @@ CONTAINS
!
! ---> fix the new density
CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD,&
qpw,rhtxy,rho,rht,.FALSE., fix)
qpw,rhtxy,rho,rht,.FALSE.,.false., fix)
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
1,results%last_distance,results%ef,.TRUE.,iter,rho,qpw,rht,rhtxy,cdom,cdomvz,cdomvxy)
......
......@@ -164,7 +164,7 @@ CONTAINS
IF (.NOT.l_xyav) THEN
CALL timestart("Qfix")
CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD, qpw,rhtxy,rho,rht,.FALSE., fix)
CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD, qpw,rhtxy,rho,rht,.FALSE.,.false., fix)
CALL timestop("Qfix")
ENDIF
......
......@@ -155,7 +155,7 @@
CALL qfix(&
& stars,atoms,sym,vacuum,&
& sphhar,input,cell,oneD,&
& qpw,rhtxy,rho,rht,.FALSE.,&
& qpw,rhtxy,rho,rht,.FALSE.,.true.,&
& fix)
ENDIF
......
......@@ -237,7 +237,7 @@
CALL qfix(&
& stars,atoms,sym,vacuum,&
& sphhar,input,cell,oneD,&
& qpw,rhtxy,rho,rht,.FALSE.,&
& qpw,rhtxy,rho,rht,.FALSE.,.true.,&
& fix)
!
! Write superposed density onto density file
......
......@@ -122,7 +122,7 @@ CONTAINS
CALL qfix(&
& stars,atoms,sym,vacuum,&
& sphhar,input,cell,oneD,&
& qpw,rhtxy,rho,rht,.FALSE.,&
& qpw,rhtxy,rho,rht,.FALSE.,.FALSE.,&
& fix)
!---> fouriertransform the diagonal part of the density matrix
......
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