Skip to content

GitLab

fleur
fleur
Commit 7f10ed8c authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

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

parent 932ae148
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 1104 additions and 1542 deletions
cdn/cdntot.f90
View file @ 7f10ed8c
......@@ -27,7 +27,7 @@ CONTAINS
INTEGER :: jsp, j, ivac, nz, n
REAL :: q2(vacuum%nmz), w, rht1(vacuum%nmzd,2,input%jspins)
COMPLEX :: x(stars%ng3)
qtot = 0.0
qistot = 0.0
DO jsp = 1,input%jspins
......@@ -103,7 +103,7 @@ CONTAINS
call tmp_potden%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN)
call init_mt_grid(input%jspins, atoms, sphhar, xcpot, sym)
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,:))
do i=1,atoms%jri(n_atm)
......@@ -156,11 +156,11 @@ CONTAINS
REAL qmt(atoms%ntype,input%jspins),qvac(2,input%jspins)
INTEGER, ALLOCATABLE :: lengths(:,:)
CHARACTER(LEN=20) :: attributes(6), names(6)
CALL timestart("cdntot")
call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, den, &
q, qis, qmt, qvac, qtot, qistot)
IF (input%film) THEN
ALLOCATE(lengths(4+vacuum%nvac,2))
ELSE
......@@ -209,7 +209,7 @@ CONTAINS
REAL, INTENT(in) :: q(:), qis(:), qmt(:,:), qvac(:,:), qtot, qistot
character(len=*), intent(in), optional :: hint
integer :: n_mt
if(present(hint)) write (*,*) "DEN of ", hint
write (*,*) "q = ", q
......
fleurinput/constants.f90
View file @ 7f10ed8c
......@@ -13,7 +13,7 @@ MODULE m_constants
PROCEDURE:: read_xml=>read_xml_constants
PROCEDURE:: mpi_bc=>mpi_bc_constants
END TYPE t_constants
REAL :: warp_factor=1.0 !should be set from input later
INTEGER, PARAMETER :: noState_const = 0
INTEGER, PARAMETER :: coreState_const = 1
......@@ -26,9 +26,10 @@ MODULE m_constants
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 :: 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
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_POTCOUL = 2
......@@ -36,7 +37,7 @@ MODULE m_constants
INTEGER, PARAMETER :: POTDEN_TYPE_POTYUK = 4
INTEGER, PARAMETER :: POTDEN_TYPE_EnergyDen = 5
INTEGER, PARAMETER :: POTDEN_TYPE_DEN = 1001 ! 1000 < POTDEN_TYPE ==> density
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',&
......@@ -47,7 +48,7 @@ MODULE m_constants
'Lu','Hf','Ta',' W','Re','Os','Ir','Pt','Au','Hg','Tl','Pb',&
'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)','(4s1/2)','(3d3/2)','(3d5/2)',&
......@@ -55,50 +56,50 @@ MODULE m_constants
'(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, 1, 2, 3, 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, 4, 3, 3, 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,-1, 2,-3, 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()
IMPLICIT NONE
! This subprogram supplies the value of the constant PI correct to
! machine precision where
! PI=3.1415926535897932384626433832795028841971693993751058209749446
pimach = 3.1415926535897932
END FUNCTION pimach
REAL ELEMENTAL FUNCTION c_light(fac)
IMPLICIT NONE
! 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
REAL, INTENT (IN) :: fac
c_light = 137.0359895e0 * fac * warp_factor
!c_light = 1e6*fac
END FUNCTION c_light
SUBROUTINE read_xml_constants(this,xml)
USE m_types_xml
CLASS(t_constants),INTENT(INout)::this
TYPE(t_xml),INTENT(in) ::xml
IF (xml%GetNumberOfNodes('/fleurInput/calculationSetup/expertModes/@warp_factor')==1)&
warp_factor=evaluateFirstOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/expertModes/@warp_factor'))
END SUBROUTINE read_xml_constants
......
fleurinput/types_wannier.f90
View file @ 7f10ed8c
......@@ -13,6 +13,29 @@ MODULE m_types_wannier
! type for wannier-functions
!
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 :: oc_num_orbs =0
INTEGER, ALLOCATABLE :: oc_orbs(:)
......@@ -133,7 +156,7 @@ MODULE m_types_wannier
PROCEDURE :: read_xml => read_xml_wannier
PROCEDURE :: mpi_bc => mpi_bc_wannier
END TYPE t_wann
PUBLIC t_wann
CONTAINS
......
global/checkdop.F90
View file @ 7f10ed8c
......@@ -24,7 +24,7 @@
! ..
! .. Scalar Arguments ..
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_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
......@@ -52,7 +52,7 @@
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.GT.1000) l_cdn = .TRUE. ! potdenTypes > 1000 are reserved for densities
! ..
! ..
......@@ -92,7 +92,7 @@
DO j = 1,np
IF (.NOT.oneD%odi%d1) THEN
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
v2(j) = potden%vacz(1,ivac,jsp)
DO k = 2,stars%ng2
......@@ -190,7 +190,7 @@
ENDDO
help = help + potden%mt(atoms%jri(n),lh,n,jsp) * s
ENDDO
v2(j) = help * ir2
v2(j) = help * ir2
IF (j.LE.8) THEN
!CALL cotra1(p(1,j),rcc,cell%bmat)
rcc=MATMUL(cell%bmat,p(:,j))/tpi_const
......
global/find_enpara.f90
View file @ 7f10ed8c
......@@ -11,31 +11,29 @@ MODULE m_find_enpara
PUBLIC:: find_enpara
CONTAINS
!> 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.
!! This code was previously in lodpot.f
REAL FUNCTION find_enpara(lo,l,n,jsp,nqn,atoms,irank,vr)RESULT(e)
USE m_types_atoms
REAL FUNCTION find_enpara(lo,l,n,jsp,nqn,atoms,vr,e_lo,e_up)RESULT(e)
USE m_types_setup
USE m_radsra
USE m_differ
Use m_xmlOutput
USE m_constants
IMPLICIT NONE
LOGICAL,INTENT(IN):: lo
INTEGER,INTENT(IN):: l,n,nqn,jsp
REAL,INTENT(OUT) :: e_lo,e_up
TYPE(t_atoms),INTENT(IN)::atoms
INTEGER,INTENT(IN) ::irank
REAL,INTENT(IN):: vr(:)
IF (nqn>0) e=priv_method1(lo,l,n,jsp,nqn,atoms,irank,vr)
IF (nqn<0) e=priv_method2(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,vr,e_lo,e_up)
END FUNCTION find_enpara
REAL FUNCTION priv_method1(lo,l,n,jsp,nqn,atoms,irank,vr)RESULT(e)
USE m_types_atoms
REAL FUNCTION priv_method1(lo,l,n,jsp,nqn,atoms,vr,e_lo,e_up)RESULT(e)
USE m_types_setup
USE m_radsra
USE m_differ
USE m_constants
......@@ -44,7 +42,6 @@ CONTAINS
INTEGER,INTENT(IN):: l,n,nqn,jsp
REAL,INTENT(OUT) :: e_lo,e_up
TYPE(t_atoms),INTENT(IN)::atoms
INTEGER,INTENT(IN) ::irank
REAL,INTENT(IN):: vr(:)
......@@ -54,12 +51,12 @@ CONTAINS
REAL d,rn,fl,fn,fj,t2,rr,t1,ldmt,us,dus,c
LOGICAL start
! ..
! .. Local Arrays ..
! .. Local Arrays ..
REAL, ALLOCATABLE :: f(:,:),vrd(:)
CHARACTER(LEN=20) :: attributes(6)
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))
! set up core-mesh
rn = atoms%rmt(n)
......@@ -84,10 +81,10 @@ CONTAINS
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")
e = 0.0
e = 0.0
! determine upper edge
nodeu = -1 ; start = .TRUE.
DO WHILE ( nodeu <= node )
DO WHILE ( nodeu <= node )
CALL radsra(e,l,vr(:),atoms%rmsh(1,n),&
atoms%dx(n),atoms%jri(n),c, us,dus,nodeu,f(:,1),f(:,2))
IF ( ( nodeu > node ) .AND. start ) THEN
......@@ -105,7 +102,7 @@ CONTAINS
IF (node /= 0) THEN
! determine lower edge
nodeu = node + 1
DO WHILE ( nodeu >= node )
DO WHILE ( nodeu >= node )
CALL radsra(e,l,vr(:),atoms%rmsh(1,n),&
atoms%dx(n),atoms%jri(n),c, us,dus,nodeu,f(:,1),f(:,2))
e = e - 0.01
......@@ -113,7 +110,7 @@ CONTAINS
ENDDO
e_lo = e
ELSE
e_lo = -9.99
e_lo = -9.99
ENDIF
! calculate core
e = (e_up+e_lo)/2
......@@ -125,34 +122,15 @@ CONTAINS
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),&
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
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
REAL FUNCTION priv_method2(lo,l,n,jsp,nqn,atoms,irank,vr)RESULT(e)
USE m_types_atoms
REAL FUNCTION priv_method2(lo,l,n,jsp,nqn,atoms,vr,e_lo,e_up)RESULT(e)
USE m_types_setup
USE m_radsra
USE m_differ
USE m_constants
......@@ -161,7 +139,6 @@ CONTAINS
INTEGER,INTENT(IN):: l,n,nqn,jsp
REAL,INTENT(OUT) :: e_lo,e_up
TYPE(t_atoms),INTENT(IN)::atoms
INTEGER,INTENT(IN) ::irank
REAL,INTENT(IN):: vr(:)
INTEGER j,ilo,i
......@@ -170,14 +147,14 @@ CONTAINS
REAL d,rn,fl,fn,fj,t2,rr,t1,ldmt,us,dus,c
LOGICAL start
! ..
! .. Local Arrays ..
! .. Local Arrays ..
REAL, ALLOCATABLE :: f(:,:),vrd(:)
CHARACTER(LEN=20) :: attributes(6)
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))
! set up core-mesh
rn = atoms%rmt(n)
......@@ -266,7 +243,7 @@ CONTAINS
! determince notches by intersection
ldmt= -99.0 !ldmt = logarithmic derivative @ MT boundary
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
CALL radsra(e,l,vr(:),atoms%rmsh(1,n),&
atoms%dx(n),atoms%jri(n),c, us,dus,nodeu,f(:,1),f(:,2))
......@@ -279,25 +256,6 @@ CONTAINS
END IF
END DO
IF (irank == 0) THEN
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 FUNCTION priv_method2
END MODULE m_find_enpara
hybrid/exchange_val_hf.F90
View file @ 7f10ed8c
......@@ -50,7 +50,7 @@
! converges well with q0. (Should be the default.)
MODULE m_exchange_valence_hf
use m_judft
LOGICAL, PARAMETER:: zero_order = .false., ibs_corr = .false.
INTEGER, PARAMETER:: maxmem = 600
......@@ -287,7 +287,7 @@ CONTAINS
hybrid%lcutm1, hybrid%maxlcutm1, hybrid%nindxm1, hybrid%maxindxm1, hybrid%gptm, &
hybrid%ngptm(ikpt0), hybrid%pgptm(:, ikpt0), hybrid%gptmd, hybrid%basm1, &
hybrid%nbasm(ikpt0), iband1, hybrid%nbands(nk), nsest, ibando, psize, indx_sest, &
atoms%invsat, sym%invsatnr, mpi%irank, cprod_vv_r(:hybrid%nbasm(ikpt0), :, :), &
sym%invsat, sym%invsatnr, mpi%irank, cprod_vv_r(:hybrid%nbasm(ikpt0), :, :), &
cprod_vv_c(:hybrid%nbasm(ikpt0), :, :), mat_ex%l_real, wl_iks(:iband1, nkqpt), n_q(ikpt))
END IF
#endif
......@@ -506,9 +506,10 @@ CONTAINS
cdum = sqrt(expo)*rrad
divergence = cell%omtil/(tpi_const**2)*sqrt(pi_const/expo)*cerf(cdum)
rrad = rrad**2
kv1 = cell%bmat(1, :)/kpts%nkpt3(1)
kv2 = cell%bmat(2, :)/kpts%nkpt3(2)
kv3 = cell%bmat(3, :)/kpts%nkpt3(3)
call judft_error("Missing functionality")
!kv1 = cell%bmat(1, :)/kpts%nkpt3(1)
!kv2 = cell%bmat(2, :)/kpts%nkpt3(2)
!kv3 = cell%bmat(3, :)/kpts%nkpt3(3)
n = 1
found = .true.
......
hybrid/hf_setup.F90
View file @ 7f10ed8c
......@@ -51,7 +51,7 @@ CONTAINS
! local arrays
REAL, ALLOCATABLE :: basprod(:)
INTEGER :: degenerat(DIMENSION%neigd2 + 1, kpts%nkpt)
INTEGER :: degenerat(merge(dimension%neigd*2,dimension%neigd,noco%l_soc) + 1, kpts%nkpt)
LOGICAL :: skip_kpt(kpts%nkpt)
INTEGER :: g(3)
......@@ -63,7 +63,7 @@ CONTAINS
ALLOCATE (zmat(kpts%nkptf), stat=ok)
IF (ok /= 0) STOP 'eigen_hf: failure allocation z_c'
ALLOCATE (eig_irr(DIMENSION%neigd2, kpts%nkpt), stat=ok)
ALLOCATE (eig_irr(merge(dimension%neigd*2,dimension%neigd,noco%l_soc), kpts%nkpt), stat=ok)
IF (ok /= 0) STOP 'eigen_hf: failure allocation eig_irr'
ALLOCATE (hybdat%kveclo_eig(atoms%nlotot, kpts%nkpt), stat=ok)
IF (ok /= 0) STOP 'eigen_hf: failure allocation hybdat%kveclo_eig'
......@@ -75,7 +75,7 @@ CONTAINS
nrec1 = kpts%nkpt*(jsp - 1) + nk
CALL lapw%init(input, noco, kpts, atoms, sym, nk, cell, sym%zrfs)
nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*atoms%nlotot, lapw%nv(1) + atoms%nlotot, noco%l_noco)
CALL zMat(nk)%init(l_real, nbasfcn, dimension%neigd2)
CALL zMat(nk)%init(l_real, nbasfcn, merge(dimension%neigd*2,dimension%neigd,noco%l_soc))
CALL read_eig(eig_id_hf, nk, jsp, zmat=zMat(nk))
eig_irr(:, nk) = results%eig(:, nk, jsp)
hybrid%ne_eig(nk) = results%neig(nk, jsp)
......@@ -83,7 +83,7 @@ CONTAINS
!Allocate further space
DO nk = kpts%nkpt + 1, kpts%nkptf
nbasfcn = zMat(kpts%bkp(nk))%matsize1
CALL zMat(nk)%init(l_real, nbasfcn, dimension%neigd2)
CALL zMat(nk)%init(l_real, nbasfcn, merge(dimension%neigd*2,dimension%neigd,noco%l_soc))
END DO
!determine degenerate states at each k-point
......
hybrid/hyb_abcrot.F90
View file @ 7f10ed8c
......@@ -52,7 +52,7 @@ CONTAINS
DO ineq = 1, atoms%neq(itype)
iatom = iatom + 1
IF (.NOT. oneD%odi%d1) THEN
iop = atoms%ngopr(iatom)
iop = sym%ngopr(iatom)
ELSE
iop = oneD%ods%ngopr(iatom)
ENDIF
......@@ -60,9 +60,9 @@ CONTAINS
! inversion of spherical harmonics: Y (pi-theta,pi+phi) = (-1) * Y (theta,phi)
! m m
ifac = 1
IF (atoms%invsat(iatom) == 2) THEN
IF (sym%invsat(iatom) == 2) THEN
IF (.NOT. oneD%odi%d1) THEN
iop = atoms%ngopr(sym%invsatnr(iatom))
iop = sym%ngopr(sym%invsatnr(iatom))
ELSE
iop = oneD%ods%ngopr(sym%invsatnr(iatom))
ENDIF
......
hybrid/hybrid.F90
View file @ 7f10ed8c
......@@ -88,7 +88,7 @@ CONTAINS
END IF
hybrid%l_subvxc = (hybrid%l_subvxc .AND. hybrid%l_addhf)
IF (.NOT. ALLOCATED(results%w_iks)) ALLOCATE (results%w_iks(DIMENSION%neigd2, kpts%nkpt, input%jspins))
IF (.NOT. ALLOCATED(results%w_iks)) ALLOCATE (results%w_iks(merge(dimension%neigd*2,dimension%neigd,noco%l_soc), kpts%nkpt, input%jspins))
IF (hybrid%l_calhf) THEN
iterHF = iterHF + 1
......
hybrid/kp_perturbation.F90
View file @ 7f10ed8c
......@@ -157,9 +157,9 @@ MODULE m_kp_perturbation
const = fpi_const*(atoms%rmt(itype)**2)/2/sqrt(cell%omtil)
DO ieq = 1, atoms%neq(itype)
iatom = iatom + 1
IF ((atoms%invsat(iatom) == 0) .or. (atoms%invsat(iatom) == 1)) THEN
IF (atoms%invsat(iatom) == 0) invsfct = 1
IF (atoms%invsat(iatom) == 1) THEN
IF ((sym%invsat(iatom) == 0) .or. (sym%invsat(iatom) == 1)) THEN
IF (sym%invsat(iatom) == 0) invsfct = 1
IF (sym%invsat(iatom) == 1) THEN
invsfct = 2
iatom1 = sym%invsatnr(iatom)
END IF
......
hybrid/read_core.F90
View file @ 7f10ed8c
This diff is collapsed.
hybrid/subvxc.F90
View file @ 7f10ed8c
......@@ -168,7 +168,7 @@ CONTAINS
iatom = 0
DO itype = 1, atoms%ntype
typsym = atoms%ntypsy(SUM(atoms%neq(:itype - 1)) + 1)
typsym = sym%ntypsy(SUM(atoms%neq(:itype - 1)) + 1)
nlharm = sphhar%nlh(typsym)
! Calculate vxc = vtot - vcoul
......@@ -298,7 +298,7 @@ CONTAINS
DO itype = 1, atoms%ntype
typsym = atoms%ntypsy(SUM(atoms%neq(:itype - 1)) + 1)
typsym = sym%ntypsy(SUM(atoms%neq(:itype - 1)) + 1)
nlharm = sphhar%nlh(typsym)
! Calculate vxc = vtot - vcoul
......@@ -340,10 +340,10 @@ CONTAINS
DO ieq = 1, atoms%neq(itype)
iatom = iatom + 1
IF ((atoms%invsat(iatom) == 0) .OR. (atoms%invsat(iatom) == 1)) THEN
IF ((sym%invsat(iatom) == 0) .OR. (sym%invsat(iatom) == 1)) THEN
IF (atoms%invsat(iatom) == 0) invsfct = 1
IF (atoms%invsat(iatom) == 1) invsfct = 2
IF (sym%invsat(iatom) == 0) invsfct = 1
IF (sym%invsat(iatom) == 1) invsfct = 2
DO ilo = 1, atoms%nlo(itype)
#ifdef CPP_OLDINTEL
......@@ -484,7 +484,7 @@ CONTAINS
END DO ! ilo
ikvecprevat = ikvecprevat + ikvecat
ikvecat = 0
END IF ! atoms%invsat(iatom)
END IF ! sym%invsat(iatom)
END DO ! ieq
END DO !itype
END IF ! if any atoms%llo
......@@ -513,4 +513,3 @@ CONTAINS
END SUBROUTINE subvxc
END MODULE m_subvxc
hybrid/symm_hf.F90
View file @ 7f10ed8c
......@@ -10,7 +10,7 @@
! M.Betzinger (09/07) !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MODULE m_symm_hf
use m_judft
#define irreps .false.
CONTAINS
......@@ -52,7 +52,8 @@ CONTAINS
rotkpt = matmul(rrot(:, :, i), kpts%bkf(:, nk))
!transfer rotkpt into BZ
rotkpt = modulo1(rotkpt, kpts%nkpt3)
call judft_error("Missing functionality")
!rotkpt = modulo1(rotkpt, kpts%nkpt3)
!check if rotkpt is identical to bk(:,nk)
IF (maxval(abs(rotkpt - kpts%bkf(:, nk))) <= 1E-07) THEN
......@@ -162,7 +163,8 @@ CONTAINS
rotkpt = matmul(rrot(:, :, psym(iop)), kpts%bkf(:, ikpt))
!transfer rotkpt into BZ
rotkpt = modulo1(rotkpt, kpts%nkpt3)
call judft_error("Missing functionality")
!rotkpt = modulo1(rotkpt, kpts%nkpt3)
!determine number of rotkpt
nrkpt = 0
......@@ -221,7 +223,8 @@ CONTAINS
rotkpt = matmul(rrot(:, :, isym), kpts%bkf(:, ikpt))
!transfer rotkpt into BZ