Commit a8cdfbb1 authored by Daniel Wortmann's avatar Daniel Wortmann

More fixes

parent 4588e4a6
This diff is collapsed.
......@@ -3,7 +3,7 @@ MODULE m_hsmt
IMPLICIT NONE
CONTAINS
SUBROUTINE hsmt(DIMENSION,atoms,sphhar,sym,enpara,SUB_COMM,n_size,n_rank,&
jsp,input,mpi,lmaxb,gwc,noco,cell,&
jsp,input,mpi,lmaxb,noco,cell,&
lapw, bkpt, vr,vs_mmp, oneD,usdus, kveclo,tlmplm,l_real,hamOvlp)
!=====================================================================
! redesign of old hssphn into hsmt
......@@ -92,7 +92,6 @@ CONTAINS
INTEGER, INTENT (IN) :: SUB_COMM,n_size,n_rank
INTEGER, INTENT (IN) :: jsp
INTEGER, INTENT (IN) :: lmaxb
INTEGER, INTENT (IN) :: gwc
! ..
! .. Array Arguments ..
......@@ -231,7 +230,7 @@ CONTAINS
CALL timestart("hsmt extra")
IF (ANY(atoms%nlo>0).OR.ANY(atoms%lda_u%l.GE.0)) &
CALL hsmt_extra(DIMENSION,atoms,sym,isp,n_size,n_rank,input,nintsp,sub_comm,&
hlpmsize,lmaxb,gwc,noco,l_socfirst,lapw,cell,enpara%el0,&
hlpmsize,lmaxb,noco,l_socfirst,lapw,cell,enpara%el0,&
fj,gj,gk,vk,tlmplm,usdus, vs_mmp,oneD,& !in
kveclo,l_real,hamOvlp%a_r,hamOvlp%b_r,hamOvlp%a_c,hamOvlp%b_c) !out/in
CALL timestop("hsmt extra")
......
......@@ -9,7 +9,7 @@ MODULE m_hsmt_extra
IMPLICIT NONE
CONTAINS
SUBROUTINE hsmt_extra(DIMENSION,atoms,sym,isp,n_size,n_rank,input,nintsp,sub_comm,&
hlpmsize,lmaxb,gwc,noco,l_socfirst, lapw,cell,el, fj,gj,gk,vk,tlmplm,usdus, vs_mmp,oneD,& !in
hlpmsize,lmaxb,noco,l_socfirst, lapw,cell,el, fj,gj,gk,vk,tlmplm,usdus, vs_mmp,oneD,& !in
kveclo,l_real,aa_r,bb_r,aa_c,bb_c) !out/inout
USE m_constants, ONLY : tpi_const,fpi_const
USE m_uham
......@@ -37,7 +37,6 @@ CONTAINS
INTEGER, INTENT (IN) :: n_size,n_rank ,nintsp,sub_comm
INTEGER, INTENT (IN) :: hlpmsize
INTEGER, INTENT (IN) :: lmaxb
INTEGER, INTENT (IN) :: gwc
LOGICAL, INTENT (IN) :: l_socfirst
......@@ -268,7 +267,7 @@ CONTAINS
ENDIF
END IF
IF (atoms%n_u>0.and.atoms%lda_u(n)%l.GE.0.AND.gwc.EQ.1) THEN
IF (atoms%n_u>0.and.atoms%lda_u(n)%l.GE.0) THEN
IF ( noco%l_noco .AND. (.NOT.noco%l_ss) ) THEN
CALL u_ham(&
atoms,input,lapw,isp,n,invsfct,&
......
......@@ -14,7 +14,7 @@ MODULE m_tlmplm
!*********************************************************************
CONTAINS
SUBROUTINE tlmplm(sphhar,atoms,dimension,enpara,&
jspin,jsp,mpi, vr,gwc,lh0,input, td,ud)
jspin,jsp,mpi, vr,lh0,input, td,ud)
USE m_intgr, ONLY : intgr3
USE m_radflo
......@@ -34,7 +34,7 @@ MODULE m_tlmplm
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: gwc,lh0 ! normally lh0 = 1; for
INTEGER, INTENT (IN) :: lh0 ! normally lh0 = 1; for
INTEGER, INTENT (IN) :: jspin,jsp !physical spin&spin index for data
! ..
! .. Array Arguments ..
......@@ -83,20 +83,16 @@ MODULE m_tlmplm
!!$OMP PRIVATE(cil,temp,wronk,i,l,l2,lamda,lh,lm,lmin,lmin0,lmp,lmpl)&
!!$OMP PRIVATE(lmplm,lmx,lmxx,lp,lp1,lpl,m,mem,mems,mp,mu,n,nh,noded)&
!!$OMP PRIVATE(nodeu,nsym,na)&
!!$OMP SHARED(dimension,atoms,gwc,lh0,jspin,jsp,sphhar,enpara,td,ud,l_write,ci,vr,mpi,input)
!!$OMP SHARED(dimension,atoms,lh0,jspin,jsp,sphhar,enpara,td,ud,l_write,ci,vr,mpi,input)
DO n = 1,atoms%ntype
na=sum(atoms%neq(:n-1))+1
IF (l_write) WRITE (6,FMT=8000) n
IF (gwc==2) WRITE (14) atoms%rmsh(1:atoms%jri(n),n),atoms%lmax(n)
DO l = 0,atoms%lmax(n)
CALL radfun(l,n,jspin,enpara%el0(l,n,jspin),vr(:,0,n),atoms,&
f(1,1,l),g(1,1,l),ud,nodeu,noded,wronk)
IF (l_write) WRITE (6,FMT=8010) l,enpara%el0(l,n,jspin),ud%us(l,n,jspin),&
ud%dus(l,n,jspin),nodeu,ud%uds(l,n,jspin),ud%duds(l,n,jspin),noded,ud%ddn(l,n,jspin),wronk
IF (gwc==2) WRITE (14) f(1:atoms%jri(n),1,l),g(1:atoms%jri(n),1,l),&
f(1:atoms%jri(n),2,l),g(1:atoms%jri(n),2,l), ud%us(l,n,jspin),&
ud%dus(l,n,jspin),ud%uds(l,n,jspin),ud%duds(l,n,jspin), enpara%el0(l,n,jspin)
END DO
8000 FORMAT (1x,/,/,' wavefunction parameters for atom type',i3,':',&
/,t32,'radial function',t79,'energy derivative',/,t3,&
......@@ -111,12 +107,6 @@ MODULE m_tlmplm
IF (atoms%nlo(n).GE.1) THEN
CALL radflo(atoms,n,jspin,enpara%ello0(1,1,jspin), vr(:,0,n), f,g,mpi,&
ud, uuilon,duilon,ulouilopn,flo)
IF (gwc==2) THEN
DO i=1,atoms%nlo(n)
WRITE (14) flo(1:atoms%jri(n),1,i),&
flo(1:atoms%jri(n),2,i), ud%ulos(i,n,jspin),ud%dulos(i,n,jspin),enpara%ello0(i,n,jspin)
ENDDO
ENDIF
END IF
nsym = atoms%ntypsy(na)
......
......@@ -452,23 +452,23 @@
TYPE t_hybdat
INTEGER :: nbasp
INTEGER :: lmaxcd,maxindxc
REAL, ALLOCATABLE :: gridf(:,:)
INTEGER , ALLOCATABLE:: nindxc(:,:)
INTEGER,ALLOCATABLE :: lmaxc(:)
REAL, ALLOCATABLE :: core1(:,:,:,:),core2(:,:,:,:)
REAL, ALLOCATABLE :: eig_c(:,:,:)
INTEGER , ALLOCATABLE:: kveclo_eig(:,:)
INTEGER,ALLOCATABLE :: ne_eig(:),nbands(:),nobd(:)
INTEGER , ALLOCATABLE:: nbasm(:)
REAL, ALLOCATABLE :: gridf(:,:) !alloc in util.F
INTEGER , ALLOCATABLE:: nindxc(:,:) !alloc in eigen_HF_init
INTEGER,ALLOCATABLE :: lmaxc(:) !alloc in eigen_HF_init
REAL, ALLOCATABLE :: core1(:,:,:,:),core2(:,:,:,:) !alloc in eigen_HF_init
REAL, ALLOCATABLE :: eig_c(:,:,:) !alloc in eigen_HF_init
INTEGER , ALLOCATABLE:: kveclo_eig(:,:) !alloc in eigen_HF_setup
INTEGER,ALLOCATABLE :: ne_eig(:),nbands(:),nobd(:) !alloc in eigen_HF_init
INTEGER , ALLOCATABLE:: nbasm(:) !alloc in eigen_HF_init
INTEGER :: maxfac
REAL, ALLOCATABLE :: sfac(:),fac(:)
REAL, ALLOCATABLE :: gauntarr(:,:,:,:,:,:)
REAL, ALLOCATABLE :: bas1(:,:,:,:),bas2(:,:,:,:)!(jmtd,maxindx,0:lmaxd,ntypd)
REAL , ALLOCATABLE :: bas1_MT(:,:,:),drbas1_MT(:,:,:)!(maxindx,0:lmaxd,ntypd)
REAL, ALLOCATABLE :: prodm(:,:,:,:)
TYPE(PRODTYPE),ALLOCATABLE :: prod(:,:,:)
INTEGER, ALLOCATABLE :: pntgptd(:)
INTEGER, ALLOCATABLE :: pntgpt(:,:,:,:)
REAL, ALLOCATABLE :: sfac(:),fac(:) !alloc in eigen_HF_init
REAL, ALLOCATABLE :: gauntarr(:,:,:,:,:,:) !alloc in eigen_HF_init
REAL, ALLOCATABLE :: bas1(:,:,:,:),bas2(:,:,:,:) !alloc in eigen_HF_init
REAL , ALLOCATABLE :: bas1_MT(:,:,:),drbas1_MT(:,:,:) !alloc in eigen_HF_init
REAL, ALLOCATABLE :: prodm(:,:,:,:) !alloc in eigen_HF_setup
TYPE(PRODTYPE),ALLOCATABLE :: prod(:,:,:) !alloc in eigen_HF_setup
INTEGER, ALLOCATABLE :: pntgptd(:) !alloc in eigen_HF_setup
INTEGER, ALLOCATABLE :: pntgpt(:,:,:,:) !alloc in eigen_HF_setup
END type t_hybdat
TYPE t_dimension
......@@ -858,5 +858,59 @@
integer :: unigrid(6)
integer :: mhp(3)
end type t_wann
TYPE t_potden
INTEGER :: iter
COMPLEX,allocatable :: pw(:,:)
REAL,ALLocatable :: mt(:,:,:,:)
real,allocatable :: vacz(:,:,:)
complex,allocatable :: vacxy(:,:,:,:)
!this type contains two init routines that should be used to allocate
!memory. You can either specify the datatypes or give the dimensions as integers
!See implementation below!
contains
procedure :: init_potden_types
procedure :: init_potden_simple
generic :: init=>init_potden_types,init_potden_simple
END type t_potden
contains
subroutine init_potden_types(pd,stars,atoms,sphhar,vacuum,oneD,jsp)
USE m_judft
implicit none
class(t_potden),INTENT(OUT):: pd
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_sphhar),INTENT(IN):: sphhar
TYPE(t_vacuum),INTENT(IN):: vacuum
TYPE(t_oneD),INTENT(IN) :: oneD
INTEGER,INTENT(IN) :: jsp
CALL init_potden_simple(pd,stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,jsp,vacuum%nmzd,vacuum%nmzxyd,oneD%odi%n2d)
END subroutine init_potden_types
subroutine init_potden_simple(pd,ng3,jmtd,nlhd,ntype,jsp,nmzd,nmzxyd,n2d)
USE m_judft
implicit none
class(t_potden),INTENT(OUT) :: pd
INTEGER,INTENT(IN) :: ng3,jmtd,nlhd,ntype,jsp
INTEGER,INTENT(IN),OPTIONAL :: nmzd,nmzxyd,n2d
INTEGER:: err(4)
err=0
pd%iter=0
ALLOCATE(pd%pw(ng3,jsp),stat=err(1))
ALLOCATE(pd%mt(jmtd,0:nlhd,ntype,jsp),stat=err(2))
IF (present(nmzd)) THEN
ALLOCATE(pd%vacz(nmzd,2,jsp),stat=err(3))
ALLOCATE(pd%vacxy(nmzxyd,n2d-1,2,jsp),stat=err(4))
ENDIF
if (any(err>0)) call judft_error("Not enough memory allocating potential or density")
pd%pw=0.0
pd%mt=0.0
if (present(nmzd)) THEN
pd%vacz=0.0
pd%vacxy=0.0
endif
end subroutine init_potden_simple
END
MODULE m_abcrot
CONTAINS
SUBROUTINE abcrot(atoms,neig,sym,cell,oneD,&
& acof,bcof,ccof)
! ***************************************************************
......@@ -11,9 +14,9 @@
USE m_types
IMPLICIT NONE
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_sym),INTENT(INOUT) :: sym
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: neig
......@@ -35,13 +38,14 @@
#ifndef CPP_MPI
PRINT*,"calculate wigner-matrix"
#endif
IF (.NOT.oneD%odi%d1) THEN
ALLOCATE (sym%d_wgn(-atoms%lmaxd:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,sym%nop))
CALL d_wigner(sym%nop,sym%mrot,cell%bmat,atoms%lmaxd,sym%d_wgn)
ELSE
ALLOCATE (sym%d_wgn(-atoms%lmaxd:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,oneD%ods%nop))
CALL d_wigner(oneD%ods%nop,oneD%ods%mrot,cell%bmat,atoms%lmaxd,sym%d_wgn)
ENDIF
STOP "WIGNER MATRIX should be available in hybrid part"
!IF (.NOT.oneD%odi%d1) THEN
! ALLOCATE (sym%d_wgn(-atoms%lmaxd:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,sym%nop))
! CALL d_wigner(sym%nop,sym%mrot,cell%bmat,atoms%lmaxd,sym%d_wgn)
!ELSE
! ALLOCATE (sym%d_wgn(-atoms%lmaxd:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,atoms%lmaxd,oneD%ods%nop))
! CALL d_wigner(oneD%ods%nop,oneD%ods%mrot,cell%bmat,atoms%lmaxd,sym%d_wgn)
!ENDIF
ENDIF
iatom=0
......@@ -83,4 +87,5 @@
ENDDO
ENDDO
END
END SUBROUTINE abcrot
end MODULE m_abcrot
......@@ -37,14 +37,12 @@
CONTAINS
SUBROUTINE coulombmatrix(mpi,atoms,kpts,&
cell, sym, hybrid, xcpot,l_restart)
SUBROUTINE coulombmatrix(mpi,atoms,kpts,cell, sym, hybrid, xcpot,l_restart)
USE m_constants , ONLY : pi_const
USE m_olap , ONLY : olap_pw,gptnorm
USE m_trafo , ONLY : symmetrize,bramat_trafo
USE m_util , ONLY : sphbessel,intgrf,intgrf_init,&
& harmonicsr,primitivef
USE m_util , ONLY : sphbessel,intgrf,intgrf_init, harmonicsr,primitivef
USE m_hsefunctional, ONLY : change_coulombmatrix
#ifdef CPP_MPI
USE m_mpi_work_dist, ONLY : work_dist_coulomb
......@@ -72,19 +70,15 @@
INTEGER :: maxfac
! INTEGER :: irecl_coulomb
INTEGER :: inviop
INTEGER :: nqnrm,iqnrm,iqnrm1,iqnrm2,&
& iqnrmstart,iqnrmstep
INTEGER :: itype,l ,ix,iy,iy0,i,j,lm,l1,l2,m1,&
& m2,ineq,idum,ikpt,ikpt0,ikpt1
INTEGER :: lm1,lm2,itype1,itype2,ineq1,ineq2,n,&
& n1,n2,ng
INTEGER :: nqnrm,iqnrm,iqnrm1,iqnrm2, iqnrmstart,iqnrmstep
INTEGER :: itype,l ,ix,iy,iy0,i,j,lm,l1,l2,m1, m2,ineq,idum,ikpt,ikpt0,ikpt1
INTEGER :: lm1,lm2,itype1,itype2,ineq1,ineq2,n, n1,n2,ng
INTEGER :: ic,ic1,ic2,ic3,ic4,ic5,ic6,ic7,ic8
INTEGER :: igpt,igpt1,igpt2,igptp,igptp1,igptp2
INTEGER :: isym,isym1,isym2,igpt0
INTEGER :: maxlcut,ok
INTEGER :: nbasp,m
INTEGER :: ikptmin,ikptmax,nkminmax
INTEGER :: idisp,icnt
#ifdef CPP_INVERSION
INTEGER , PARAMETER :: coul_size = 8
#else
......@@ -108,11 +102,9 @@
INTEGER :: rrot(3,3,sym%nsym),invrrot(3,3,sym%nsym)
INTEGER , ALLOCATABLE :: iarr(:),pointer(:,:,:,:)!,pointer(:,:,:)
INTEGER :: igptmin(kpts%nkpt),igptmax(kpts%nkpt)
INTEGER , ALLOCATABLE :: nsym_gpt(:,:),sym_sym1(:,:,:), sym_gpt(:,:,:)
INTEGER :: nsym1(kpts%nkpt+1),ngptm1(kpts%nkpt+1), sym1(sym%nsym,kpts%nkpt+1)
INTEGER , ALLOCATABLE :: nsym_gpt(:,:), sym_gpt(:,:,:)
INTEGER :: nsym1(kpts%nkpt+1), sym1(sym%nsym,kpts%nkpt+1)
INTEGER :: comm(kpts%nkpt)
LOGICAL :: calc_mt(kpts%nkpt)
REAL :: q(3),q1(3),q2(3)
......@@ -125,7 +117,7 @@
REAL :: sphbesmoment1(atoms%jmtd,0:hybrid%maxlcutm1)
REAL :: rarr(0:hybrid%lexp+1),rarr1(0:hybrid%maxlcutm1)
REAL , ALLOCATABLE :: fac(:),sfac(:),facfac(:)
REAL , ALLOCATABLE :: gmat(:,:),qnrm(:),eig(:)
REAL , ALLOCATABLE :: gmat(:,:),qnrm(:)
REAL , ALLOCATABLE :: sphbesmoment(:,:,:)
REAL , ALLOCATABLE :: sphbes0(:,:,:)
REAL , ALLOCATABLE :: olap(:,:,:,:),integral(:,:,:,:)
......@@ -136,17 +128,14 @@
& kpts%nkpt) ! nw = 1
COMPLEX :: y((hybrid%lexp+1)**2),y1((hybrid%lexp+1)**2),&
& y2((hybrid%lexp+1)**2)
COMPLEX :: imgl(0:hybrid%lexp)
COMPLEX :: dwgn(-hybrid%maxlcutm1:hybrid%maxlcutm1,&
& -hybrid%maxlcutm1:hybrid%maxlcutm1,&
& 0:hybrid%maxlcutm1,sym%nsym)
COMPLEX , ALLOCATABLE :: smat(:,:)
COMPLEX , ALLOCATABLE :: coulmat(:,:)
COMPLEX , ALLOCATABLE :: carr1(:),carr2(:,:),carr2a(:,:),&
COMPLEX , ALLOCATABLE :: carr2(:,:),carr2a(:,:),&
& carr2b(:,:)
COMPLEX , ALLOCATABLE :: structconst1(:,:)
REAL , ALLOCATABLE :: eval(:)
REAL , ALLOCATABLE :: coulomb_mt1(:,:,:,:,:)
#if ( defined(CPP_INVERSION) )
REAL , ALLOCATABLE :: coulomb(:,:),coulhlp(:,:),&
......@@ -160,7 +149,7 @@
#else
COMPLEX , ALLOCATABLE :: coulomb(:,:),coulhlp(:,:),&
& coulhlp1(:,:)
COMPLEX , ALLOCATABLE :: olapm(:,:),evec(:,:),invecec(:,:)
COMPLEX , ALLOCATABLE :: olapm(:,:)
COMPLEX , ALLOCATABLE :: coulomb_mt2(:,:,:,:,:),&
& coulomb_mt3(:,:,:,:)
COMPLEX , ALLOCATABLE :: coulomb_mtir(:,:,:),&
......@@ -229,12 +218,7 @@
facfac(i) = facfac(i-1)*(2*i+1) !
END DO
! Define imgl(l) = img**l
imgl(0) = 1
DO i=1,hybrid%lexp
imgl(i) = imgl(i-1) * img
END DO
# ifdef CPP_NOSPMVEC
irecl_coulomb = hybrid%maxbasm1 * (hybrid%maxbasm1+1) * coul_size / 2
......@@ -749,7 +733,7 @@
DO l1=0,hybrid%lexp
l2 = l + l1 ! for structconst
idum = 1
cdum = sphbesmoment(l1,itype1,iqnrm) * imgl(l1) * cexp
cdum = sphbesmoment(l1,itype1,iqnrm) * img**(l1) * cexp
DO m1=-l1,l1
lm1 = lm1 + 1
m2 = M - m1 ! for structconst
......@@ -788,7 +772,7 @@
! finally define coulomb
idum = ix*(ix-1)/2
cdum = (4*pi_const)**2 * imgl(l) * y(lm) * exp(img * 2*pi_const&
cdum = (4*pi_const)**2 * img**(l) * y(lm) * exp(img * 2*pi_const&
* dot_product(hybrid%gptm(:,igptp),atoms%taual(:,ic)))
DO n=1,hybrid%nindxm1(l,itype)
iy = iy + 1
......@@ -934,7 +918,7 @@
DO l=0,hybrid%lexp
DO M=-l,l
lm = lm + 1
carr2a(lm,igpt) = 4*pi_const * imgl(l) * y(lm)
carr2a(lm,igpt) = 4*pi_const * img**(l) * y(lm)
END DO
END DO
DO ic = 1,atoms%nat
......@@ -2262,11 +2246,11 @@
COMPLEX , INTENT(INOUT) :: structconst((2*hybrid%lexp+1)**2 ,atoms%nat,atoms%nat, kpts%nkpt)
! - local scalars -
INTEGER :: i,ic1,ic2,lm,ikpt,l ,ilastsh, ishell,nshell,i1,i2
INTEGER :: ix,iy,iz,n,nn,m
INTEGER :: nptsh,maxl,maxlm
INTEGER :: i,ic1,ic2,lm,ikpt,l ,ishell,nshell
INTEGER :: m
INTEGER :: nptsh,maxl
REAL :: rad,rrad ,rdum,rvol
REAL :: rad,rrad ,rdum
REAL :: a,a1,aa
REAL :: pref,rexp
REAL :: time1,time2
......@@ -2278,18 +2262,16 @@
LOGICAL, SAVE :: first = .true.
! - local arrays -
INTEGER :: conv(0:2*hybrid%lexp)
INTEGER , ALLOCATABLE :: shell(:)
INTEGER , ALLOCATABLE :: pnt(:),ptsh(:,:)
REAL :: r(3),rc(3),ra(3),k(3),ki(3),ka(3)
REAL :: rc(3),ra(3),k(3),ki(3),ka(3)
REAL :: convpar(0:2*hybrid%lexp),g(0:2*hybrid%lexp)
REAL , ALLOCATABLE :: radsh(:)
REAL , ALLOCATABLE :: structdum2(:,:)
COMPLEX :: y((2*hybrid%lexp+1)**2)
COMPLEX :: shlp((2*hybrid%lexp+1)**2,kpts%nkpt)
COMPLEX , ALLOCATABLE :: structdum(:,:,:),structhlp(:,:), chlp(:),structdum1(:)
IF ( mpi%irank /= 0 ) first = .false.
rdum = cell%vol**(1d0/3) ! define "average lattice parameter"
......
......@@ -4,7 +4,7 @@ module m_eigen_hf_init
! preparations for HF and hybrid functional calculation
!
contains
subroutine eigen_hf_init(hybrid,kpts,sym,atoms,input,dimension,hybdat,irank2,isize2)
subroutine eigen_hf_init(hybrid,kpts,atoms,input,dimension,hybdat,irank2,isize2)
USE m_types
USE m_read_core
USE m_util
......@@ -12,12 +12,11 @@ contains
implicit none
TYPE(t_hybrid),INTENT(INOUT) :: hybrid
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_input),INTENT(IN) :: input
TYPE(t_dimension),INTENT(IN) :: dimension
INTEGER,INTENT(OUT) :: irank2(:),isize2(:)
TYPE(t_hybdat),INTENT(OUT):: hybdat
TYPE(t_hybdat),INTENT(OUT) :: hybdat
......@@ -29,8 +28,7 @@ contains
IF( .NOT. hybrid%l_hybrid ) THEN
hybrid%l_calhf = .false.
ELSE IF( (all(hybrid%ddist .lt. 1E-5) .or. init_vex .or. nohf_it >= 50 )&
& .and. input%imix .gt. 10) THEN
ELSE IF( (all(hybrid%ddist .lt. 1E-5) .or. init_vex .or. nohf_it >= 50 ) .and. input%imix .gt. 10) THEN
hybrid%l_calhf = .true.
init_vex = .false.
nohf_it = 0
......@@ -48,8 +46,15 @@ contains
!initialize hybdat%gridf for radial integration
CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
!Alloc variables
ALLOCATE(hybdat%lmaxc(atoms%ntype))
ALLOCATE(hybdat%ne_eig(kpts%nkpt),hybdat%nbands(kpts%nkpt))
ALLOCATE(hybdat%nobd(kpts%nkptf))
ALLOCATE(hybdat%bas1(atoms%jmtd,hybrid%maxindx,0:atoms%lmaxd,atoms%ntype))
ALLOCATE(hybdat%bas2(atoms%jmtd,hybrid%maxindx,0:atoms%lmaxd,atoms%ntype))
ALLOCATE(hybdat%bas1_MT(hybrid%maxindx,0:atoms%lmaxd,atoms%ntype))
ALLOCATE(hybdat%drbas1_MT(hybrid%maxindx,0:atoms%lmaxd,atoms%ntype))
!sym%tau = oneD%ods%tau
! preparations for core states
......
This diff is collapsed.
......@@ -31,6 +31,7 @@
USE m_setabc1locdn
USE m_olap
USE m_types
USE m_abcrot
IMPLICIT NONE
TYPE(t_hybdat),INTENT(INOUT) :: hybdat
......@@ -339,8 +340,8 @@
! rotate them in the global one
CALL abcrot(&
atoms,hybdat%nbands(ikpt0),dimension,&
hybdat%nbands(ikpt0),sym,&
atoms,hybdat%nbands(ikpt0),&
sym,&
cell,oneD,&
acof(: hybdat%nbands(ikpt0),:,:),bcof(: hybdat%nbands(ikpt0),:,:),&
ccof(:,: hybdat%nbands(ikpt0),:,:) )
......
......@@ -37,17 +37,16 @@ MODULE m_hsfock
CONTAINS
SUBROUTINE hsfock(&
& nk,atoms,hybrid,obsolete,lapw,dimension,&
& nk,atoms,hybrid,lapw,dimension,&
& kpts,nkpti,jsp,input,&
& hybdat,&
& eig_irr,n_size,sym,&
& cell,noco,oneD,&
& eig_irr,sym,&
& cell,noco,&
& results,&
& it,maxbands,mnobd,&
& it,mnobd,&
& xcpot,&
& gwc,&
& mpi,irank2,isize2,comm,&
& a)
& hamovlp)
USE m_symm_hf ,ONLY: symm_hf
USE m_util ,ONLY: intgrf,intgrf_init
......@@ -65,9 +64,7 @@ MODULE m_hsfock
TYPE(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_hybrid),INTENT(INOUT) :: hybrid
TYPE(t_obsolete),INTENT(IN) :: obsolete
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
......@@ -79,23 +76,15 @@ MODULE m_hsfock
! - scalars -
INTEGER,INTENT(IN) :: jsp
INTEGER,INTENT(IN) :: it
INTEGER,INTENT(IN) :: n_size
INTEGER,INTENT(IN) :: irank2 ,isize2,comm
INTEGER,INTENT(IN) :: nkpti ,nk
INTEGER,INTENT(IN) :: maxbands
INTEGER,INTENT(IN) :: mnobd
INTEGER,INTENT(IN) :: gwc
! - arrays -
REAL,INTENT(IN) :: eig_irr(dimension%neigd,nkpti)
#ifdef CPP_INVERSION
REAL,INTENT(INOUT) :: a(dimension%nbasfcn*(dimension%nbasfcn+1)/2)
#else
COMPLEX,INTENT(INOUT) :: a(dimension%nbasfcn*(dimension%nbasfcn+1)/2)
#endif
TYPE(t_hamovlp),INTENT(INOUT)::hamovlp
#if ( !defined(CPP_INVERSION) )
COMPLEX,ALLOCATABLE :: z(:,:)
#else
......@@ -109,9 +98,8 @@ MODULE m_hsfock
INTEGER :: ikpt,ikpt0
INTEGER :: irec
INTEGER :: irecl_olap,irecl_z,irecl_vx
INTEGER :: irecl_gw
INTEGER :: maxndb
INTEGER :: nddb,ndb1,ndb2
INTEGER :: nddb
INTEGER :: nsymop
INTEGER :: nkpt_EIBZ
INTEGER :: ncstd
......@@ -140,19 +128,17 @@ MODULE m_hsfock
#ifdef CPP_INVERSION
REAL ,ALLOCATABLE :: trafo(:,:),invtrafo(:,:)
REAL ,ALLOCATABLE :: ex(:,:),v(:,:),v_x(:),v_xp(:)
REAL ,ALLOCATABLE :: ex(:,:),v(:,:),v_x(:)
REAL ,ALLOCATABLE :: mat_ex(:)
#else
COMPLEX,ALLOCATABLE :: trafo(:,:),invtrafo(:,:)
COMPLEX,ALLOCATABLE :: ex(:,:),v(:,:),v_x(:),v_xp(:)
COMPLEX,ALLOCATABLE :: ex(:,:),v(:,:),v_x(:)
COMPLEX,ALLOCATABLE :: mat_ex(:)
#endif
COMPLEX :: exch(dimension%neigd,dimension%neigd)
COMPLEX,ALLOCATABLE :: carr(:)
COMPLEX,ALLOCATABLE :: rep_c(:,:,:,:,:)
real :: rdum
CALL timestart("total time hsfock")
CALL timestart("symm_hf")
......@@ -266,7 +252,7 @@ MODULE m_hsfock
! HF exchange
CALL timestart("valence exchange calculation")
CALL exchange_valence_hf(&
CALL exchange_valence_hf(&
& nk,kpts,nkpti,nkpt_EIBZ, sym,atoms,hybrid,&
& cell, dimension,input,jsp, hybdat, mnobd, lapw,&
& eig_irr,results,parent,pointer_EIBZ,n_q,wl_iks,&
......@@ -454,9 +440,11 @@ MODULE m_hsfock
END IF ! hybrid%l_calhf
! add non-local x-potential to the hamiltonian a
a = a - a_ex*v_x
IF (hamovlp%l_real) THEN
hamovlp%a_r = hamovlp%a_r - a_ex*v_x
ELSE
hamovlp%a_c = hamovlp%a_c - a_ex*v_x
ENDIF
! calculate HF energy
IF( hybrid%l_calhf ) THEN
WRITE(6,'(A)') new_line('n')//new_line('n')//' ### '// ' diagonal HF exchange elements (eV) ###'
......@@ -474,51 +462,20 @@ MODULE m_hsfock
! calculate exchange contribution of current k-point nk to total energy (te_hfex)
! in the case of a spin-unpolarized calculation the factor 2 is added in eigen_hf.F
IF( input%gw .eq.2 .and. gwc .eq. 1 ) THEN
exch = 0
ALLOCATE( carr(ic),stat=ok )
IF( ok .ne. 0 ) STOP 'hsfock: error allocation carr'
DO iband1 = 1,hybdat%nbands(nk)
carr = matvec(v_x(:ic1),z(:ic,iband1))
DO iband2 = 1,iband1
exch(iband2,iband1) = dotprod(z(:ic,iband2),carr(:ic))
exch(iband1,iband2) = conjg(exch(iband2,iband1))
END DO
END DO
DO iband = 1,hybdat%nbands(nk)
IF( iband .le. hybdat%nobd(nk) ) THEN
exch = 0
DO iband = 1,hybdat%nbands(nk)
exch(iband,iband) = dotprod(z(:ic,iband),matvec(v_x(:ic1),z(:ic,iband)))
IF( iband .le. hybdat%nobd(nk) ) THEN
results%te_hfex%valence = results%te_hfex%valence -&
& a_ex*results%w_iks(iband,nk,jsp)*exch(iband,iband)
END IF
IF(hybrid%l_calhf) THEN
& a_ex*results%w_iks(iband,nk,jsp)*exch(iband,iband)
END IF
IF(hybrid%l_calhf) THEN
WRITE(6, '( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,4X,3F10.5)')&
& kpts%bk(:,nk),iband, (REAL(exch(iband,iband))-div_vv(iband))*(-27.211608),&
& div_vv(iband)*(-27.211608),REAL(exch(iband,iband))*(-27.211608)
END IF
END DO
! write exch(:,:) to file gw_vxnl
irec = (jsp-1)*nkpti + nk
irecl_gw = dimension%neigd*dimension%neigd*16
OPEN(unit=778,file='gw_vxnl',access='direct',recl=irecl_gw)
WRITE(778,rec=irec) -exch
CLOSE(778)
ELSE
exch = 0
DO iband = 1,hybdat%nbands(nk)
exch(iband,iband) = dotprod(z(:ic,iband),matvec(v_x(:ic1),z(:ic,iband)))
IF( iband .le. hybdat%nobd(nk) ) THEN
results%te_hfex%valence = results%te_hfex%valence -&
& a_ex*results%w_iks(iband,nk,jsp)*exch(iband,iband)
END IF
IF(hybrid%l_calhf) THEN
WRITE(6, '( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,4X,3F10.5)')&
& kpts%bk(:,nk),iband, (REAL(exch(iband,iband))-div_vv(iband))*(-27.211608),&
& div_vv(iband)*(-27.211608),REAL(exch(iband,iband))*(-27.211608)
END IF
END DO
END IF
& kpts%bk(:,nk),iband, (REAL(exch(iband,iband))-div_vv(iband))*(-27.211608),&
& div_vv(iband)*(-27.211608),REAL(exch(iband,iband))*(-27.211608)
END IF
END DO
DEALLOCATE( z,v_x )
......
This source diff could not be displayed because it is too large. You can view the blob instead.
MODULE m_subvxc
CONTAINS
SUBROUTINE subvxc(&
lapw,bk,&
dimension,input,jsp,vr0,&