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 Show whitespace changes
Inline Side-by-side
Showing with 1104 additions and 1542 deletions
cdn/cdntot.f90
View file @ 7f10ed8c
......@@ -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)
......
fleurinput/constants.f90
View file @ 7f10ed8c
......@@ -26,7 +26,8 @@ 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
......
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(:)
......
global/checkdop.F90
View file @ 7f10ed8c
......@@ -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
......
global/find_enpara.f90
View file @ 7f10ed8c
......@@ -15,27 +15,25 @@ 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(:)
......@@ -129,30 +126,11 @@ CONTAINS
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
......@@ -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 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
rotkpt = modulo1(rotkpt, kpts%nkpt3)
call judft_error("Missing functionality")
!rotkpt = modulo1(rotkpt, kpts%nkpt3)
!check if rotkpt is identical to bk(:,ikpt)
IF (maxval(abs(rotkpt - kpts%bkf(:, ikpt))) <= 1E-06) THEN
......@@ -573,7 +576,8 @@ CONTAINS
rotkpt = matmul(rrot(:, :, iop), 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
......@@ -608,7 +612,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
......
hybrid/symmetrizeh.F90
View file @ 7f10ed8c
......@@ -233,9 +233,9 @@ CONTAINS
DO itype = 1, atoms%ntype
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) invsfct = 2
IF ((sym%invsat(iatom) == 0) .OR. (sym%invsat(iatom) == 1)) THEN
IF (sym%invsat(iatom) == 0) invsfct = 1
IF (sym%invsat(iatom) == 1) invsfct = 2
DO ilo = 1, atoms%nlo(itype)
l = atoms%llo(ilo, itype)
DO m = 1, invsfct*(2*l + 1)
......@@ -264,9 +264,9 @@ CONTAINS
DO itype = 1, atoms%ntype
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) invsfct = 2
IF ((sym%invsat(iatom) == 0) .OR. (sym%invsat(iatom) == 1)) THEN
IF (sym%invsat(iatom) == 0) invsfct = 1
IF (sym%invsat(iatom) == 1) invsfct = 2
DO ilo = 1, atoms%nlo(itype)
l = atoms%llo(ilo, itype)
......@@ -325,10 +325,10 @@ CONTAINS
iatom = iatom + 1
ratom = map(isym, iatom)
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 (atoms%invsat(ratom) == 2) 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
IF (sym%invsat(ratom) == 2) THEN
ratom = sym%invsatnr(ratom)
END IF
invsfct = 2
......@@ -387,9 +387,9 @@ CONTAINS
DO itype = 1, atoms%ntype
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) invsfct = 2
IF ((sym%invsat(iatom) == 0) .OR. (sym%invsat(iatom) == 1)) THEN
IF (sym%invsat(iatom) == 0) invsfct = 1
IF (sym%invsat(iatom) == 1) invsfct = 2
DO ilo = 1, atoms%nlo(itype)
l = atoms%llo(ilo, itype)
......@@ -403,7 +403,7 @@ CONTAINS
iop = psym(isym)
ratom = map(isym, iatom)
IF (invsfct == 2) THEN
IF (atoms%invsat(ratom) == 2) THEN
IF (sym%invsat(ratom) == 2) THEN
ratom = sym%invsatnr(ratom)
END IF
END IF
......@@ -448,9 +448,9 @@ CONTAINS
DO itype = 1, atoms%ntype
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) invsfct = 2
IF ((sym%invsat(iatom) == 0) .OR. (sym%invsat(iatom) == 1)) THEN
IF (sym%invsat(iatom) == 0) invsfct = 1
IF (sym%invsat(iatom) == 1) invsfct = 2
DO ilo = 1, atoms%nlo(itype)
l = atoms%llo(ilo, itype)
......@@ -461,9 +461,9 @@ CONTAINS
DO itype1 = 1, atoms%ntype
DO ieq1 = 1, atoms%neq(itype1)
iatom1 = iatom1 + 1
IF ((atoms%invsat(iatom1) == 0) .OR. (atoms%invsat(iatom1) == 1)) THEN
IF (atoms%invsat(iatom1) == 0) invsfct1 = 1
IF (atoms%invsat(iatom1) == 1) invsfct1 = 2
IF ((sym%invsat(iatom1) == 0) .OR. (sym%invsat(iatom1) == 1)) THEN
IF (sym%invsat(iatom1) == 0) invsfct1 = 1
IF (sym%invsat(iatom1) == 1) invsfct1 = 2
DO ilo1 = 1, atoms%nlo(itype1)
l1 = atoms%llo(ilo1, itype1)
......@@ -478,12 +478,12 @@ CONTAINS
ratom1 = map(isym, iatom1)
IF (invsfct == 2) THEN
IF (atoms%invsat(ratom) == 2) THEN
IF (sym%invsat(ratom) == 2) THEN
ratom = sym%invsatnr(ratom)
END IF
END IF
IF (invsfct1 == 2) THEN
IF (atoms%invsat(ratom1) == 2) THEN
IF (sym%invsat(ratom1) == 2) THEN
ratom1 = sym%invsatnr(ratom1)
END IF
END IF
......
hybrid/trafo.F90
View file @ 7f10ed8c
......@@ -5,7 +5,7 @@
!--------------------------------------------------------------------------------
MODULE m_trafo
use m_judft
CONTAINS
SUBROUTINE waveftrafo_symm(cmt_out, z_out, cmt, l_real, z_r, z_c, bandi, ndb, &
......@@ -76,7 +76,8 @@ CONTAINS
rkpt = matmul(rrot, kpts%bk(:, nk))
rkpthlp = rkpt
rkpt = modulo1(rkpt, kpts%nkpt3)
call judft_error("Missing functionality here")
!rkpt = modulo1(rkpt, kpts%nkpt3)
g1 = nint(rkpt - rkpthlp)
! MT coefficients
......@@ -223,7 +224,8 @@ CONTAINS
rkpt = matmul(rrot, kpts%bk(:, nk))
rkpthlp = rkpt
rkpt = modulo1(rkpt, kpts%nkpt3)
call judft_error("Missing functionality here")
!rkpt = modulo1(rkpt, kpts%nkpt3)
g1 = nint(rkpt - rkpthlp)
! MT coefficients
......@@ -369,7 +371,7 @@ CONTAINS
nn = sum((/((2*l + 1)*nindxm(l, itype), l=0, lcutm(itype))/))
DO ieq = 1, atoms%neq(itype)
ic = ic + 1
IF (atoms%invsat(ic) == 0) THEN
IF (sym%invsat(ic) == 0) THEN
! if the structure is inversion-symmetric, but the equivalent atom belongs to a different unit cell
! invsat(atom) = 0, invsatnr(atom) = 0
! but we need invsatnr(atom) = natom
......@@ -481,7 +483,7 @@ CONTAINS
nn = sum((/((2*l + 1)*nindxm(l, itype), l=0, lcutm(itype))/))
DO ieq = 1, atoms%neq(itype)
ic = ic + 1
IF (atoms%invsat(ic) == 0) THEN
IF (sym%invsat(ic) == 0) THEN
! if the structure is inversion-symmetric, but the equivalent atom belongs to a different unit cell
! invsat(atom) = 0, invsatnr(atom) =0
! but we need invsatnr(atom) = natom
......@@ -633,7 +635,8 @@ CONTAINS
rkpt = matmul(rrot, kpts%bkf(:, ikpt0))
rkpthlp = rkpt
rkpt = modulo1(rkpt, kpts%nkpt3)
call judft_error("Missing functionality here")
!rkpt = modulo1(rkpt, kpts%nkpt3)
g = nint(rkpthlp - rkpt)
#ifdef CPP_DEBUG
......@@ -838,7 +841,8 @@ CONTAINS
rrot = transpose(sym%mrot(:, :, sym%invtab(iisym)))
invrrot = transpose(sym%mrot(:, :, iisym))
rkpt = matmul(rrot, kpts%bk(:, ikpt0))
rkpthlp = modulo1(rkpt, kpts%nkpt3)
call judft_error("Missing functionality here")
! rkpthlp = modulo1(rkpt, kpts%nkpt3)
g = nint(rkpt - rkpthlp)
CALL d_wigner(invrot, cell%bmat, maxlcutm, dwgn(:, :, 1:maxlcutm))
......@@ -854,7 +858,8 @@ CONTAINS
rrot = -transpose(sym%mrot(:, :, sym%invtab(iisym)))
invrrot = -transpose(sym%mrot(:, :, iisym))
rkpt = matmul(rrot, kpts%bk(:, ikpt0))
rkpthlp = modulo1(rkpt, kpts%nkpt3)
call judft_error("Missing functionality here")
!rkpthlp = modulo1(rkpt, kpts%nkpt3)
g = nint(rkpt - rkpthlp)
matin1 = conjg(matin1)
......@@ -1111,7 +1116,8 @@ CONTAINS
END DO
rkpt = matmul(rrot, kpts%bk(:, ikpt0))
rkpthlp = modulo1(rkpt, kpts%nkpt3)
call judft_error("Missing functionality here")
!rkpthlp = modulo1(rkpt, kpts%nkpt3)
g = nint(rkpt - rkpthlp)
! determine number of rotated k-point bk(:,ikpt) -> ikpt1
......@@ -1332,7 +1338,8 @@ CONTAINS
rrot = transpose(sym%mrot(:, :, sym%invtab(iisym)))
invrrot = transpose(sym%mrot(:, :, iisym))
rkpt = matmul(rrot, kpts%bk(:, ikpt0))
rkpthlp = modulo1(rkpt, kpts%nkpt3)
call judft_error("Missing functionality here")
!rkpthlp = modulo1(rkpt, kpts%nkpt3)
g = nint(rkpt - rkpthlp)
CALL d_wigner(invrot, cell%bmat, maxlcutm, dwgn(:, :, 1:maxlcutm))
......@@ -1348,7 +1355,8 @@ CONTAINS
invrot = sym%mrot(:, :, sym%invtab(iisym))
invrrot = -transpose(sym%mrot(:, :, iisym))
rkpt = matmul(rrot, kpts%bk(:, ikpt0))
rkpthlp = modulo1(rkpt, kpts%nkpt3)
call judft_error("Missing functionality here")