Commit 9f4f2bc1 authored by Gregor Michalicek's avatar Gregor Michalicek

Moved some arrays with constants to global/constants.f

parent c73d242d
......@@ -18,8 +18,8 @@
REAL, PARAMETER :: eVac0Default_const = -0.25
CHARACTER(len=9), PARAMETER :: version_const = 'fleur 27'
CHARACTER(2),DIMENSION(0:103),PARAMETER:: namat_const=(/
& 'va',' H','He','Li','Be',' B',' C',' N',' O',' F','Ne',
CHARACTER(2),DIMENSION(0:103),PARAMETER :: namat_const=(/
& 'va',' H','He','Li','Be',' B',' C',' N',' O',' F','Ne',
& 'Na','Mg','Al','Si',' P',' S','Cl','Ar',' K','Ca','Sc','Ti',
& ' V','Cr','Mn','Fe','Co','Ni','Cu','Zn','Ga','Ge','As','Se',
& 'Br','Kr','Rb','Sr',' Y','Zr','Nb','Mo','Tc','Ru','Rh','Pd',
......@@ -29,6 +29,31 @@
& 'Bi','Po','At','Rn','Fr','Ra','Ac','Th','Pa',' U','Np','Pu',
& 'Am','Cm','Bk','Cf','Es','Fm','Md','No','Lw'/)
CHARACTER(7),DIMENSION(29),PARAMETER :: coreStateList_const=(/
+ '(1s1/2)','(2s1/2)','(2p1/2)','(2p3/2)','(3s1/2)',
+ '(3p1/2)','(3p3/2)','(3d3/2)','(3d5/2)','(4s1/2)',
+ '(4p1/2)','(4p3/2)','(5s1/2)','(4d3/2)','(4d5/2)',
+ '(5p1/2)','(5p3/2)','(6s1/2)','(4f5/2)','(4f7/2)',
+ '(5d3/2)','(5d5/2)','(6p1/2)','(6p3/2)','(7s1/2)',
+ '(5f5/2)','(5f7/2)','(6d3/2)','(6d5/2)' /)
INTEGER,DIMENSION(29),PARAMETER :: coreStateNumElecsList_const=(/ ! This is the number of electrons per spin
+ 1, 1, 1, 2, 1, 1, 2, 2, 3, 1, 1, 2, 1, 2,
+ 3, 1, 2, 1, 3, 4, 2, 3, 1, 2, 1, 3, 4, 2, 3/)
INTEGER,DIMENSION(29),PARAMETER :: coreStateNprncList_const=(/
+ 1, 2, 2, 2, 3, 3, 3, 3, 3, 4, 4, 4, 5, 4, 4,
+ 5, 5, 6, 4, 4, 5, 5, 6, 6, 7, 5, 5, 6, 6/)
INTEGER,DIMENSION(29),PARAMETER :: coreStateKappaList_const=(/
+ -1,-1, 1,-2,-1, 1,-2, 2,-3,-1, 1,-2,-1, 2,-3,
+ 1,-2,-1, 3,-4, 2,-3, 1,-2,-1, 3,-4, 2,-3/)
CHARACTER(4),DIMENSION(6),PARAMETER :: nobleGasConfigList_const=(/
+ '[He]','[Ne]','[Ar]','[Kr]','[Xe]','[Rn]'/)
INTEGER,DIMENSION(6),PARAMETER :: nobleGasNumStatesList_const=(/
+ 1, 4, 7, 12, 17, 24/)
CONTAINS
!------------------------------------------------------------------------
REAL PURE FUNCTION pimach()
......
......@@ -107,12 +107,6 @@ SUBROUTINE r_inpXML(&
CHARACTER(len=100) :: xPosString, yPosString, zPosString
CHARACTER(len=200) :: coreStatesString
! REAL :: tempTaual(3,atoms%nat)
CHARACTER(len=7) :: coreStateList(29) !'(1s1/2)'
CHARACTER(len=4) :: nobleGasConfigList(6) !'[He]'
INTEGER :: nobleGasNumStatesList(6)
REAL :: coreStateNumElecsList(29) !(per spin)
INTEGER :: coreStateNprncList(29)
INTEGER :: coreStateKappaList(29)
REAL :: coreStateOccs(29,2)
INTEGER :: coreStateNprnc(29), coreStateKappa(29)
INTEGER :: speciesXMLElectronStates(29)
......@@ -180,23 +174,6 @@ SUBROUTINE r_inpXML(&
schemaFilename = "FleurInputSchema.xsd"//C_NULL_CHAR
docFilename = "inp.xml"//C_NULL_CHAR
DATA coreStateList / '(1s1/2)','(2s1/2)','(2p1/2)','(2p3/2)','(3s1/2)',&
& '(3p1/2)','(3p3/2)','(3d3/2)','(3d5/2)','(4s1/2)',&
& '(4p1/2)','(4p3/2)','(5s1/2)','(4d3/2)','(4d5/2)',&
& '(5p1/2)','(5p3/2)','(6s1/2)','(4f5/2)','(4f7/2)',&
& '(5d3/2)','(5d5/2)','(6p1/2)','(6p3/2)','(7s1/2)',&
& '(5f5/2)','(5f7/2)','(6d3/2)','(6d5/2)' /
DATA nobleGasConfigList / '[He]','[Ne]','[Ar]','[Kr]','[Xe]','[Rn]' /
DATA nobleGasNumStatesList / 1, 4, 7, 12, 17, 24 /
DATA coreStateNumElecsList / 1, 1, 1, 2, 1, 1, 2, 2, 3, 1, 1, 2, 1, 2,&
& 3, 1, 2, 1, 3, 4, 2, 3, 1, 2, 1, 3, 4, 2, 3 /
DATA coreStateNprncList / 1, 2, 2, 2, 3, 3, 3, 3, 3, 4, 4, 4, 5, 4, 4,&
& 5, 5, 6, 4, 4, 5, 5, 6, 6, 7, 5, 5, 6, 6 /
DATA coreStateKappaList /-1,-1, 1,-2,-1, 1,-2, 2,-3,-1, 1,-2,-1, 2,-3,&
& 1,-2,-1, 3,-4, 2,-3, 1,-2,-1, 3,-4, 2,-3 /
!TODO! these switches should be in the inp-file
input%l_core_confpot=.true. !former CPP_CORE
input%l_useapw=.false. !former CPP_APW
......@@ -1400,29 +1377,29 @@ SUBROUTINE r_inpXML(&
DO WHILE (token.NE.' ')
IF (token(1:1).EQ.'[') THEN
DO i = 1, 6
IF (TRIM(ADJUSTL(token)).EQ.nobleGasConfigList(i)) THEN
IF (providedCoreStates+nobleGasNumStatesList(i).GT.29) THEN
IF (TRIM(ADJUSTL(token)).EQ.nobleGasConfigList_const(i)) THEN
IF (providedCoreStates+nobleGasNumStatesList_const(i).GT.29) THEN
STOP 'Error: Too many core states provided in xml input file!'
END IF
DO j = providedCoreStates+1, providedCoreStates+nobleGasNumStatesList(i)
coreStateOccs(j-providedCoreStates,:) = coreStateNumElecsList(j)
coreStateNprnc(j-providedCoreStates) = coreStateNprncList(j)
coreStateKappa(j-providedCoreStates) = coreStateKappaList(j)
DO j = providedCoreStates+1, providedCoreStates+nobleGasNumStatesList_const(i)
coreStateOccs(j-providedCoreStates,:) = coreStateNumElecsList_const(j)
coreStateNprnc(j-providedCoreStates) = coreStateNprncList_const(j)
coreStateKappa(j-providedCoreStates) = coreStateKappaList_const(j)
speciesXMLElectronStates(j) = coreState_const
END DO
providedCoreStates = providedCoreStates + nobleGasNumStatesList(i)
providedCoreStates = providedCoreStates + nobleGasNumStatesList_const(i)
END IF
END DO
ELSE
DO i = 1, 29
IF (TRIM(ADJUSTL(token)).EQ.coreStateList(i)) THEN
IF (TRIM(ADJUSTL(token)).EQ.coreStateList_const(i)) THEN
providedCoreStates = providedCoreStates + 1
IF (providedCoreStates.GT.29) THEN
STOP 'Error: Too many core states provided in xml input file!'
END IF
coreStateOccs(providedCoreStates,:) = coreStateNumElecsList(i)
coreStateNprnc(providedCoreStates) = coreStateNprncList(i)
coreStateKappa(providedCoreStates) = coreStateKappaList(i)
coreStateOccs(providedCoreStates,:) = coreStateNumElecsList_const(i)
coreStateNprnc(providedCoreStates) = coreStateNprncList_const(i)
coreStateKappa(providedCoreStates) = coreStateKappaList_const(i)
speciesXMLElectronStates(i) = coreState_const
END IF
END DO
......@@ -1436,14 +1413,14 @@ SUBROUTINE r_inpXML(&
token = popFirstStringToken(valueString)
DO WHILE (token.NE.' ')
DO i = 1, 29
IF (TRIM(ADJUSTL(token)).EQ.coreStateList(i)) THEN
IF (TRIM(ADJUSTL(token)).EQ.coreStateList_const(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)
coreStateOccs(providedStates,:) = coreStateNumElecsList_const(i)
coreStateNprnc(providedStates) = coreStateNprncList_const(i)
coreStateKappa(providedStates) = coreStateKappaList_const(i)
speciesXMLElectronStates(i) = valenceState_const
END IF
END DO
......@@ -1467,9 +1444,9 @@ SUBROUTINE r_inpXML(&
nprncTemp = 0
kappaTemp = 0
DO j = 1, 29
IF (TRIM(ADJUSTL(valueString)).EQ.coreStateList(j)) THEN
nprncTemp = coreStateNprncList(j)
kappaTemp = coreStateKappaList(j)
IF (TRIM(ADJUSTL(valueString)).EQ.coreStateList_const(j)) THEN
nprncTemp = coreStateNprncList_const(j)
kappaTemp = coreStateKappaList_const(j)
speciesXMLPrintCoreStates(j) = .TRUE.
speciesXMLCoreOccs(1,j) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathB))//'/@spinUp'))
speciesXMLCoreOccs(2,j) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathB))//'/@spinDown'))
......
......@@ -118,17 +118,6 @@ SUBROUTINE w_inpXML(&
REAL :: tempTaual(3,atoms%nat), scpos(3)
REAL :: a1Temp(3),a2Temp(3),a3Temp(3)
REAL :: amatTemp(3,3), bmatTemp(3,3)
CHARACTER(len=7) :: coreStateList(29) !'(1s1/2)'
CHARACTER(len=4) :: nobleGasConfigList(6) !'[He]'
DATA coreStateList / '(1s1/2)','(2s1/2)','(2p1/2)','(2p3/2)','(3s1/2)',&
& '(3p1/2)','(3p3/2)','(3d3/2)','(3d5/2)','(4s1/2)',&
& '(4p1/2)','(4p3/2)','(5s1/2)','(4d3/2)','(4d5/2)',&
& '(5p1/2)','(5p3/2)','(6s1/2)','(4f5/2)','(4f7/2)',&
& '(5d3/2)','(5d5/2)','(6p1/2)','(6p3/2)','(7s1/2)',&
& '(5f5/2)','(5f7/2)','(6d3/2)','(6d5/2)' /
DATA nobleGasConfigList / '[He]','[Ne]','[Ar]','[Kr]','[Xe]','[Rn]' /
IF (PRESENT(dtild_opt)) dtild=dtild_opt
IF (PRESENT(name_opt)) name=name_opt
......@@ -463,42 +452,42 @@ SUBROUTINE w_inpXML(&
IF ((endCoreStates.GE.24).AND.&
& (ALL(xmlPrintCoreStates(1:24,iAtomType).EQV..FALSE.)).AND.&
& (ALL(xmlElectronStates(1:24,iAtomType).EQ.coreState_const)) ) THEN
coreStatesString = nobleGasConfigList(6)
coreStatesString = nobleGasConfigList_const(6)
startCoreStates = 25
ELSE IF ((endCoreStates.GE.17).AND.&
& (ALL(xmlPrintCoreStates(1:17,iAtomType).EQV..FALSE.)).AND.&
& (ALL(xmlElectronStates(1:17,iAtomType).EQ.coreState_const))) THEN
coreStatesString = nobleGasConfigList(5)
coreStatesString = nobleGasConfigList_const(5)
startCoreStates = 18
ELSE IF ((endCoreStates.GE.12).AND.&
& (ALL(xmlPrintCoreStates(1:12,iAtomType).EQV..FALSE.)).AND.&
& (ALL(xmlElectronStates(1:12,iAtomType).EQ.coreState_const))) THEN
coreStatesString = nobleGasConfigList(4)
coreStatesString = nobleGasConfigList_const(4)
startCoreStates = 13
ELSE IF ((endCoreStates.GE.7).AND.&
& (ALL(xmlPrintCoreStates(1:7,iAtomType).EQV..FALSE.)).AND.&
& (ALL(xmlElectronStates(1:7,iAtomType).EQ.coreState_const))) THEN
coreStatesString = nobleGasConfigList(3)
coreStatesString = nobleGasConfigList_const(3)
startCoreStates = 8
ELSE IF ((endCoreStates.GE.4).AND.&
& (ALL(xmlPrintCoreStates(1:4,iAtomType).EQV..FALSE.)).AND.&
& (ALL(xmlElectronStates(1:4,iAtomType).EQ.coreState_const))) THEN
coreStatesString = nobleGasConfigList(2)
coreStatesString = nobleGasConfigList_const(2)
startCoreStates = 5
ELSE IF ((endCoreStates.GE.1).AND.&
& (ALL(xmlPrintCoreStates(1:1,iAtomType).EQV..FALSE.)).AND.&
& (ALL(xmlElectronStates(1:1,iAtomType).EQ.coreState_const))) THEN
coreStatesString = nobleGasConfigList(1)
coreStatesString = nobleGasConfigList_const(1)
startCoreStates = 2
END IF
DO i = startCoreStates, endCoreStates
IF(xmlElectronStates(i,iAtomType).EQ.coreState_const) THEN
coreStatesString = TRIM(ADJUSTL(coreStatesString)) // ' ' // coreStateList(i)
coreStatesString = TRIM(ADJUSTL(coreStatesString)) // ' ' // coreStateList_const(i)
END IF
END DO
DO i = 1, 29
IF(xmlElectronStates(i,iAtomType).EQ.valenceState_const) THEN
valenceStatesString = TRIM(ADJUSTL(valenceStatesString)) // ' ' // coreStateList(i)
valenceStatesString = TRIM(ADJUSTL(valenceStatesString)) // ' ' // coreStateList_const(i)
END IF
END DO
WRITE (fileNum,'(a)') ' <electronConfig>'
......@@ -511,7 +500,7 @@ SUBROUTINE w_inpXML(&
IF ((xmlElectronStates(i,iAtomType).NE.noState_const).AND.(xmlPrintCoreStates(i,iAtomType))) THEN
! <coreStateOccupation state="(2s1/2)" spinUp="1.0" spinDown="1.0"/>
325 FORMAT(' <stateOccupation state="',a,'" spinUp="',f0.8,'" spinDown="',f0.8,'"/>')
WRITE(fileNum,325) coreStateList(i), xmlCoreOccs(1,i,iAtomType), xmlCoreOccs(2,i,iAtomType)
WRITE(fileNum,325) coreStateList_const(i), xmlCoreOccs(1,i,iAtomType), xmlCoreOccs(2,i,iAtomType)
END IF
END DO
WRITE (fileNum,'(a)') ' </electronConfig>'
......
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