Commit 7f10ed8c authored by Daniel Wortmann's avatar Daniel Wortmann

Fixed merge. Several features are disabled: libxc because of metaGGA for example

parent 932ae148
...@@ -27,7 +27,7 @@ CONTAINS ...@@ -27,7 +27,7 @@ CONTAINS
INTEGER :: jsp, j, ivac, nz, n INTEGER :: jsp, j, ivac, nz, n
REAL :: q2(vacuum%nmz), w, rht1(vacuum%nmzd,2,input%jspins) REAL :: q2(vacuum%nmz), w, rht1(vacuum%nmzd,2,input%jspins)
COMPLEX :: x(stars%ng3) COMPLEX :: x(stars%ng3)
qtot = 0.0 qtot = 0.0
qistot = 0.0 qistot = 0.0
DO jsp = 1,input%jspins DO jsp = 1,input%jspins
...@@ -103,7 +103,7 @@ CONTAINS ...@@ -103,7 +103,7 @@ CONTAINS
call tmp_potden%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN) call tmp_potden%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN)
call init_mt_grid(input%jspins, atoms, sphhar, xcpot, sym) call init_mt_grid(input%jspins, atoms, sphhar, xcpot, sym)
do n_atm =1,atoms%ntype do n_atm =1,atoms%ntype
call mt_from_grid(atoms, sphhar, n_atm, input%jspins, mt(:,:,n_atm), & call mt_from_grid(atoms, sym, sphhar, n_atm, input%jspins, mt(:,:,n_atm), &
tmp_potden%mt(:,0:,n_atm,:)) tmp_potden%mt(:,0:,n_atm,:))
do i=1,atoms%jri(n_atm) do i=1,atoms%jri(n_atm)
...@@ -156,11 +156,11 @@ CONTAINS ...@@ -156,11 +156,11 @@ CONTAINS
REAL qmt(atoms%ntype,input%jspins),qvac(2,input%jspins) REAL qmt(atoms%ntype,input%jspins),qvac(2,input%jspins)
INTEGER, ALLOCATABLE :: lengths(:,:) INTEGER, ALLOCATABLE :: lengths(:,:)
CHARACTER(LEN=20) :: attributes(6), names(6) CHARACTER(LEN=20) :: attributes(6), names(6)
CALL timestart("cdntot") CALL timestart("cdntot")
call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, den, & call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, den, &
q, qis, qmt, qvac, qtot, qistot) q, qis, qmt, qvac, qtot, qistot)
IF (input%film) THEN IF (input%film) THEN
ALLOCATE(lengths(4+vacuum%nvac,2)) ALLOCATE(lengths(4+vacuum%nvac,2))
ELSE ELSE
...@@ -209,7 +209,7 @@ CONTAINS ...@@ -209,7 +209,7 @@ CONTAINS
REAL, INTENT(in) :: q(:), qis(:), qmt(:,:), qvac(:,:), qtot, qistot REAL, INTENT(in) :: q(:), qis(:), qmt(:,:), qvac(:,:), qtot, qistot
character(len=*), intent(in), optional :: hint character(len=*), intent(in), optional :: hint
integer :: n_mt integer :: n_mt
if(present(hint)) write (*,*) "DEN of ", hint if(present(hint)) write (*,*) "DEN of ", hint
write (*,*) "q = ", q write (*,*) "q = ", q
......
...@@ -13,7 +13,7 @@ MODULE m_constants ...@@ -13,7 +13,7 @@ MODULE m_constants
PROCEDURE:: read_xml=>read_xml_constants PROCEDURE:: read_xml=>read_xml_constants
PROCEDURE:: mpi_bc=>mpi_bc_constants PROCEDURE:: mpi_bc=>mpi_bc_constants
END TYPE t_constants END TYPE t_constants
REAL :: warp_factor=1.0 !should be set from input later REAL :: warp_factor=1.0 !should be set from input later
INTEGER, PARAMETER :: noState_const = 0 INTEGER, PARAMETER :: noState_const = 0
INTEGER, PARAMETER :: coreState_const = 1 INTEGER, PARAMETER :: coreState_const = 1
...@@ -26,9 +26,10 @@ MODULE m_constants ...@@ -26,9 +26,10 @@ MODULE m_constants
COMPLEX, PARAMETER :: ImagUnit=(0.0,1.0) COMPLEX, PARAMETER :: ImagUnit=(0.0,1.0)
REAL, PARAMETER :: hartree_to_ev_const=27.21138602 ! value from 2014 CODATA recommended values. Uncertainty is 0.00000017 REAL, PARAMETER :: hartree_to_ev_const=27.21138602 ! value from 2014 CODATA recommended values. Uncertainty is 0.00000017
REAL, PARAMETER :: eVac0Default_const = -0.25 REAL, PARAMETER :: eVac0Default_const = -0.25
CHARACTER(len=9), PARAMETER :: version_const = 'fleur 27' CHARACTER(len=9), PARAMETER :: version_const = 'fleur 30'
CHARACTER(len=49), PARAMETER :: version_const_MaX = ' MaX-Release 3.1 (www.max-centre.eu)'
REAL, PARAMETER :: boltzmann_const = 3.1668114e-6 ! value is given in Hartree/Kelvin REAL, PARAMETER :: boltzmann_const = 3.1668114e-6 ! value is given in Hartree/Kelvin
INTEGER, PARAMETER :: POTDEN_TYPE_OTHER = 0 ! POTDEN_TYPE <= 0 ==> undefined INTEGER, PARAMETER :: POTDEN_TYPE_OTHER = 0 ! POTDEN_TYPE <= 0 ==> undefined
INTEGER, PARAMETER :: POTDEN_TYPE_POTTOT = 1 ! 0 < POTDEN_TYPE <= 1000 ==> potential INTEGER, PARAMETER :: POTDEN_TYPE_POTTOT = 1 ! 0 < POTDEN_TYPE <= 1000 ==> potential
INTEGER, PARAMETER :: POTDEN_TYPE_POTCOUL = 2 INTEGER, PARAMETER :: POTDEN_TYPE_POTCOUL = 2
...@@ -36,7 +37,7 @@ MODULE m_constants ...@@ -36,7 +37,7 @@ MODULE m_constants
INTEGER, PARAMETER :: POTDEN_TYPE_POTYUK = 4 INTEGER, PARAMETER :: POTDEN_TYPE_POTYUK = 4
INTEGER, PARAMETER :: POTDEN_TYPE_EnergyDen = 5 INTEGER, PARAMETER :: POTDEN_TYPE_EnergyDen = 5
INTEGER, PARAMETER :: POTDEN_TYPE_DEN = 1001 ! 1000 < POTDEN_TYPE ==> density INTEGER, PARAMETER :: POTDEN_TYPE_DEN = 1001 ! 1000 < POTDEN_TYPE ==> density
CHARACTER(2),DIMENSION(0:103),PARAMETER :: namat_const=(/& CHARACTER(2),DIMENSION(0:103),PARAMETER :: namat_const=(/&
'va',' H','He','Li','Be',' B',' C',' N',' O',' F','Ne',& 'va',' H','He','Li','Be',' B',' C',' N',' O',' F','Ne',&
'Na','Mg','Al','Si',' P',' S','Cl','Ar',' K','Ca','Sc','Ti',& 'Na','Mg','Al','Si',' P',' S','Cl','Ar',' K','Ca','Sc','Ti',&
...@@ -47,7 +48,7 @@ MODULE m_constants ...@@ -47,7 +48,7 @@ MODULE m_constants
'Lu','Hf','Ta',' W','Re','Os','Ir','Pt','Au','Hg','Tl','Pb',& 'Lu','Hf','Ta',' W','Re','Os','Ir','Pt','Au','Hg','Tl','Pb',&
'Bi','Po','At','Rn','Fr','Ra','Ac','Th','Pa',' U','Np','Pu',& 'Bi','Po','At','Rn','Fr','Ra','Ac','Th','Pa',' U','Np','Pu',&
'Am','Cm','Bk','Cf','Es','Fm','Md','No','Lw'/) 'Am','Cm','Bk','Cf','Es','Fm','Md','No','Lw'/)
CHARACTER(7),DIMENSION(29),PARAMETER :: coreStateList_const=(/& CHARACTER(7),DIMENSION(29),PARAMETER :: coreStateList_const=(/&
'(1s1/2)','(2s1/2)','(2p1/2)','(2p3/2)','(3s1/2)',& '(1s1/2)','(2s1/2)','(2p1/2)','(2p3/2)','(3s1/2)',&
'(3p1/2)','(3p3/2)','(4s1/2)','(3d3/2)','(3d5/2)',& '(3p1/2)','(3p3/2)','(4s1/2)','(3d3/2)','(3d5/2)',&
...@@ -55,50 +56,50 @@ MODULE m_constants ...@@ -55,50 +56,50 @@ MODULE m_constants
'(5p1/2)','(5p3/2)','(6s1/2)','(4f5/2)','(4f7/2)',& '(5p1/2)','(5p3/2)','(6s1/2)','(4f5/2)','(4f7/2)',&
'(5d3/2)','(5d5/2)','(6p1/2)','(6p3/2)','(7s1/2)',& '(5d3/2)','(5d5/2)','(6p1/2)','(6p3/2)','(7s1/2)',&
'(5f5/2)','(5f7/2)','(6d3/2)','(6d5/2)' /) '(5f5/2)','(5f7/2)','(6d3/2)','(6d5/2)' /)
INTEGER,DIMENSION(29),PARAMETER :: coreStateNumElecsList_const=(/& ! This is the number of electrons per spin INTEGER,DIMENSION(29),PARAMETER :: coreStateNumElecsList_const=(/& ! This is the number of electrons per spin
1, 1, 1, 2, 1, 1, 2, 1, 2, 3, 1, 2, 1, 2,& 1, 1, 1, 2, 1, 1, 2, 1, 2, 3, 1, 2, 1, 2,&
3, 1, 2, 1, 3, 4, 2, 3, 1, 2, 1, 3, 4, 2, 3/) 3, 1, 2, 1, 3, 4, 2, 3, 1, 2, 1, 3, 4, 2, 3/)
INTEGER,DIMENSION(29),PARAMETER :: coreStateNprncList_const=(/& INTEGER,DIMENSION(29),PARAMETER :: coreStateNprncList_const=(/&
1, 2, 2, 2, 3, 3, 3, 4, 3, 3, 4, 4, 5, 4, 4,& 1, 2, 2, 2, 3, 3, 3, 4, 3, 3, 4, 4, 5, 4, 4,&
5, 5, 6, 4, 4, 5, 5, 6, 6, 7, 5, 5, 6, 6/) 5, 5, 6, 4, 4, 5, 5, 6, 6, 7, 5, 5, 6, 6/)
INTEGER,DIMENSION(29),PARAMETER :: coreStateKappaList_const=(/& INTEGER,DIMENSION(29),PARAMETER :: coreStateKappaList_const=(/&
-1,-1, 1,-2,-1, 1,-2,-1, 2,-3, 1,-2,-1, 2,-3,& -1,-1, 1,-2,-1, 1,-2,-1, 2,-3, 1,-2,-1, 2,-3,&
1,-2,-1, 3,-4, 2,-3, 1,-2,-1, 3,-4, 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]'/) 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/) INTEGER,DIMENSION(6),PARAMETER :: nobleGasNumStatesList_const=(/1, 4, 7, 12, 17, 24/)
CONTAINS CONTAINS
REAL PURE FUNCTION pimach() REAL PURE FUNCTION pimach()
IMPLICIT NONE IMPLICIT NONE
! This subprogram supplies the value of the constant PI correct to ! This subprogram supplies the value of the constant PI correct to
! machine precision where ! machine precision where
! PI=3.1415926535897932384626433832795028841971693993751058209749446 ! PI=3.1415926535897932384626433832795028841971693993751058209749446
pimach = 3.1415926535897932 pimach = 3.1415926535897932
END FUNCTION pimach END FUNCTION pimach
REAL ELEMENTAL FUNCTION c_light(fac) REAL ELEMENTAL FUNCTION c_light(fac)
IMPLICIT NONE IMPLICIT NONE
! This subprogram supplies the value of c according to ! This subprogram supplies the value of c according to
! NIST standard 13.1.99 ! NIST standard 13.1.99
! Hartree and Rydbergs changed by fac = 1.0 or 2.0 ! Hartree and Rydbergs changed by fac = 1.0 or 2.0
REAL, INTENT (IN) :: fac REAL, INTENT (IN) :: fac
c_light = 137.0359895e0 * fac * warp_factor c_light = 137.0359895e0 * fac * warp_factor
!c_light = 1e6*fac !c_light = 1e6*fac
END FUNCTION c_light END FUNCTION c_light
SUBROUTINE read_xml_constants(this,xml) SUBROUTINE read_xml_constants(this,xml)
USE m_types_xml USE m_types_xml
CLASS(t_constants),INTENT(INout)::this CLASS(t_constants),INTENT(INout)::this
TYPE(t_xml),INTENT(in) ::xml TYPE(t_xml),INTENT(in) ::xml
IF (xml%GetNumberOfNodes('/fleurInput/calculationSetup/expertModes/@warp_factor')==1)& IF (xml%GetNumberOfNodes('/fleurInput/calculationSetup/expertModes/@warp_factor')==1)&
warp_factor=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/expertModes/@warp_factor')) warp_factor=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/expertModes/@warp_factor'))
END SUBROUTINE read_xml_constants END SUBROUTINE read_xml_constants
......
...@@ -13,6 +13,29 @@ MODULE m_types_wannier ...@@ -13,6 +13,29 @@ MODULE m_types_wannier
! type for wannier-functions ! type for wannier-functions
! !
TYPE,EXTENDS(t_fleurinput_base):: t_wann TYPE,EXTENDS(t_fleurinput_base):: t_wann
!New parameters not handled correctly yet...
LOGICAL :: l_socmatvec
LOGICAL :: l_socmatvecrs
LOGICAL :: l_mmn0_unf_to_spn_unf
LOGICAL :: l_mmn0_to_spn_unf
LOGICAL :: l_mmn0_to_spn
LOGICAL :: l_mmn0_to_spn2
LOGICAL :: l_mmn0_unf_to_spn
LOGICAL :: l_perpmag_unf_to_tor_unf
LOGICAL :: l_perpmag_to_tor_unf
LOGICAL :: l_perpmag_to_tor
LOGICAL :: l_perpmag_unf_to_tor
LOGICAL :: l_hsomtxvec_unf_to_lmpzsoc_unf
LOGICAL :: l_hsomtxvec_to_lmpzsoc_unf
LOGICAL :: l_hsomtxvec_to_lmpzsoc
LOGICAL :: l_hsomtxvec_unf_to_lmpzsoc
LOGICAL :: l_hsomtx_unf_to_hsoc_unf
LOGICAL :: l_hsomtx_to_hsoc_unf
LOGICAL :: l_hsomtx_to_hsoc
LOGICAL :: l_hsomtx_unf_to_hsoc
INTEGER :: perpmagl
LOGICAL :: l_perpmagatlres
INTEGER :: wan90version =3 INTEGER :: wan90version =3
INTEGER :: oc_num_orbs =0 INTEGER :: oc_num_orbs =0
INTEGER, ALLOCATABLE :: oc_orbs(:) INTEGER, ALLOCATABLE :: oc_orbs(:)
...@@ -133,7 +156,7 @@ MODULE m_types_wannier ...@@ -133,7 +156,7 @@ MODULE m_types_wannier
PROCEDURE :: read_xml => read_xml_wannier PROCEDURE :: read_xml => read_xml_wannier
PROCEDURE :: mpi_bc => mpi_bc_wannier PROCEDURE :: mpi_bc => mpi_bc_wannier
END TYPE t_wann END TYPE t_wann
PUBLIC t_wann PUBLIC t_wann
CONTAINS CONTAINS
......
...@@ -24,7 +24,7 @@ ...@@ -24,7 +24,7 @@
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
TYPE(t_dimension),INTENT(IN) :: dimension TYPE(t_dimension),INTENT(IN) :: dimension
type(t_sphhar),intent(in) :: sphhar type(t_sphhar),intent(in) :: sphhar
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
...@@ -52,7 +52,7 @@ ...@@ -52,7 +52,7 @@
l_cdn = .FALSE. ! By default we assume that the input is a potential. l_cdn = .FALSE. ! By default we assume that the input is a potential.
IF (potden%potdenType.LE.0) CALL juDFT_error('unknown potden type', calledby='checkdop') IF (potden%potdenType.LE.0) CALL juDFT_error('unknown potden type', calledby='checkdop')
IF (potden%potdenType.GT.1000) l_cdn = .TRUE. ! potdenTypes > 1000 are reserved for densities IF (potden%potdenType.GT.1000) l_cdn = .TRUE. ! potdenTypes > 1000 are reserved for densities
! .. ! ..
! .. ! ..
...@@ -92,7 +92,7 @@ ...@@ -92,7 +92,7 @@
DO j = 1,np DO j = 1,np
IF (.NOT.oneD%odi%d1) THEN IF (.NOT.oneD%odi%d1) THEN
CALL starf2(& CALL starf2(&
& sym%nop2,stars%ng2,stars%kv2,sym%mrot,sym%symor,sym%tau,p(1,j),sym%invtab,& & sym%nop2,stars%ng2,stars%kv2,sym%mrot,sym%symor,sym%tau,p(1:3,j),sym%invtab,&
& sf2)!keep & sf2)!keep
v2(j) = potden%vacz(1,ivac,jsp) v2(j) = potden%vacz(1,ivac,jsp)
DO k = 2,stars%ng2 DO k = 2,stars%ng2
...@@ -190,7 +190,7 @@ ...@@ -190,7 +190,7 @@
ENDDO ENDDO
help = help + potden%mt(atoms%jri(n),lh,n,jsp) * s help = help + potden%mt(atoms%jri(n),lh,n,jsp) * s
ENDDO ENDDO
v2(j) = help * ir2 v2(j) = help * ir2
IF (j.LE.8) THEN IF (j.LE.8) THEN
!CALL cotra1(p(1,j),rcc,cell%bmat) !CALL cotra1(p(1,j),rcc,cell%bmat)
rcc=MATMUL(cell%bmat,p(:,j))/tpi_const rcc=MATMUL(cell%bmat,p(:,j))/tpi_const
......
...@@ -11,31 +11,29 @@ MODULE m_find_enpara ...@@ -11,31 +11,29 @@ MODULE m_find_enpara
PUBLIC:: find_enpara PUBLIC:: find_enpara
CONTAINS CONTAINS
!> Function to determine the energy parameter given the quantum number and the potential !> Function to determine the energy parameter given the quantum number and the potential
!! Different schemes are implemented. Nqn (main quantum number) is used as a switch. !! Different schemes are implemented. Nqn (main quantum number) is used as a switch.
!! This code was previously in lodpot.f !! This code was previously in lodpot.f
REAL FUNCTION find_enpara(lo,l,n,jsp,nqn,atoms,irank,vr)RESULT(e) REAL FUNCTION find_enpara(lo,l,n,jsp,nqn,atoms,vr,e_lo,e_up)RESULT(e)
USE m_types_atoms USE m_types_setup
USE m_radsra USE m_radsra
USE m_differ USE m_differ
Use m_xmlOutput
USE m_constants USE m_constants
IMPLICIT NONE IMPLICIT NONE
LOGICAL,INTENT(IN):: lo LOGICAL,INTENT(IN):: lo
INTEGER,INTENT(IN):: l,n,nqn,jsp INTEGER,INTENT(IN):: l,n,nqn,jsp
REAL,INTENT(OUT) :: e_lo,e_up REAL,INTENT(OUT) :: e_lo,e_up
TYPE(t_atoms),INTENT(IN)::atoms TYPE(t_atoms),INTENT(IN)::atoms
INTEGER,INTENT(IN) ::irank
REAL,INTENT(IN):: vr(:) REAL,INTENT(IN):: vr(:)
IF (nqn>0) e=priv_method1(lo,l,n,jsp,nqn,atoms,irank,vr) IF (nqn>0) e=priv_method1(lo,l,n,jsp,nqn,atoms,vr,e_lo,e_up)
IF (nqn<0) e=priv_method2(lo,l,n,jsp,nqn,atoms,irank,vr) IF (nqn<0) e=priv_method2(lo,l,n,jsp,nqn,atoms,vr,e_lo,e_up)
END FUNCTION find_enpara END FUNCTION find_enpara
REAL FUNCTION priv_method1(lo,l,n,jsp,nqn,atoms,irank,vr)RESULT(e) REAL FUNCTION priv_method1(lo,l,n,jsp,nqn,atoms,vr,e_lo,e_up)RESULT(e)
USE m_types_atoms USE m_types_setup
USE m_radsra USE m_radsra
USE m_differ USE m_differ
USE m_constants USE m_constants
...@@ -44,7 +42,6 @@ CONTAINS ...@@ -44,7 +42,6 @@ CONTAINS
INTEGER,INTENT(IN):: l,n,nqn,jsp INTEGER,INTENT(IN):: l,n,nqn,jsp
REAL,INTENT(OUT) :: e_lo,e_up REAL,INTENT(OUT) :: e_lo,e_up
TYPE(t_atoms),INTENT(IN)::atoms TYPE(t_atoms),INTENT(IN)::atoms
INTEGER,INTENT(IN) ::irank
REAL,INTENT(IN):: vr(:) REAL,INTENT(IN):: vr(:)
...@@ -54,12 +51,12 @@ CONTAINS ...@@ -54,12 +51,12 @@ CONTAINS
REAL d,rn,fl,fn,fj,t2,rr,t1,ldmt,us,dus,c REAL d,rn,fl,fn,fj,t2,rr,t1,ldmt,us,dus,c
LOGICAL start LOGICAL start
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
REAL, ALLOCATABLE :: f(:,:),vrd(:) REAL, ALLOCATABLE :: f(:,:),vrd(:)
CHARACTER(LEN=20) :: attributes(6) CHARACTER(LEN=20) :: attributes(6)
c=c_light(1.0) c=c_light(1.0)
!Core potential setup done for each n,l now !Core potential setup done for each n,l now
d = EXP(atoms%dx(n)) d = EXP(atoms%dx(n))
! set up core-mesh ! set up core-mesh
rn = atoms%rmt(n) rn = atoms%rmt(n)
...@@ -84,10 +81,10 @@ CONTAINS ...@@ -84,10 +81,10 @@ CONTAINS
node = nqn - (l+1) node = nqn - (l+1)
IF (node<0) CALL judft_error("Error in setup of energy-parameters",hint="This could e.g. happen if you try to use 1p-states") IF (node<0) CALL judft_error("Error in setup of energy-parameters",hint="This could e.g. happen if you try to use 1p-states")
e = 0.0 e = 0.0
! determine upper edge ! determine upper edge
nodeu = -1 ; start = .TRUE. nodeu = -1 ; start = .TRUE.
DO WHILE ( nodeu <= node ) DO WHILE ( nodeu <= node )
CALL radsra(e,l,vr(:),atoms%rmsh(1,n),& CALL radsra(e,l,vr(:),atoms%rmsh(1,n),&
atoms%dx(n),atoms%jri(n),c, us,dus,nodeu,f(:,1),f(:,2)) atoms%dx(n),atoms%jri(n),c, us,dus,nodeu,f(:,1),f(:,2))
IF ( ( nodeu > node ) .AND. start ) THEN IF ( ( nodeu > node ) .AND. start ) THEN
...@@ -105,7 +102,7 @@ CONTAINS ...@@ -105,7 +102,7 @@ CONTAINS
IF (node /= 0) THEN IF (node /= 0) THEN
! determine lower edge ! determine lower edge
nodeu = node + 1 nodeu = node + 1
DO WHILE ( nodeu >= node ) DO WHILE ( nodeu >= node )
CALL radsra(e,l,vr(:),atoms%rmsh(1,n),& CALL radsra(e,l,vr(:),atoms%rmsh(1,n),&
atoms%dx(n),atoms%jri(n),c, us,dus,nodeu,f(:,1),f(:,2)) atoms%dx(n),atoms%jri(n),c, us,dus,nodeu,f(:,1),f(:,2))
e = e - 0.01 e = e - 0.01
...@@ -113,7 +110,7 @@ CONTAINS ...@@ -113,7 +110,7 @@ CONTAINS
ENDDO ENDDO
e_lo = e e_lo = e
ELSE ELSE
e_lo = -9.99 e_lo = -9.99
ENDIF ENDIF
! calculate core ! calculate core
e = (e_up+e_lo)/2 e = (e_up+e_lo)/2
...@@ -125,34 +122,15 @@ CONTAINS ...@@ -125,34 +122,15 @@ CONTAINS
fn = REAL(nqn) ; fl = REAL(l) ; fj = fl-0.5 fn = REAL(nqn) ; fl = REAL(l) ; fj = fl-0.5
CALL differ(fn,fl,fj,c,atoms%zatom(n),atoms%dx(n),atoms%rmsh(1,n),& CALL differ(fn,fl,fj,c,atoms%zatom(n),atoms%dx(n),atoms%rmsh(1,n),&
rn,d,msh,vrd, e1, f(:,1),f(:,2),ierr) rn,d,msh,vrd, e1, f(:,1),f(:,2),ierr)
e = (2.0*e + e1 ) / 3.0 e = (2.0*e + e1 ) / 3.0
ENDIF ENDIF
IF (irank == 0) THEN
attributes = ''
WRITE(attributes(1),'(i0)') n
WRITE(attributes(2),'(i0)') jsp
WRITE(attributes(3),'(i0,a1)') nqn, ch(l)
WRITE(attributes(4),'(f8.2)') e_lo
WRITE(attributes(5),'(f8.2)') e_up
WRITE(attributes(6),'(f16.10)') e
IF (lo) THEN
CALL writeXMLElementForm('loAtomicEP',(/'atomType ','spin ','branch ',&
'branchLowest ','branchHighest','value '/),&
attributes,RESHAPE((/10,4,6,12,13,5,6,1,3,8,8,16/),(/6,2/)))
ELSE
CALL writeXMLElementForm('atomicEP',(/'atomType ','spin ','branch ',&
'branchLowest ','branchHighest','value '/),&
attributes,RESHAPE((/12,4,6,12,13,5,6,1,3,8,8,16/),(/6,2/)))
ENDIF
WRITE(6,'(a6,i5,i2,a1,a12,f6.2,a3,f6.2,a13,f8.4)') ' Atom',n,nqn,ch(l),' branch from',&
e_lo, ' to',e_up,' htr. ; e_l =',e
ENDIF
END FUNCTION priv_method1 END FUNCTION priv_method1
REAL FUNCTION priv_method2(lo,l,n,jsp,nqn,atoms,irank,vr)RESULT(e) REAL FUNCTION priv_method2(lo,l,n,jsp,nqn,atoms,vr,e_lo,e_up)RESULT(e)
USE m_types_atoms USE m_types_setup
USE m_radsra USE m_radsra
USE m_differ USE m_differ
USE m_constants USE m_constants
...@@ -161,7 +139,6 @@ CONTAINS ...@@ -161,7 +139,6 @@ CONTAINS
INTEGER,INTENT(IN):: l,n,nqn,jsp INTEGER,INTENT(IN):: l,n,nqn,jsp
REAL,INTENT(OUT) :: e_lo,e_up REAL,INTENT(OUT) :: e_lo,e_up
TYPE(t_atoms),INTENT(IN)::atoms TYPE(t_atoms),INTENT(IN)::atoms
INTEGER,INTENT(IN) ::irank
REAL,INTENT(IN):: vr(:) REAL,INTENT(IN):: vr(:)
INTEGER j,ilo,i INTEGER j,ilo,i
...@@ -170,14 +147,14 @@ CONTAINS ...@@ -170,14 +147,14 @@ CONTAINS
REAL d,rn,fl,fn,fj,t2,rr,t1,ldmt,us,dus,c REAL d,rn,fl,fn,fj,t2,rr,t1,ldmt,us,dus,c
LOGICAL start LOGICAL start
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
REAL, ALLOCATABLE :: f(:,:),vrd(:) REAL, ALLOCATABLE :: f(:,:),vrd(:)
CHARACTER(LEN=20) :: attributes(6) CHARACTER(LEN=20) :: attributes(6)
c=c_light(1.0) c=c_light(1.0)
!Core potential setup done for each n,l now !Core potential setup done for each n,l now
d = EXP(atoms%dx(n)) d = EXP(atoms%dx(n))
! set up core-mesh ! set up core-mesh
rn = atoms%rmt(n) rn = atoms%rmt(n)
...@@ -266,7 +243,7 @@ CONTAINS ...@@ -266,7 +243,7 @@ CONTAINS
! determince notches by intersection ! determince notches by intersection
ldmt= -99.0 !ldmt = logarithmic derivative @ MT boundary ldmt= -99.0 !ldmt = logarithmic derivative @ MT boundary
lnd = -l-1 lnd = -l-1
DO WHILE ( ABS(ldmt-lnd) .GE. 1E-07) DO WHILE ( ABS(ldmt-lnd) .GE. 1E-07)
e = (e_up+e_lo)/2 e = (e_up+e_lo)/2
CALL radsra(e,l,vr(:),atoms%rmsh(1,n),& CALL radsra(e,l,vr(:),atoms%rmsh(1,n),&
atoms%dx(n),atoms%jri(n),c, us,dus,nodeu,f(:,1),f(:,2)) atoms%dx(n),atoms%jri(n),c, us,dus,nodeu,f(:,1),f(:,2))
...@@ -279,25 +256,6 @@ CONTAINS ...@@ -279,25 +256,6 @@ CONTAINS
END IF END IF
END DO END DO
IF (irank == 0) THEN END FUNCTION priv_method2
attributes = ''
WRITE(attributes(1),'(i0)') n
WRITE(attributes(2),'(i0)') jsp
WRITE(attributes(3),'(i0,a1)') ABS(nqn), ch(l)
WRITE(attributes(4),'(f16.10)') ldmt
WRITE(attributes(5),'(f16.10)') e
IF (lo) THEN
CALL writeXMLElementForm('heloAtomicEP',(/'atomType ','spin ','branch ',&
'logDerivMT ','value '/),&
attributes(1:5),reshape((/8,4,6,12,5+17,6,1,3,16,16/),(/5,2/)))
ELSE
CALL writeXMLElementForm('heAtomicEP',(/'atomType ','spin ','branch ',&
'logDerivMT ','value '/),&
attributes(1:5),reshape((/10,4,6,12,5+17,6,1,3,16,16/),(/5,2/)))
ENDIF
WRITE (6,'(a7,i3,i2,a1,a12,f7.2,a4,f7.2,a5)') " Atom ",n,nqn,ch(l)," branch, D = ",&
ldmt, " at ",e," htr."
ENDIF
END FUNCTION priv_method2
END MODULE m_find_enpara END MODULE m_find_enpara
...@@ -50,7 +50,7 @@ ...@@ -50,7 +50,7 @@
! converges well with q0. (Should be the default.) ! converges well with q0. (Should be the default.)
MODULE m_exchange_valence_hf MODULE m_exchange_valence_hf
use m_judft