Commit 7a8c72a9 authored by Gregor Michalicek's avatar Gregor Michalicek

Initial commit of the electron configuration setup withing inp.xml.

Note that there are still bugs.
parent f6681e04
......@@ -95,7 +95,7 @@ CONTAINS
! rn = rmt(jatom)
dxx = atoms%dx(jatom)
bmu = 0.0
CALL setcor(jatom,DIMENSION%jspd,atoms,bmu,nst,kappa,nprnc,occ_h)
CALL setcor(jatom,DIMENSION%jspd,atoms,input,bmu,nst,kappa,nprnc,occ_h)
IF ((bmu > 99.)) THEN
occ(1:nst) = input%jspins * occ_h(1:nst,jspin)
ELSE
......
......@@ -73,7 +73,7 @@ CONTAINS
END DO
ELSE
OPEN (58,file='core.dat',form='formatted',status='new')
CALL etabinit(atoms,DIMENSION, vr, etab,ntab,ltab,nkmust)
CALL etabinit(atoms,DIMENSION,input, vr, etab,ntab,ltab,nkmust)
END IF
!
ncmsh = DIMENSION%msh
......
......@@ -7,7 +7,7 @@ MODULE m_etabinit
! ntab & ltab transport this info to core.F gb`02
!------------------------------------------------------------
CONTAINS
SUBROUTINE etabinit(atoms,DIMENSION, vr,&
SUBROUTINE etabinit(atoms,DIMENSION,input, vr,&
etab,ntab,ltab,nkmust)
USE m_constants, ONLY : c_light
......@@ -17,6 +17,7 @@ CONTAINS
IMPLICIT NONE
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_input),INTENT(IN) :: input
!
! .. Scalar Arguments ..
! ..
......@@ -47,7 +48,7 @@ CONTAINS
rn = atoms%rmt(jatom)
dxx = atoms%dx(jatom)
bmu = 0.0
CALL setcor(jatom,1,atoms,bmu,nst,kappa,nprnc,occ)
CALL setcor(jatom,1,atoms,input,bmu,nst,kappa,nprnc,occ)
rnot = atoms%rmsh(1,jatom)
d = EXP(atoms%dx(jatom))
rn = rnot* (d** (ncmsh-1))
......
MODULE m_setcor
USE m_juDFT
CONTAINS
SUBROUTINE setcor(itype,jspins,atoms,bmu,nst,kappa,nprnc,occ)
SUBROUTINE setcor(itype,jspins,atoms,input,bmu,nst,kappa,nprnc,occ)
!
! *****************************************************
! sets the values of kappa and occupation numbers of
......@@ -9,11 +9,10 @@ CONTAINS
! following code by m. weinert february 1982
! *****************************************************
USE m_types
USE m_types
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_input),INTENT(IN) :: input
!
! .. Scalar Arguments ..
INTEGER,INTENT (IN) :: itype,jspins
......@@ -24,9 +23,9 @@ CONTAINS
REAL,INTENT (OUT) :: occ(:,:)
! ..
! .. Local Scalars ..
INTEGER iz,jz,jz0,k,n,jspin
INTEGER iz,jz,jz0,k,n,m,i,jspin,tempInt
INTEGER k_h(2),n_h(2)
REAL fj,l,bmu_l,o_h(2), fac(2)
REAL fj,l,bmu_l,o_h(2), fac(2),tempReal
LOGICAL l_clf
CHARACTER(len=13) :: fname
! ..
......@@ -35,7 +34,7 @@ CONTAINS
WRITE(fname,"('corelevels.',i2.2)") NINT(atoms%zatom(itype))
INQUIRE (file=fname, exist=l_clf)
IF (l_clf) THEN
IF (l_clf.AND..NOT.input%l_inpXML) THEN
OPEN (61,file=fname,form='formatted')
READ (61,'(i3)') nst
IF (bmu.LT.0.001) bmu = 999.
......@@ -212,5 +211,33 @@ CONTAINS
ENDIF
ENDIF
! modify default electron configuration according to explicitely provided setting in inp.xml
IF(input%l_inpXML) THEN
nst = max(nst,atoms%numStatesProvided(itype))
DO n = 1, atoms%numStatesProvided(itype)
IF((nprnc(n).NE.atoms%coreStateNprnc(n,itype)).OR.(kappa(n).NE.atoms%coreStateKappa(n,itype))) THEN
m = 0
DO m = n, nst
IF((nprnc(m).EQ.atoms%coreStateNprnc(n,itype)).AND.(kappa(m).EQ.atoms%coreStateKappa(n,itype))) THEN
EXIT
END IF
END DO
DO i = m-1, n, -1
nprnc(i+1) = nprnc(i)
kappa(i+1) = kappa(i)
occ(i+1,:) = occ(i,:)
END DO
END IF
nprnc(n) = atoms%coreStateNprnc(n,itype)
kappa(n) = atoms%coreStateKappa(n,itype)
IF (jspins.EQ.1) THEN
occ(n,1) = atoms%coreStateOccs(n,1,itype) + atoms%coreStateOccs(n,2,itype)
ELSE
occ(n,1) = atoms%coreStateOccs(n,1,itype)
occ(n,2) = atoms%coreStateOccs(n,2,itype)
END IF
END DO
END IF
END SUBROUTINE setcor
END MODULE m_setcor
MODULE m_constants
IMPLICIT NONE
INTEGER,PARAMETER::noState_const = 0
INTEGER,PARAMETER::coreState_const = 1
INTEGER,PARAMETER::valenceState_const = 2
REAL,PARAMETER:: pi_const=3.1415926535897932
REAL,PARAMETER:: tpi_const=2.*3.1415926535897932
REAL,PARAMETER:: fpi_const=4.*3.1415926535897932
......
......@@ -191,8 +191,8 @@
INTEGER,ALLOCATABLE::jri(:)
!core states
INTEGER,ALLOCATABLE::ncst(:)
!Are core states explicitely provided?
LOGICAL,ALLOCATABLE::coreStatesProvided(:)
!How many states are explicitely provided?
INTEGER,ALLOCATABLE::numStatesProvided(:)
!core state occupations
REAL,ALLOCATABLE::coreStateOccs(:,:,:)
!core state nprnc
......
......@@ -58,7 +58,7 @@
DO n = 1,atoms%ntype
IF (atoms%zatom(n).GE.1.0) THEN
bmu = 0.0
CALL setcor(n,1,atoms,bmu, nst,kappa,nprnc,occ)
CALL setcor(n,1,atoms,input,bmu, nst,kappa,nprnc,occ)
DO nc=1,atoms%ncst(n)
qe=qe+atoms%neq(n)*occ(nc,1)
ENDDO
......
......@@ -12,7 +12,7 @@
SUBROUTINE atom_input(
> infh,xl_buffer,buffer,
> jspins,film,idlist,xmlCoreRefOccs,
X nline,xmlCoreStates,
X nline,xmlElectronStates,
X xmlPrintCoreStates,xmlCoreOccs,
< nel,atoms,enpara )
......@@ -20,7 +20,7 @@
USE m_juDFT_init
USE m_readrecord
USE m_setatomcore, ONLY : setatom_bystr, setcore_bystr
USE m_constants, ONLY : namat_const
USE m_constants
USE m_enpara, ONLY : w_enpara,default_enpara
IMPLICIT NONE
......@@ -38,7 +38,7 @@
REAL , INTENT (IN) :: idlist(atoms%ntype)
REAL , INTENT (IN) :: xmlCoreRefOccs(29)
REAL, INTENT (INOUT) :: xmlCoreOccs(2,29,atoms%ntype)
LOGICAL, INTENT (INOUT) :: xmlCoreStates(29,atoms%ntype)
INTEGER, INTENT (INOUT) :: xmlElectronStates(29,atoms%ntype)
LOGICAL, INTENT (INOUT) :: xmlPrintCoreStates(29,atoms%ntype)
CHARACTER(len=xl_buffer) :: buffer
......@@ -415,7 +415,7 @@
IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 25 !(7s1/2)
END SELECT
IF(xmlCoreStateNumber.EQ.0) STOP 'Invalid core state!'
xmlCoreStates(xmlCoreStateNumber,n) = .TRUE.
xmlElectronStates(xmlCoreStateNumber,n) = coreState_const
xmlPrintCoreStates(xmlCoreStateNumber,n) =
+ coreocc(i,n).NE.xmlCoreRefOccs(xmlCoreStateNumber)
SELECT CASE(xmlCoreStateNumber)
......@@ -465,6 +465,60 @@ c in s and p states equal occupation of up and down states
END IF
WRITE(27,'(4i3,i4,a1)') coreqn(1,i,n),coreqn(2,i,n),up,dn,
& coreqn(1,i,n),lotype(lval(i,n))
xmlCoreStateNumber = 0
SELECT CASE(coreqn(1,i,n))
CASE (1)
IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 1 !(1s1/2)
CASE (2)
IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 2 !(2s1/2)
IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 3 !(2p1/2)
IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 4 !(2p3/2)
CASE (3)
IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 5 !(3s1/2)
IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 6 !(3p1/2)
IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 7 !(3p3/2)
IF(coreqn(2,i,n).EQ.2) xmlCoreStateNumber = 9 !(3d3/2)
IF(coreqn(2,i,n).EQ.-3) xmlCoreStateNumber = 10 !(3d5/2)
CASE (4)
IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 8 !(4s1/2)
IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 11 !(4p1/2)
IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 12 !(4p3/2)
IF(coreqn(2,i,n).EQ.2) xmlCoreStateNumber = 14 !(4d3/2)
IF(coreqn(2,i,n).EQ.-3) xmlCoreStateNumber = 15 !(4d5/2)
IF(coreqn(2,i,n).EQ.3) xmlCoreStateNumber = 19 !(4f5/2)
IF(coreqn(2,i,n).EQ.-4) xmlCoreStateNumber = 20 !(4f7/2)
CASE (5)
IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 13 !(5s1/2)
IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 16 !(5p1/2)
IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 17 !(5p3/2)
IF(coreqn(2,i,n).EQ.2) xmlCoreStateNumber = 21 !(5d3/2)
IF(coreqn(2,i,n).EQ.-3) xmlCoreStateNumber = 22 !(5d5/2)
IF(coreqn(2,i,n).EQ.3) xmlCoreStateNumber = 26 !(5f5/2)
IF(coreqn(2,i,n).EQ.-4) xmlCoreStateNumber = 27 !(5f7/2)
CASE (6)
IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 18 !(6s1/2)
IF(coreqn(2,i,n).EQ.1) xmlCoreStateNumber = 23 !(6p1/2)
IF(coreqn(2,i,n).EQ.-2) xmlCoreStateNumber = 24 !(6p3/2)
IF(coreqn(2,i,n).EQ.2) xmlCoreStateNumber = 28 !(6d3/2)
IF(coreqn(2,i,n).EQ.-3) xmlCoreStateNumber = 29 !(6d5/2)
CASE (7)
IF(coreqn(2,i,n).EQ.-1) xmlCoreStateNumber = 25 !(7s1/2)
END SELECT
IF(xmlCoreStateNumber.EQ.0) STOP 'Invalid valence state!'
xmlElectronStates(xmlCoreStateNumber,n) = valenceState_const
xmlPrintCoreStates(xmlCoreStateNumber,n) =
+ coreocc(i,n).NE.xmlCoreRefOccs(xmlCoreStateNumber)
! SELECT CASE(xmlCoreStateNumber)
! CASE (9:10,14:15,19:22,26:29)
! up = MIN((xmlCoreRefOccs(xmlCoreStateNumber)/2),
! + coreocc(i,n))
! dn = MAX(0.0,coreocc(i,n)-up)
! CASE DEFAULT
! up = CEILING(coreocc(i,n)/2)
! dn = FLOOR(coreocc(i,n)/2)
! END SELECT
xmlCoreOccs(1,xmlCoreStateNumber,n) = up
xmlCoreOccs(2,xmlCoreStateNumber,n) = dn
ENDDO
WRITE (6,*) '----------'
......
......@@ -60,6 +60,8 @@ PROGRAM inpgen
dispfn='disp'
nline = 0
input%l_inpXML = .FALSE.
ALLOCATE ( mmrot(3,3,nop48), ttr(3,nop48) )
ALLOCATE ( atompos(3,natmax),atomid(natmax) )
......
......@@ -88,7 +88,7 @@
INTEGER :: nkpt3(3)
!HF
LOGICAL :: xmlCoreStates(29,atoms%ntype)
INTEGER :: xmlElectronStates(29,atoms%ntype)
LOGICAL :: xmlPrintCoreStates(29,atoms%ntype)
REAL :: xmlCoreOccs(2,29,atoms%ntype)
REAL :: xmlCoreRefOccs(29)
......@@ -102,7 +102,7 @@
DATA xmlCoreRefOccs /2,2,2,4,2,2,4,2,4,6,2,4,2,4,6,2,4,2,6,8,4,&
& 6,2,4,2,6,8,4,6/
xmlCoreStates = .FALSE.
xmlElectronStates = noState_const
xmlPrintCoreStates = .FALSE.
xmlCoreOccs = 0.0
......@@ -216,7 +216,7 @@
& infh,xl_buffer,buffer,&
& input%jspins,input%film,idlist,xmlCoreRefOccs,&
& nline,&
& xmlCoreStates,xmlPrintCoreStates,xmlCoreOccs,&
& xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
& nel,atoms,enpara)
DO n = 1, atoms%ntype
......@@ -421,7 +421,7 @@
& atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,div,l_gamma,&
& noel,namex,relcor,a1,a2,a3,scale,dtild,name,&
& xmlCoreStates,xmlPrintCoreStates,xmlCoreOccs,&
& xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
& atomTypeSpecies,speciesRepAtomType,&
& enpara%el0(:,:,1),enpara%ello0(:,:,1),enpara%evac0(:,1))
......
......@@ -116,7 +116,7 @@ SUBROUTINE r_inpXML(&
INTEGER :: numberNodes, nodeSum, numSpecies, n2spg, n1, n2, ikpt, iqpt
INTEGER :: atomicNumber, coreStates, gridPoints, lmax, lnonsphr, lmaxAPW
INTEGER :: latticeDef, symmetryDef, nop48, firstAtomOfType
INTEGER :: loEDeriv, ntp1, ios, ntst, jrc, minNeigd, providedCoreStates
INTEGER :: loEDeriv, ntp1, ios, ntst, jrc, minNeigd, providedCoreStates, providedStates
INTEGER :: nv, nv2, kq1, kq2, kq3, nprncTemp, kappaTemp
INTEGER :: ldau_l
INTEGER :: speciesEParams(0:3)
......@@ -227,7 +227,7 @@ SUBROUTINE r_inpXML(&
ALLOCATE(atoms%taual(3,atoms%nat))
ALLOCATE(atoms%pos(3,atoms%nat))
ALLOCATE(atoms%rmt(atoms%ntype))
ALLOCATE(atoms%coreStatesProvided(atoms%ntype))
ALLOCATE(atoms%numStatesProvided(atoms%ntype))
ALLOCATE(atoms%ncv(atoms%ntype)) ! For what is this?
ALLOCATE(atoms%ngopr(atoms%nat)) ! For what is this?
......@@ -1128,7 +1128,7 @@ SUBROUTINE r_inpXML(&
ALLOCATE (speciesNames(numSpecies), speciesNLO(numSpecies))
atoms%coreStatesProvided = .FALSE.
atoms%numStatesProvided = 0
DO iSpecies = 1, numSpecies
! Attributes of species
......@@ -1242,8 +1242,7 @@ SUBROUTINE r_inpXML(&
ALLOCATE(atoms%l_dulo(atoms%nlod,atoms%ntype)) ! For what is this?
enpara%lchange = .FALSE.
dimension%nstd = maxval(atoms%ncst(:))
dimension%nstd = max(dimension%nstd,30)
dimension%nstd = 29
ALLOCATE(atoms%coreStateOccs(dimension%nstd,2,atoms%ntype))
ALLOCATE(atoms%coreStateNprnc(dimension%nstd,atoms%ntype))
......@@ -1265,12 +1264,13 @@ SUBROUTINE r_inpXML(&
coreConfigPresent = .FALSE.
providedCoreStates = 0
providedStates = 0
coreStateOccs = 0.0
WRITE(xPathA,*) '/fleurInput/atomSpecies/species[',iSpecies,']/coreConfig'
WRITE(xPathA,*) '/fleurInput/atomSpecies/species[',iSpecies,']/electronConfig'
numberNodes = xmlGetNumberOfNodes(TRIM(ADJUSTL(xPathA)))
IF (numberNodes.EQ.1) THEN
coreConfigPresent = .TRUE.
valueString = xmlGetAttributeValue(TRIM(ADJUSTL(xPathA)))
valueString = xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/coreConfig')
token = popFirstStringToken(valueString)
DO WHILE (token.NE.' ')
WRITE(*,*) TRIM(ADJUSTL(token))
......@@ -1303,11 +1303,31 @@ SUBROUTINE r_inpXML(&
END IF
token = popFirstStringToken(valueString)
END DO
numberNodes = xmlGetNumberOfNodes(TRIM(ADJUSTL(xPathA))//'/valenceConfig')
providedStates = providedCoreStates
IF(numberNodes.EQ.1) THEN
valueString = xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/valenceConfig')
token = popFirstStringToken(valueString)
DO WHILE (token.NE.' ')
DO i = 1, 29
IF (TRIM(ADJUSTL(token)).EQ.coreStateList(i)) THEN
providedStates = providedStates + 1
IF (providedStates.GT.29) THEN
STOP 'Error: Too many valence states provided in xml input file!'
END IF
coreStateOccs(providedStates,:) = coreStateNumElecsList(i)
coreStateNprnc(providedStates) = coreStateNprncList(i)
coreStateKappa(providedStates) = coreStateKappaList(i)
END IF
END DO
token = popFirstStringToken(valueString)
END DO
END IF
END IF
! Explicitely provided core occupations
WRITE(xPathA,*) '/fleurInput/atomSpecies/species[',iSpecies,']/coreStateOccupation'
WRITE(xPathA,*) '/fleurInput/atomSpecies/species[',iSpecies,']/electronConfig/stateOccupation'
numberNodes = xmlGetNumberOfNodes(TRIM(ADJUSTL(xPathA)))
IF (numberNodes.GE.1) THEN
IF (.NOT.coreConfigPresent) THEN
......@@ -1325,7 +1345,7 @@ SUBROUTINE r_inpXML(&
kappaTemp = coreStateKappaList(j)
END IF
END DO
DO j = 1, providedCoreStates
DO j = 1, providedStates
IF ((nprncTemp.EQ.coreStateNprnc(j)).AND.(kappaTemp.EQ.coreStateKappa(j))) THEN
coreStateOccs(j,1) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathB))//'/@spinUp'))
coreStateOccs(j,2) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathB))//'/@spinDown'))
......@@ -1372,15 +1392,15 @@ SUBROUTINE r_inpXML(&
WRITE(xPathA,*) '/fleurInput/atomGroups/atomGroup[',iType,']/@species'
valueString = TRIM(ADJUSTL(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA)))))
IF(TRIM(ADJUSTL(speciesNames(iSpecies))).EQ.TRIM(ADJUSTL(valueString))) THEN
atoms%coreStatesProvided(iType) = coreConfigPresent
atoms%numStatesProvided(iType) = providedStates
IF (coreConfigPresent) THEN
IF (providedCoreStates.LT.atoms%ncst(iType)) THEN
IF (providedCoreStates.NE.atoms%ncst(iType)) THEN
WRITE(*,*) 'species', TRIM(ADJUSTL(speciesNames(iSpecies)))
WRITE(*,*) 'providedCoreStates: ', providedCoreStates
WRITE(*,*) 'ncst: ', atoms%ncst(iType)
STOP 'Not enough core states provided!'
STOP 'Wrong number of core states provided!'
END IF
DO k = 1, atoms%ncst(iType)
DO k = 1, providedStates !atoms%ncst(iType)
atoms%coreStateOccs(k,1,iType) = coreStateOccs(k,1)
atoms%coreStateOccs(k,2,iType) = coreStateOccs(k,2)
atoms%coreStateNprnc(k,iType) = coreStateNprnc(k)
......
......@@ -14,12 +14,13 @@ SUBROUTINE w_inpXML(&
& atoms,obsolete,vacuum,input,stars,sliceplot,banddos,&
& cell,sym,xcpot,noco,jij,oneD,hybrid,kpts,div,l_gamma,&
& noel,namex,relcor,a1,a2,a3,scale,dtild_opt,name_opt,&
& xmlCoreStates,xmlPrintCoreStates,xmlCoreOccs,&
& xmlElectronStates,xmlPrintCoreStates,xmlCoreOccs,&
& atomTypeSpecies,speciesRepAtomType,&
& el0,ello0,evac0)
USE m_types
USE m_juDFT_init
USE m_constants
IMPLICIT NONE
......@@ -47,7 +48,7 @@ SUBROUTINE w_inpXML(&
REAL, INTENT (IN) :: a1(3),a2(3),a3(3),scale
REAL, INTENT (IN) :: el0(0:3,atoms%ntype),ello0(atoms%nlod,atoms%ntype),evac0(2)
REAL, INTENT (IN) :: xmlCoreOccs(2,29,atoms%ntype)
LOGICAL, INTENT (IN) :: xmlCoreStates(29,atoms%ntype)
INTEGER, INTENT (IN) :: xmlElectronStates(29,atoms%ntype)
LOGICAL, INTENT (IN) :: xmlPrintCoreStates(29,atoms%ntype)
CHARACTER(len=3),INTENT(IN) :: noel(atoms%ntypd)
CHARACTER(len=4),INTENT(IN) :: namex
......@@ -102,7 +103,7 @@ SUBROUTINE w_inpXML(&
LOGICAL :: kptGamma, l_relcor
INTEGER :: iAtomType, startCoreStates, endCoreStates
CHARACTER(len=100) :: xPosString, yPosString, zPosString
CHARACTER(len=200) :: coreStatesString
CHARACTER(len=200) :: coreStatesString, valenceStatesString
REAL :: tempTaual(3,atoms%nat)
REAL :: a1Temp(3),a2Temp(3),a3Temp(3)
REAL :: amatTemp(3,3), bmatTemp(3,3)
......@@ -406,63 +407,73 @@ SUBROUTINE w_inpXML(&
IF (ALL((el0(0:3,iAtomType)-INT(el0(0:3,iAtomType))).LE.0.00000001)) THEN
! <energyParameters s="3" p="3" d="3" f="4"/>
322 FORMAT(' <energyParameters s="',i0,'" p="',i0,'" d="',i0,'" f="',i0,'"/>')
WRITE (5,322) INT(el0(0,iAtomType)),INT(el0(1,iAtomType)),INT(el0(2,iAtomType)),INT(el0(3,iAtomType))
321 FORMAT(' <energyParameters s="',i0,'" p="',i0,'" d="',i0,'" f="',i0,'"/>')
WRITE (5,321) INT(el0(0,iAtomType)),INT(el0(1,iAtomType)),INT(el0(2,iAtomType)),INT(el0(3,iAtomType))
END IF
IF(ANY(xmlCoreStates(:,iAtomType))) THEN
IF(ANY(xmlElectronStates(:,iAtomType).NE.noState_const)) THEN
endCoreStates = 1
startCoreStates = 1
coreStatesString = ''
valenceStatesString = ''
DO i = 1, 29
IF (xmlCoreStates(i,iAtomType)) endCoreStates = i
IF (xmlElectronStates(i,iAtomType).EQ.coreState_const) endCoreStates = i
END DO
IF ((endCoreStates.GE.24).AND.&
& (ALL(xmlPrintCoreStates(1:24,iAtomType).EQ..FALSE.)).AND.&
& (ALL(xmlCoreStates(1:24,iAtomType))) ) THEN
& (ALL(xmlElectronStates(1:24,iAtomType).EQ.coreState_const)) ) THEN
coreStatesString = nobleGasConfigList(6)
startCoreStates = 25
ELSE IF ((endCoreStates.GE.17).AND.&
& (ALL(xmlPrintCoreStates(1:17,iAtomType).EQ..FALSE.)).AND.&
& (ALL(xmlCoreStates(1:17,iAtomType)))) THEN
& (ALL(xmlElectronStates(1:17,iAtomType).EQ.coreState_const))) THEN
coreStatesString = nobleGasConfigList(5)
startCoreStates = 18
ELSE IF ((endCoreStates.GE.12).AND.&
& (ALL(xmlPrintCoreStates(1:12,iAtomType).EQ..FALSE.)).AND.&
& (ALL(xmlCoreStates(1:12,iAtomType)))) THEN
& (ALL(xmlElectronStates(1:12,iAtomType).EQ.coreState_const))) THEN
coreStatesString = nobleGasConfigList(4)
startCoreStates = 13
ELSE IF ((endCoreStates.GE.7).AND.&
& (ALL(xmlPrintCoreStates(1:7,iAtomType).EQ..FALSE.)).AND.&
& (ALL(xmlCoreStates(1:7,iAtomType)))) THEN
& (ALL(xmlElectronStates(1:7,iAtomType).EQ.coreState_const))) THEN
coreStatesString = nobleGasConfigList(3)
startCoreStates = 8
ELSE IF ((endCoreStates.GE.4).AND.&
& (ALL(xmlPrintCoreStates(1:4,iAtomType).EQ..FALSE.)).AND.&
& (ALL(xmlCoreStates(1:4,iAtomType)))) THEN
& (ALL(xmlElectronStates(1:4,iAtomType).EQ.coreState_const))) THEN
coreStatesString = nobleGasConfigList(2)
startCoreStates = 5
ELSE IF ((endCoreStates.GE.1).AND.&
& (ALL(xmlPrintCoreStates(1:1,iAtomType).EQ..FALSE.)).AND.&
& (ALL(xmlCoreStates(1:1,iAtomType)))) THEN
& (ALL(xmlElectronStates(1:1,iAtomType).EQ.coreState_const))) THEN
coreStatesString = nobleGasConfigList(1)
startCoreStates = 2
END IF
DO i = startCoreStates, endCoreStates
IF(xmlCoreStates(i,iAtomType)) THEN
IF(xmlElectronStates(i,iAtomType).EQ.coreState_const) THEN
coreStatesString = TRIM(ADJUSTL(coreStatesString)) // ' ' // coreStateList(i)
END IF
END DO
DO i = 1, 29
IF(xmlElectronStates(i,iAtomType).EQ.valenceState_const) THEN
valenceStatesString = TRIM(ADJUSTL(valenceStatesString)) // ' ' // coreStateList(i)
END IF
END DO
WRITE (5,'(a)') ' <electronConfig>'
! <coreConfig>[He] (2s1/2) (2p1/2) (2p3/2)</coreConfig>
323 FORMAT(' <coreConfig>',a,'</coreConfig>')
WRITE(5,323) TRIM(ADJUSTL(coreStatesString))
DO i = startCoreStates, endCoreStates
IF ((xmlCoreStates(i,iAtomType)).AND.(xmlPrintCoreStates(i,iAtomType))) THEN
322 FORMAT(' <coreConfig>',a,'</coreConfig>')
WRITE(5,322) TRIM(ADJUSTL(coreStatesString))
323 FORMAT(' <valenceConfig>',a,'</valenceConfig>')
WRITE(5,323) TRIM(ADJUSTL(valenceStatesString))
DO i = startCoreStates, 29
IF ((xmlElectronStates(i,iAtomType).NE.noState_const).AND.(xmlPrintCoreStates(i,iAtomType))) THEN
! <coreStateOccupation state="(2s1/2)" spinUp="1.0" spinDown="1.0"/>
325 FORMAT(' <coreStateOccupation state="',a,'" spinUp="',f0.8,'" spinDown="',f0.8,'"/>')
325 FORMAT(' <stateOccupation state="',a,'" spinUp="',f0.8,'" spinDown="',f0.8,'"/>')
WRITE(5,325) coreStateList(i), xmlCoreOccs(1,i,iAtomType), xmlCoreOccs(2,i,iAtomType)
END IF
END DO
WRITE (5,'(a)') ' </electronConfig>'
END IF
DO ilo = 1, atoms%nlo(iAtomType)
......
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -158,7 +158,7 @@
ALLOCATE ( enpara%enmix(dimension%jspd),sym%d_wgn(-3:3,-3:3,3,sym%nop) )
ALLOCATE ( atoms%ulo_der(atoms%nlod,atoms%ntypd) )
ALLOCATE ( noco%soc_opt(atoms%ntypd+2) )
ALLOCATE ( atoms%coreStatesProvided(atoms%ntypd))
ALLOCATE ( atoms%numStatesProvided(atoms%ntypd))
!+odim
ALLOCATE ( oneD%ig1(-oneD%odd%k3:oneD%odd%k3,-oneD%odd%M:oneD%odd%M) )
ALLOCATE ( oneD%kv1(2,oneD%odd%n2d),oneD%nstr1(oneD%odd%n2d) )
......@@ -176,7 +176,7 @@
hybrid%ddist = 1.
!
atoms%coreStatesProvided(:) = .FALSE.
atoms%numStatesProvided(:) = 0
atoms%vr0(:) = 0.0
jij%M(:) = 0.0
......
......@@ -73,7 +73,7 @@
enddo
rn = rad(n)
bmu_l = atoms%bmu(ntyp)
CALL setcor(ntyp,input%jspins,atoms,bmu_l, nst,kappa,nprnc,occ)
CALL setcor(ntyp,input%jspins,atoms,input,bmu_l, nst,kappa,nprnc,occ)
!
!---> for electric field case (sigma.ne.0), add the extra charge
......
......@@ -57,7 +57,7 @@ CONTAINS
ncore(itype) = 0
bmu = 0.0
CALL setcor(itype,1,atoms,bmu, nst,kappa,nprnc,occ)
CALL setcor(itype,1,atoms,input,bmu, nst,kappa,nprnc,occ)
DO ispin = jspin, jspin
......
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