IffGit has a new shared runner for building Docker images in GitLab CI. Visit https://iffgit.fz-juelich.de/examples/ci-docker-in-docker for more details.

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

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)