Commit 6276e9a5 authored by Daniel Wortmann's avatar Daniel Wortmann

First collection of hybrid functional routines added

parent 563c6b3a
......@@ -31,7 +31,7 @@ include(inpgen/CMakeLists.txt)
include(docs/CMakeLists.txt)
include(tests/CMakeLists.txt)
include(mpi/CMakeLists.txt)
include(hybrid/CMakeLists.txt)
#include(wannier/CMakeLists.txt)
......
......@@ -30,6 +30,8 @@ CONTAINS
USE m_usetup
USE m_pot_io
USE m_eigen_diag
USE m_eigen_hf_init
USE m_eigen_hf_setup
#ifdef CPP_NOTIMPLEMENTED
USE m_symm_hf, ONLY : symm_hf_nkpt_EIBZ
USE m_gen_bz
......@@ -57,7 +59,7 @@ CONTAINS
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_hybrid),INTENT(IN) :: hybrid
TYPE(t_hybrid),INTENT(INOUT) :: hybrid
TYPE(t_enpara),INTENT(INOUT) :: enpara_in
TYPE(t_obsolete),INTENT(IN) :: obsolete
TYPE(t_input),INTENT(IN) :: input
......@@ -137,8 +139,10 @@ CONTAINS
INTEGER :: maxindxc,mnobd
INTEGER :: maxfac
INTEGER :: maxbands
LOGICAL :: l_hybrid
! - local arrays -
TYPE(t_hybdat) :: hybdat
INTEGER :: comm(kpts%nkpt),irank2(kpts%nkpt),isize2(kpts%nkpt)
#ifdef CPP_NEVER
INTEGER :: nobd(kpts%nkptf)
INTEGER :: lmaxc(atoms%ntype)
......@@ -148,7 +152,6 @@ CONTAINS
INTEGER , ALLOCATABLE :: nindxc(:,:)
INTEGER , ALLOCATABLE :: kveclo_eig(:,:)
INTEGER , ALLOCATABLE :: nbasm(:)
INTEGER :: comm(kpts%nkpt),irank2(kpts%nkpt),isize2(kpts%nkpt)
REAL :: el_eig(0:atoms%lmaxd,atoms%ntype), ello_eig(atoms%nlod,atoms%ntype),rarr(3)
REAL :: bas1_MT(hybrid%maxindx,0:atoms%lmaxd,atoms%ntype)
REAL :: drbas1_MT(hybrid%maxindx,0:atoms%lmaxd,atoms%ntype)
......@@ -195,14 +198,14 @@ CONTAINS
! ..
nbands = 0
bas1 = 0 ; bas2 = 0
l_hybrid = (&
hybrid%l_hybrid = (&
xcpot%icorr == icorr_pbe0 .OR.&
xcpot%icorr == icorr_hse .OR.&
xcpot%icorr == icorr_vhse .OR.&
xcpot%icorr == icorr_hf .OR.&
xcpot%icorr == icorr_exx)
l_real=sym%invs.AND..NOT.noco%l_noco
IF (noco%l_soc.AND.l_real.AND.l_hybrid ) THEN
IF (noco%l_soc.AND.l_real.AND.hybrid%l_hybrid ) THEN
CALL juDFT_error('hybrid functional + SOC + inv.symmetry is not tested', calledby='eigen')
END IF
......@@ -290,7 +293,7 @@ CONTAINS
ENDIF
!
CALL eigen_hf_init(hybrid,kpts,sym,atoms,input,dimension,hybdat,irank2,isize2)
!---> set up and solve the eigenvalue problem
!---> loop over energy windows
......@@ -325,7 +328,7 @@ CONTAINS
IF (matsize<2) CALL judft_error("Wrong size of matrix",calledby="eigen",hint="Your basis might be too large or the parallelization fail or ??")
ne = MAX(5,DIMENSION%neigd)
IF (l_hybrid.OR.hybrid%l_calhf) THEN
IF (hybrid%l_hybrid.OR.hybrid%l_calhf) THEN
eig_id_hf=eig_id
ENDIF
eig_id=open_eig(&
......@@ -391,9 +394,8 @@ CONTAINS
!---> loop over k-points: each can be a separate task
DO jsp = 1,nspins
!+do
!-do
CALL eigen_HF_setup(hybrid,input,sym,kpts,dimension,atoms,mpi,noco,cell,oneD,results,jsp,eig_id_hf,&
hybdat,irank2,it,vr0)
!
!---> set up k-point independent t(l'm',lm) matrices
......@@ -480,7 +482,7 @@ CONTAINS
ENDIF
!
#ifdef CPP_NOTIMPLEMENTED
IF( l_hybrid ) THEN
IF( hybrid%l_hybrid ) THEN
CALL hsfock(nk,atoms,lcutm,obsolete,lapw, DIMENSION,kpts,jsp,input,hybrid,maxbasm,&
maxindxp,maxlcutm,maxindxm,nindxm, basm,bas1,bas2,bas1_MT,drbas1_MT,ne_eig,eig_irr,&
......@@ -496,7 +498,7 @@ CONTAINS
oneD, vr(:,:,:,jsp),vpw(:,jsp), a)
END IF
END IF ! l_hybrid
END IF ! hybrid%l_hybrid
#endif
!
!---> update with vacuum terms
......@@ -700,7 +702,7 @@ ENDIF
ENDIF
! hf: write out radial potential vr0
IF (l_hybrid.OR.hybrid%l_calhf) THEN
IF (hybrid%l_hybrid.OR.hybrid%l_calhf) THEN
OPEN(unit=120,file='vr0',form='unformatted')
DO isp=1,DIMENSION%jspd
DO nn=1,atoms%ntype
......@@ -717,11 +719,11 @@ ENDIF
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#endif
IF (l_hybrid.OR.hybrid%l_calhf) CALL close_eig(eig_id_hf)
IF (hybrid%l_hybrid.OR.hybrid%l_calhf) CALL close_eig(eig_id_hf)
atoms%n_u=n_u_in
IF( input%jspins .EQ. 1 .AND. l_hybrid ) THEN
IF( input%jspins .EQ. 1 .AND. hybrid%l_hybrid ) THEN
results%te_hfex%valence = 2*results%te_hfex%valence
results%te_hfex%core = 2*results%te_hfex%core
END IF
......
......@@ -267,8 +267,6 @@
REAL,ALLOCATABLE ::bk(:,:)
!(nkpts) weights
REAL,ALLOCATABLE ::wtkpt(:)
INTEGER, ALLOCATABLE :: pntgptd(:)
INTEGER, ALLOCATABLE :: pntgpt(:,:,:,:,:)
INTEGER :: nkptf !<k-vectors in full BZ
INTEGER :: nkpt3(3)
REAL ,ALLOCATABLE :: bkf(:,:)
......@@ -396,13 +394,14 @@
END TYPE
TYPE t_hybrid
LOGICAL :: l_hybrid
INTEGER :: ewaldlambda
INTEGER :: lexp
INTEGER :: bands1
INTEGER :: bands2
INTEGER(4) :: maxlcutm1
INTEGER(4) :: maxindxm1
INTEGER(4) :: maxbasm1
INTEGER :: bands1 !Only read in
INTEGER :: bands2 !Only read in
INTEGER :: maxlcutm1
INTEGER :: maxindxm1
INTEGER :: maxbasm1
INTEGER :: maxlcutm2
INTEGER :: maxindxm2
INTEGER :: maxbasm2
......@@ -415,9 +414,9 @@
INTEGER :: maxlmindx
INTEGER :: gptmd
INTEGER,ALLOCATABLE :: nindx(:,:)
INTEGER(4),ALLOCATABLE:: select1(:,:)
INTEGER(4),ALLOCATABLE:: lcutm1(:)
INTEGER(4),ALLOCATABLE:: select2(:,:)
INTEGER,ALLOCATABLE :: select1(:,:)
INTEGER,ALLOCATABLE :: lcutm1(:)
INTEGER,ALLOCATABLE :: select2(:,:)
INTEGER,ALLOCATABLE :: lcutm2(:)
INTEGER,ALLOCATABLE :: nindxm1(:,:)
INTEGER,ALLOCATABLE :: nindxm2(:,:)
......@@ -433,20 +432,45 @@
INTEGER,ALLOCATABLE :: lcutwf(:)
INTEGER,ALLOCATABLE :: map(:,:)
INTEGER,ALLOCATABLE :: tvec(:,:,:)
REAL(8) :: radshmin
REAL :: radshmin
REAL :: gcutm1
REAL :: gcutm2
REAL :: tolerance1
REAL :: tolerance2
REAL(8),ALLOCATABLE :: ddist(:)
REAL :: tolerance1 !only read in
REAL :: tolerance2 !only read in
REAL ,ALLOCATABLE :: ddist(:)
REAL ,ALLOCATABLE :: basm1(:,:,:,:)
REAL ,ALLOCATABLE :: basm2(:,:,:,:)
COMPLEX,ALLOCATABLE :: d_wgn2(:,:,:,:)
LOGICAL :: l_subvxc
LOGICAL :: l_calhf
LOGICAL,ALLOCATABLE :: l_exxc(:,:)
END TYPE
END TYPE t_hybrid
TYPE prodtype
INTEGER :: l1,l2,n1,n2
END TYPE prodtype
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(:)
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(:,:,:,:)
END type t_hybdat
TYPE t_dimension
INTEGER :: jspd
INTEGER :: nspd
......
set(fleur_F90 ${fleur_F90}
hybrid/abcrot.F90 hybrid/exchange_core.F90 hybrid/mixedbasis.F90 hybrid/symmetrizeh.F90
hybrid/checkolap.F90 hybrid/exchange_val_hf.F90 hybrid/read_core.F90 hybrid/wavefproducts.F90
hybrid/coulombmatrix.F90 hybrid/gen_wavf.F90 hybrid/spmvec.F90
hybrid/eigen_HF_init.F90 hybrid/hsfock.F90 hybrid/subvxc.F90
hybrid/eigen_HF_setup.F90 hybrid/kp_perturbation.F90 hybrid/symm_hf.F90
)
SUBROUTINE abcrot(atoms,neig,sym,cell,oneD,&
& acof,bcof,ccof)
! ***************************************************************
! * This routine transforms a/b/cof which are given wrt rotated *
! * MT functions (according to invsat/ngopr) into a/b/cof wrt *
! * unrotated MT functions. Needed for GW calculations. *
! * *
! * Christoph Friedrich Mar/2005 *
! ***************************************************************
USE m_dwigner
USE m_types
IMPLICIT NONE
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_sym),INTENT(INOUT) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: neig
! ..
! .. Array Arguments ..
COMPLEX, INTENT (INOUT) :: acof(:,0:,:) !(dimension%neigd,0:dimension%lmd,atoms%natd)
COMPLEX, INTENT (INOUT) :: bcof(:,0:,:) !(dimension%neigd,0:dimension%lmd,atoms%natd)
COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,dimension%neigd,atoms%nlod,atoms%natd)
! ..
! .. Local Scalars ..
INTEGER itype,ineq,iatom,iop,ilo,i,l ,lm,lmp,ifac
! ..
! .. Local Arrays ..
!***** COMPLEX, ALLOCATABLE :: d_wgn(:,:,:,:) !put into module m_savewigner
!
IF ( .NOT.ALLOCATED(sym%d_wgn) ) THEN !calculate sym%d_wgn only once
#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
ENDIF
iatom=0
DO itype=1,atoms%ntype
DO ineq=1,atoms%neq(itype)
iatom=iatom+1
IF (.NOT.oneD%odi%d1) THEN
iop=atoms%ngopr(iatom)
ELSE
iop=oneD%ods%ngopr(iatom)
ENDIF
! l l l
! inversion of spherical harmonics: Y (pi-theta,pi+phi) = (-1) * Y (theta,phi)
! m m
ifac = 1
IF(atoms%invsat(iatom).EQ.2) THEN
IF (.NOT.oneD%odi%d1) THEN
iop=atoms%ngopr(sym%invsatnr(iatom))
ELSE
iop=oneD%ods%ngopr(sym%invsatnr(iatom))
ENDIF
ifac = -1
ENDIF
DO l=1,atoms%lmax(itype)
! replaced d_wgn by conjg(d_wgn),FF October 2006
DO i=1,neig
acof(i,l**2:l*(l+2),iatom) = ifac**l * matmul(conjg(sym%d_wgn(-l:l,-l:l,l,iop)), acof(i,l**2:l*(l+2),iatom))
bcof(i,l**2:l*(l+2),iatom) = ifac**l * matmul(conjg(sym%d_wgn(-l:l,-l:l,l,iop)), bcof(i,l**2:l*(l+2),iatom))
ENDDO
ENDDO
DO ilo=1,atoms%nlo(itype)
l=atoms%llo(ilo,itype)
IF(l.gt.0) THEN
DO i=1,neig
ccof(-l:l,i,ilo,iatom) = ifac**l * matmul(conjg(sym%d_wgn(-l:l,-l:l,l,iop)), ccof(-l:l,i,ilo,iatom))
ENDDO
ENDIF
ENDDO
ENDDO
ENDDO
END
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
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)
USE m_types
USE m_read_core
USE m_util
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
LOGICAL,SAVE :: init_vex=.true.
INTEGER,SAVE :: nohf_it
integer:: itype,ieq,l,m,i,nk,l1,l2,m1,m2,ok
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
hybrid%l_calhf = .true.
init_vex = .false.
nohf_it = 0
ELSE IF( input%imix .lt. 10 ) THEN
hybrid%l_calhf = .true.
init_vex = .true.
nohf_it = 0
ELSE
hybrid%l_calhf = .false.
nohf_it = nohf_it + 1
END IF
IF( hybrid%l_calhf ) THEN
!initialize hybdat%gridf for radial integration
CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
!sym%tau = oneD%ods%tau
! preparations for core states
CALL core_init(dimension,input,atoms, hybdat%lmaxcd,hybdat%maxindxc)
ALLOCATE( hybdat%nindxc(0:hybdat%lmaxcd,atoms%ntype), stat = ok )
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation hybdat%nindxc'
ALLOCATE( hybdat%core1(atoms%jmtd,hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype), stat=ok )
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation core1'
ALLOCATE( hybdat%core2(atoms%jmtd,hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype), stat=ok )
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation core2'
ALLOCATE( hybdat%eig_c(hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype), stat=ok )
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation hybdat%eig_c'
hybdat%nindxc = 0 ; hybdat%core1 = 0 ; hybdat%core2 = 0 ; hybdat%eig_c = 0
! determine the size of the mixed basis at each k-point
! ( can be done in mixedbasis only once)
hybdat%nbasp = 0
DO itype=1,atoms%ntype
DO ieq=1,atoms%neq(itype)
DO l=0,hybrid%lcutm1(itype)
DO m=-l,l
DO i=1,hybrid%nindxm1(l,itype)
hybdat%nbasp = hybdat%nbasp + 1
END DO
END DO
END DO
END DO
END DO
ALLOCATE( hybdat%nbasm(kpts%nkptf) ,stat=ok)
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation hybdat%nbasm'
DO nk = 1,kpts%nkptf
hybdat%nbasm(nk) = hybdat%nbasp + hybrid%ngptm(nk)
END DO
! pre-calculate gaunt coefficients
hybdat%maxfac = max(2*atoms%lmaxd+hybrid%maxlcutm1+1,2*hybdat%lmaxcd+2*atoms%lmaxd+1)
ALLOCATE ( hybdat%fac( 0:hybdat%maxfac),hybdat%sfac( 0:hybdat%maxfac),stat=ok)
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation fac,hybdat%sfac'
hybdat%fac(0) = 1
hybdat%sfac(0) = 1
DO i=1,hybdat%maxfac
hybdat%fac(i) = hybdat%fac(i-1)*i ! hybdat%fac(i) = i!
hybdat%sfac(i) = hybdat%sfac(i-1)*sqrt(i*1d0) ! hybdat%sfac(i) = sqrt(i!)
END DO
ALLOCATE ( hybdat%gauntarr( 2, 0:atoms%lmaxd, 0:atoms%lmaxd, 0:hybrid%maxlcutm1, -atoms%lmaxd:atoms%lmaxd ,-hybrid%maxlcutm1:hybrid%maxlcutm1 ),stat=ok)
IF( ok .ne. 0 ) STOP 'eigen: failure allocation hybdat%gauntarr'
hybdat%gauntarr = 0
DO l2 = 0,atoms%lmaxd
DO l1 = 0,atoms%lmaxd
DO l = abs(l1-l2),min(l1+l2,hybrid%maxlcutm1)
DO m = -l,l
DO m1 = -l1,l1
m2 = m1 + m ! Gaunt condition -m1+m2-m = 0
IF(abs(m2).le.l2) hybdat%gauntarr(1,l1,l2,l,m1,m) = gaunt(l1,l2,l,m1,m2,m,hybdat%maxfac,hybdat%fac,hybdat%sfac)
m2 = m1 - m ! switch role of l2-index
IF(abs(m2).le.l2) hybdat%gauntarr(2,l1,l2,l,m1,m) = gaunt(l2,l1,l,m2,m1,m,hybdat%maxfac,hybdat%fac,hybdat%sfac)
END DO
END DO
END DO
END DO
END DO
END IF ! hybrid%l_calhf
#ifdef CPP_NEVER
!# ifdef CPP_MPI
IF ( hybrid%l_calhf ) THEN
ALLOCATE( nkpt_EIBZ(kpts%nkpt) )
DO nk = 1,kpts%nkpt
nkpt_EIBZ(nk) = symm_hf_nkpt_EIBZ(kpts%nkptf,kpts%nkpt3,nk,kpts%bkf,sym%nsym, sym%nop,sym%mrot,sym%invtab)
END DO
comm=init_work_dist(mpi%mpi_comm,mpi%irank,mpi%isize,kpts%nkpt,nkpt_EIBZ)
skip_kpt = ( comm == MPI_COMM_NULL )
DO nk = 1,kpts%nkpt
! determine rank in new communicator and size of the communicator
IF ( skip_kpt(nk) ) THEN
irank2(nk) = MPI_PROC_NULL
ELSE
CALL MPI_COMM_RANK(comm(nk),irank2(nk),ierr(1))
CALL MPI_COMM_SIZE(comm(nk),isize2(nk),ierr(1))
END IF
END DO
ELSE
irank2 = 0
isize2 = 1
skip_kpt = .false.
END IF
# else
irank2 = 0
isize2 = 1
!skip_kpt = .false.
# endif
end subroutine eigen_hf_init
end module m_eigen_hf_init
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -132,8 +132,8 @@
USE m_wann_optional
USE m_wannier
#endif
! USE m_mixedbasis
! USE m_coulomb
USE m_mixedbasis
USE m_coulomb
USE m_gen_map
USE m_dwigner
USE m_gen_bz
......@@ -315,7 +315,7 @@
ENDIF
!HF
#if defined(CPP_HF) && (2==1)
!#if defined(CPP_HF) && (2==1)
hybrid%l_subvxc = ( xcpot%icorr == icorr_hf .OR. xcpot%icorr == icorr_pbe0 .OR.&
& xcpot%icorr == icorr_hse .OR. xcpot%icorr == icorr_vhse )
......@@ -340,33 +340,25 @@
& WRITE(*,'(/A)',advance='no')&
& ' calculation of mixedbasis...'
IF (it==1)&
& eig_id=open_eig(&
& mpi%mpi_comm,dimension%nbasfcn,dimension%neigd,kpts%nkpt(1),dimension%jspd,atoms%lmaxd,atoms%nlod,atoms%ntype,atoms%nlotot&
& ,noco%l_noco,.FALSE.,.FALSE.)
! CALL open_eig(mpi_comm,
! > nbasfcn,neigd,nkpt(1),jspd,lmaxd,nlod,ntypd,nlotot,
! > l_noco,.false.,.true.)
STOP "open_eig in fleur.F"
!eig_id=open_eig(&
!mpi%mpi_comm,dimension%nbasfcn,dimension%neigd,kpts%nkpt,dimension%jspd,atoms%lmaxd,atoms%nlod,atoms%ntype,atoms%nlotot&
!,noco%l_noco,.FALSE.,.FALSE.)
!DW TODO! eig_id has to be adjusted here
CALL mixedbasis(atoms,kpts,obsolete,&
& sphhar,dimension,input,&
& enpara,cell,vacuum,sym,&
& oneD,stars,xcpot,hybrid,&
& eig_id,mpi,l_restart)
IF ( irank == 0 ) WRITE(*,'(A)')'...done'
IF ( mpi%irank == 0 )&
& WRITE(*,'(A)',advance='no')&
& ' calculation of coulomb matrix ...'
CALL coulombmatrix(&
& mpi,obsolete,atoms,kpts,&
& cell,sym,hybrid,xcpot,l_restart,&
& oneD)
IF ( irank == 0 ) WRITE(*,'(A)')'...done'
CALL mixedbasis(atoms,kpts,&
sphhar,dimension,input, enpara,cell,vacuum,sym,&
oneD,stars,xcpot,hybrid, eig_id,mpi,l_restart)
IF ( mpi%irank == 0 ) WRITE(*,'(A)')'...done'
IF ( mpi%irank == 0 ) WRITE(*,'(A)',advance='no') ' calculation of coulomb matrix ...'
CALL coulombmatrix(mpi,atoms,kpts,&
cell,sym,hybrid,xcpot,l_restart)
IF ( mpi%irank == 0 ) WRITE(*,'(A)')'...done'
!calculate whole Brilloun zone
CALL gen_bz(kpts,sym)
#ifdef CPP_MPI
CALL MPI_Bcast( hybrid%maxbasm1,1,MPI_INTEGER4,0,&
& mpi%mpi_comm,ierr(1) )
CALL MPI_Bcast( hybrid%radshmin,1,MPI_REAL8, 0,&
& mpi%mpi_comm,ierr(1) )
CALL MPI_Bcast( hybrid%maxbasm1,1,MPI_INTEGER4,0, mpi%mpi_comm,ierr(1) )
CALL MPI_Bcast( hybrid%radshmin,1,MPI_REAL8, 0, mpi%mpi_comm,ierr(1) )
#endif
CALL timestop("generation of mixedbasis and coulombmatrix")
......@@ -375,11 +367,9 @@
input%zelec = input%zelec * 2
END IF
IF ( mpi%irank == 0 )&
& WRITE(*,'(A)',advance='no') ' start fermie....'
CALL fermie(eig_id,&
& mpi,dimension,kpts,obsolete,atoms,&
& input,noco,results,jij,cell)
IF ( mpi%irank == 0 ) WRITE(*,'(A)',advance='no') ' start fermie....'
CALL fermie(eig_id, mpi,kpts,obsolete,&
input,noco,enpara%epara_min,jij,cell,results)
IF ( noco%l_soc ) THEN
input%zelec = input%zelec / 2
......@@ -397,11 +387,11 @@
hybrid%maxgptm1 = 0; hybrid%maxgptm2 = 0; hybrid%maxindxm1 = 0; hybrid%maxindxm2 = 0
hybrid%maxlcutm1 = 0; hybrid%maxlcutm2 = 0; hybrid%maxindxp1 = 0; hybrid%maxindxp2 = 0
ALLOCATE(hybrid%gptm(0,0),hybrid%ngptm(0),hybrid%pgptm(0,0),hybrid%ngptm1(0),&
& hybrid%pgptm1(0,0),hybrid%ngptm2(0),hybrid%pgptm2(0,0),hybrid%basm1(0,0,0,0),&
& hybrid%basm2(0,0,0,0),hybrid%nindxm1(0,0),hybrid%nindxm2(0,0))
hybrid%pgptm1(0,0),hybrid%ngptm2(0),hybrid%pgptm2(0,0),hybrid%basm1(0,0,0,0),&
hybrid%basm2(0,0,0,0),hybrid%nindxm1(0,0),hybrid%nindxm2(0,0))
END IF ! first iteration hybrids
!HF
#endif
!#endif
IF (.NOT.obsolete%pot8) THEN
CALL timestart("generation of potential")
......@@ -529,12 +519,12 @@
CALL rotate_eig(&
& kpts,dimension,atoms,&
& sym,mpi)
#endif
DEALLOCATE( kpts%pntgptd, kpts%pntgpt )
! this change is sufficient to modify fermie and c
! the enlarged kpt mesh
kpts%nkpt = kpts%nkptf
kpts%nkpt = kpts%nkptf
#endif
END IF
ENDIF
......
......@@ -10,6 +10,10 @@ c return type of the pure intgrf function
INTEGER :: ierror ! error code
END TYPE intgrf_out
INTERFACE derivative
MODULE PROCEDURE:: derivative_t,derivative_nt
END INTERFACE
CONTAINS
......@@ -427,7 +431,19 @@ c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Returns derivative of f in df.
SUBROUTINE derivative(df,f,jmtd,jri,dx,rmsh,ntype,itype)
SUBROUTINE derivative_t(df,f,atoms,itype)
USE m_types
IMPLICIT NONE
REAL, INTENT(IN) :: f(:)
REAL, INTENT(OUT) :: df(:)
TYPE(t_atoms),INTENT(IN)::atoms
INTEGER,INTENT(IN) :: itype
call derivative_nt(df,f,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,
+ atoms%ntype,itype)
END SUBROUTINE
SUBROUTINE derivative_nt(df,f,jmtd,jri,dx,rmsh,ntype,itype)
IMPLICIT NONE
......@@ -481,7 +497,7 @@ c Returns derivative of f in df.
& - d41*d42 / (d31*d32*d43) * f(n-1)
& + ( 1d0/d41 + 1d0/d42 + 1d0/d43 ) * f(n)
END SUBROUTINE derivative
END SUBROUTINE derivative_nt
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
......
......@@ -11,11 +11,9 @@ xc-pot/excwb91.f
xc-pot/gaunt.f
xc-pot/grdchlh.f
xc-pot/mkgl0.f
xc-pot/olap.F
xc-pot/pbecor2.f
xc-pot/potl0.f
xc-pot/relcor.f
xc-pot/trafo.F
xc-pot/vxcepbe.f
xc-pot/vxcl91.f
xc-pot/vxcpw91.f
......@@ -31,6 +29,8 @@ xc-pot/xcwgn.f
xc-pot/xcxal.f
)
set(fleur_F90 ${fleur_F90}
xc-pot/trafo.F90
xc-pot/exponential_integral.f90
xc-pot/hsefunctional.F90
xc-pot/olap.F90
)
This diff is collapsed.
This diff is collapsed.
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