Commit c3d29487 authored by Daniel Wortmann's avatar Daniel Wortmann

Bugfixes, put swapped some variables between hybrid/hybdat datatype, moved...

Bugfixes, put swapped some variables between hybrid/hybdat datatype, moved files from xc-pot to hybrid
parent 17b9ba12
......@@ -206,14 +206,12 @@ 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 (.not.hybrid%l_calhf) THEN
eig_id=open_eig(&
mpi%mpi_comm,DIMENSION%nbasfcn,DIMENSION%neigd,kpts%nkpt,DIMENSION%jspd,atoms%lmaxd,&
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,.TRUE.,l_real,noco%l_soc,.FALSE.,&
mpi%n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=DIMENSION%nstd,&
nsld=atoms%nat,nat=atoms%nat,l_dos=banddos%dos.OR.input%cdinf,l_mcd=banddos%l_mcd,&
l_orb=banddos%l_orb)
endif
IF (l_real) THEN
ALLOCATE ( hamOvlp%a_r(matsize), stat = err )
ELSE
......@@ -345,8 +343,6 @@ CONTAINS
if (hybrid%l_addhf) CALL add_Vnonlocal(nk,hybrid,dimension, kpts,jsp,results,xcpot,hamovlp)
IF ( irank2(nk) /= 0 ) CYCLE
IF( hybrid%l_subvxc ) THEN
CALL subvxc(lapw,kpts%bk(:,nk),DIMENSION,input,jsp,v%mt(:,0,:,:),atoms,ud,hybrid,enpara%el0,enpara%ello0,&
sym, atoms%nlotot,kveclo, cell,sphhar, stars, xcpot,mpi,&
......
......@@ -422,7 +422,6 @@ MODULE m_types
INTEGER,ALLOCATABLE :: pgptm1(:,:)
INTEGER,ALLOCATABLE :: ngptm (:)
INTEGER,ALLOCATABLE :: pgptm (:,:)
INTEGER,ALLOCATABLE :: nindxp1(:,:)
INTEGER,ALLOCATABLE :: lcutwf(:)
INTEGER,ALLOCATABLE :: map(:,:)
INTEGER,ALLOCATABLE :: tvec(:,:,:)
......@@ -454,7 +453,8 @@ MODULE m_types
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
INTEGER,ALLOCATABLE :: nindxp1(:,:)
END TYPE t_hybdat
TYPE t_dimension
INTEGER :: jspd
......
......@@ -3,5 +3,12 @@ hybrid/abcrot.F90 hybrid/exchange_core.F90 hybrid/mixedbasis.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/hybrid.F90
hybrid/HF_init.F90 hybrid/hsfock.F90 hybrid/subvxc.F90 hybrid/add_Vnonlocal.F90
hybrid/hf_setup.F90 hybrid/kp_perturbation.F90 hybrid/symm_hf.F90
hybrid/hf_setup.F90 hybrid/kp_perturbation.F90 hybrid/symm_hf.F90 hybrid/trafo.F90
hybrid/exponential_integral.f90
hybrid/hsefunctional.F90
hybrid/olap.F90
)
set(fleur_F77 ${fleur_F77}
hybrid/wrapper.F
)
......@@ -31,8 +31,6 @@ CONTAINS
!Alloc variables
ALLOCATE(hybdat%lmaxc(atoms%ntype))
ALLOCATE(hybrid%ne_eig(kpts%nkpt),hybrid%nbands(kpts%nkpt))
ALLOCATE(hybrid%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))
......
......@@ -82,7 +82,8 @@ MODULE m_add_vnonlocal
a_ex=get_exchange_weight(xcpot%icorr)
v_x%l_real=hamovlp%l_real
v_x%matsize1=dimension%nbasfcn
CALL read_v_x(v_x,kpts%nkpt*(jsp-1) + nk)
! add non-local x-potential to the hamiltonian a (in packed storage)
......
......@@ -224,12 +224,14 @@
phase_vv=0
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation phase'
if (mat_ex%l_real) THEN
ALLOCATE( cprod_vv_c(0,0,0), carr3_vv_c(0,0,0))
ALLOCATE( cprod_vv_r(hybrid%maxbasm1,psize,hybrid%nbands(nk)),stat=ok )
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation cprod'
ALLOCATE( carr3_vv_r(hybrid%maxbasm1,psize,hybrid%nbands(nk)),stat=ok )
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation carr3'
cprod_vv_r = 0 ; carr3_vv_r = 0
ELSE
ALLOCATE( cprod_vv_r(0,0,0), carr3_vv_r(0,0,0))
ALLOCATE( cprod_vv_c(hybrid%maxbasm1,psize,hybrid%nbands(nk)),stat=ok )
IF( ok .ne. 0 ) STOP 'exchange_val_hf: error allocation cprod'
ALLOCATE( carr3_vv_c(hybrid%maxbasm1,psize,hybrid%nbands(nk)),stat=ok )
......@@ -249,9 +251,9 @@
! read in coulomb matrix from direct access file coulomb
#if( !defined CPP_NOSPMVEC && !defined CPP_IRAPPROX )
if (mat_ex%l_real) THEN
call read_coulomb_spm_r(ikpt0,coulomb_mt1,coulomb_mt2_r,coulomb_mt3_r,coulomb_mtir_r)
call read_coulomb_spm_r(kpts%bkp(ikpt0),coulomb_mt1,coulomb_mt2_r,coulomb_mt3_r,coulomb_mtir_r)
else
call read_coulomb_spm_c(ikpt0,coulomb_mt1,coulomb_mt2_c,coulomb_mt3_c,coulomb_mtir_c)
call read_coulomb_spm_c(kpts%bkp(ikpt0),coulomb_mt1,coulomb_mt2_c,coulomb_mt3_c,coulomb_mtir_c)
end if
#else
call read_coulomb(kpts%bkp(ikpt0),coulomb)
......
......@@ -143,20 +143,7 @@
! eigen_hf writes spherical component in file vr0
! if it = 1 vr0 is identical to the potential of the
! previous calculation
IF( it .ne. 1) THEN
OPEN(unit=220,file='vr0',form='unformatted')
DO ispin=1,dimension%jspd
DO itype=1,atoms%ntype
DO i=1,atoms%jmtd
READ(220) vr(i,itype,ispin)
END DO
END DO
END DO
CLOSE(220)
ELSE
vr = vr0
END IF
vr = vr0
! ALLOCATE ( z_out(nbasfcn,neigd,nkpti),stat=ok )
......
......@@ -255,8 +255,8 @@ CONTAINS
IF( ok .NE. 0 ) STOP 'eigen_hf: failure allocation hybdat%prod'
basprod = 0 ; hybdat%prodm = 0 ; hybdat%prod%l1 = 0 ; hybdat%prod%l2 = 0
hybdat%prod%n1 = 0 ; hybdat%prod%n2 = 0
ALLOCATE(hybrid%nindxp1(0:hybrid%maxlcutm1,atoms%ntype))
hybrid%nindxp1 = 0
ALLOCATE(hybdat%nindxp1(0:hybrid%maxlcutm1,atoms%ntype))
hybdat%nindxp1 = 0
DO itype = 1,atoms%ntype
ng = atoms%jri(itype)
DO l2 = 0,MIN(atoms%lmax(itype),hybrid%lcutwf(itype))
......@@ -272,8 +272,8 @@ CONTAINS
basprod(:ng) = ( hybdat%bas1(:ng,n1,l1,itype)*hybdat%bas1(:ng,n2,l2,itype) +hybdat%bas2(:ng,n1,l1,itype)*hybdat%bas2(:ng,n2,l2,itype)) / atoms%rmsh(:ng,itype)
DO l = ABS(l1-l2),MIN(hybrid%lcutm1(itype),l1+l2)
IF(MOD(l1+l2+l,2).EQ.0) THEN
hybrid%nindxp1(l,itype) = hybrid%nindxp1(l,itype) + 1
n = hybrid%nindxp1(l,itype)
hybdat%nindxp1(l,itype) = hybdat%nindxp1(l,itype) + 1
n = hybdat%nindxp1(l,itype)
hybdat%prod(n,l,itype)%l1 = l1
hybdat%prod(n,l,itype)%l2 = l2
hybdat%prod(n,l,itype)%n1 = n1
......
......@@ -43,6 +43,7 @@ CONTAINS
REAL, ALLOCATABLE :: eig_irr(:,:)
real :: bkpt(3)
CALL open_hybrid_io1(DIMENSION,sym%invs)
IF (kpts%nkptf==0) CALL judft_error("kpoint-set of full BZ not available",hint="to generate kpts in the full BZ you should specify a k-mesh in inp.xml")
!Check if new non-local potential shall be generated
......@@ -50,25 +51,22 @@ CONTAINS
hybrid%l_subvxc = ( hybrid%l_hybrid.AND.xcpot%icorr /= icorr_exx )
IF (.NOT.ALLOCATED(v%pw)) THEN
hybrid%l_calhf=.FALSE.
INQUIRE(file="v_x.mat",exist=hybrid%l_addhf)
!INQUIRE(file="v_x.mat",exist=hybrid%l_addhf)
hybrid%l_addhf=.false.
hybrid%l_subvxc = ( hybrid%l_subvxc .AND. hybrid%l_addhf)
RETURN
ENDIF
hybrid%l_addhf=.true.
IF( ( init_vex .OR. nohf_it >= 50 ) .AND. input%imix .GT. 10) THEN
! 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
!In first iteration allocate some memory
IF (init_vex) THEN
ALLOCATE(hybrid%ne_eig(kpts%nkpt),hybrid%nbands(kpts%nkpt),hybrid%nobd(kpts%nkptf))
ALLOCATE( hybrid%nbasm(kpts%nkptf))
init_vex=.false.
ENDIF
hybrid%l_calhf = .TRUE.
IF( .NOT. ALLOCATED(results%w_iks) )&
ALLOCATE ( results%w_iks(DIMENSION%neigd2,kpts%nkpt,DIMENSION%jspd) )
......@@ -98,7 +96,7 @@ CONTAINS
CALL timestop("generation of mixed basis")
CALL open_hybrid_io(hybrid,DIMENSION,atoms,sym%invs)
CALL open_hybrid_io2(hybrid,DIMENSION,atoms,sym%invs)
CALL timestart("generation of coulomb matrix")
CALL coulombmatrix(mpi,atoms,kpts,cell,sym,hybrid,xcpot,l_restart)
......
......@@ -869,8 +869,6 @@ CONTAINS
END DO
END DO
hybrid%maxbasm1 = hybrid%nbasp + hybrid%maxgptm
ALLOCATE( hybrid%nbasm(kpts%nkptf) ,stat=ok)
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation hybrid%nbasm'
DO nk = 1,kpts%nkptf
hybrid%nbasm(nk) = hybrid%nbasp + hybrid%ngptm(nk)
END DO
......
......@@ -647,7 +647,7 @@
END IF
rkpt = matmul(rrot,kpts%bk(:,ikpt0))
rkpt = matmul(rrot,kpts%bkf(:,ikpt0))
rkpthlp = rkpt
rkpt = modulo1(rkpt,kpts%nkpt3)
g = nint(rkpthlp-rkpt)
......@@ -681,7 +681,7 @@
! Multiplication
! MT
cexp = exp(img*tpi_const*dot_product( kpts%bk(:,ikpt1)+g,trans(:) ) )
cexp = exp(img*tpi_const*dot_product( kpts%bkf(:,ikpt1)+g,trans(:) ) )
ic = 0
iiatom = 0
DO itype = 1,atoms%ntype
......@@ -733,7 +733,7 @@
WRITE(*,*) g
STOP 'bra_trafo2: G-point not found in G-point set.'
END IF
cdum = exp(img*tpi_const*dot_product(kpts%bk(:,ikpt1)+g1,trans(:)))
cdum = exp(img*tpi_const*dot_product(kpts%bkf(:,ikpt1)+g1,trans(:)))
vecout1(nbasp+igptm,:,:)= cdum * vecin1(nbasp+igptm2,:,:)
END DO
......
......@@ -191,7 +191,7 @@
DO l = 0,hybrid%lcutm1(itype)
DO n = 1,hybrid%nindxp1(l,itype) ! loop over basis-function products
DO n = 1,hybdat%nindxp1(l,itype) ! loop over basis-function products
l1 = hybdat%prod(n,l,itype)%l1 !
l2 = hybdat%prod(n,l,itype)%l2 ! current basis-function product
......@@ -553,7 +553,7 @@
! loop over l of mixed basis
DO l = 0,hybrid%lcutm1(itype)
! loop over basis functions products, which belong to l
DO n = 1,hybrid%nindxp1(l,itype)
DO n = 1,hybdat%nindxp1(l,itype)
! determine l1,p1 and l2,p2 for the basis functions, which can generate l
l1 = hybdat%prod(n,l,itype)%l1
......@@ -674,7 +674,7 @@
DO l = 0,hybrid%lcutm1(itype)
monepl = -monepl
! loop over basis functions products, which belong to l
DO n = 1,hybrid%nindxp1(l,itype)
DO n = 1,hybdat%nindxp1(l,itype)
! determine l1,p1 and l2,p2 for the basis functions, which can generate l
l1 = hybdat%prod(n,l,itype)%l1
......@@ -1577,7 +1577,7 @@
! loop over l of mixed basis
DO l = 0,hybrid%lcutm1(itype)
! loop over basis functions products, which belong to l
DO n = 1,hybrid%nindxp1(l,itype)
DO n = 1,hybdat%nindxp1(l,itype)
! determine l1,p1 and l2,p2 for the basis functions, which can generate l
l1 = hybdat%prod(n,l,itype)%l1
......@@ -1702,7 +1702,7 @@
DO l = 0,hybrid%lcutm1(itype)
monepl = -monepl
! loop over basis functions products, which belong to l
DO n = 1,hybrid%nindxp1(l,itype)
DO n = 1,hybdat%nindxp1(l,itype)
! determine l1,p1 and l2,p2 for the basis functions, which can generate l
l1 = hybdat%prod(n,l,itype)%l1
......@@ -2511,7 +2511,7 @@
DO l = 0,hybrid%lcutm1(itype)
DO n = 1,hybrid%nindxp1(l,itype) ! loop over basis-function products
DO n = 1,hybdat%nindxp1(l,itype) ! loop over basis-function products
l1 = hybdat%prod(n,l,itype)%l1 !
l2 = hybdat%prod(n,l,itype)%l2 ! current basis-function product
......
......@@ -8,23 +8,40 @@ module m_io_hybrid
!public:: open_hybrid_io,read_cmt,write_cmt
contains
subroutine open_hybrid_io(hybrid,dimension,atoms,l_real)
SUBROUTINE open_hybrid_io1(DIMENSION,l_real)
implicit none
TYPE(t_hybrid),INTENT(IN) :: hybrid
TYPE(t_dimension),INTENT(IN):: dimension
TYPE(t_atoms),INTENT(IN) :: atoms
LOGICAL,INTENT(IN) :: l_real
LOGICAL :: opened=.false.
INTEGER:: irecl_coulomb
OPEN(unit=777,file='cmt',form='unformatted',access='direct',&
& recl=dimension%neigd*hybrid%maxlmindx*atoms%nat*16)
if (opened) return
opened=.true.
print *,"Open olap.mat"
id_olap=OPEN_MATRIX(l_real,dimension%nbasfcn,1,"olap.mat")
print *,"Open z.mat"
id_z=OPEN_MATRIX(l_real,dimension%nbasfcn,1,"z.mat")
print *,"Open v_x.mat"
id_v_x=OPEN_MATRIX(l_real,dimension%nbasfcn,1,"v_x.mat")
END SUBROUTINE open_hybrid_io1
SUBROUTINE open_hybrid_io2(hybrid,DIMENSION,atoms,l_real)
IMPLICIT NONE
TYPE(t_hybrid),INTENT(IN) :: hybrid
TYPE(t_dimension),INTENT(IN):: dimension
TYPE(t_atoms),INTENT(IN) :: atoms
LOGICAL,INTENT(IN) :: l_real
INTEGER:: irecl_coulomb
LOGICAL :: opened=.FALSE.
if (opened) return
opened=.true.
OPEN(unit=777,file='cmt',form='unformatted',access='direct',&
& recl=dimension%neigd*hybrid%maxlmindx*atoms%nat*16)
#ifdef CPP_NOSPMVEC
irecl_coulomb = hybrid%maxbasm1 * (hybrid%maxbasm1+1) * 8 / 2
if (.not.l_real) irecl_coulomb =irecl_coulomb *2
......@@ -42,7 +59,7 @@ contains
OPEN(unit=778,file='coulomb1',form='unformatted',access='direct', recl=irecl_coulomb)
id_coulomb_spm=778
#endif
end subroutine open_hybrid_io
END SUBROUTINE open_hybrid_io2
subroutine write_cmt(cmt,nk)
implicit none
......
......@@ -236,7 +236,7 @@
!#endif
IF (.NOT.obsolete%pot8) THEN
CALL timestart("generation of potential")
CALL vgen(reap,input,xcpot,dimension, atoms,sphhar,stars,vacuum,&
CALL vgen(hybrid,reap,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,&
sym,obsolete,cell, oneD,sliceplot,mpi ,results,noco,v,vx)
CALL timestop("generation of potential")
......@@ -519,7 +519,7 @@
reap = .FALSE.
input%total = .FALSE.
CALL timestart("generation of potential (total)")
CALL vgen(reap,input,xcpot,dimension, atoms,sphhar,stars,vacuum,sym,&
CALL vgen(hybrid,reap,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,sym,&
obsolete,cell,oneD,sliceplot,mpi, results,noco,v,vx)
CALL timestop("generation of potential (total)")
......
......@@ -6,7 +6,7 @@
MODULE m_vgen
USE m_juDFT
CONTAINS
SUBROUTINE vgen(reap,input,xcpot,dimension, atoms,sphhar,stars,&
SUBROUTINE vgen(hybrid,reap,input,xcpot,DIMENSION, atoms,sphhar,stars,&
vacuum,sym, obsolete,cell,oneD,sliceplot,mpi, results,noco,v,vx)
! ***********************************************************
! FLAPW potential generator *
......@@ -54,6 +54,7 @@ CONTAINS
IMPLICIT NONE
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_hybrid),INTENT(IN) :: hybrid
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_oneD),INTENT(IN) :: oneD
......@@ -701,8 +702,8 @@ CONTAINS
END IF
!HF kinetic energy correction for core states
IF ( xcpot%icorr == icorr_pbe0 .OR. xcpot%icorr == icorr_hse .OR.&
xcpot%icorr == icorr_hf .OR. xcpot%icorr == icorr_vhse ) THEN
IF ( hybrid%l_addhf.AND.(xcpot%icorr == icorr_pbe0 .OR. xcpot%icorr == icorr_hse .OR.&
xcpot%icorr == icorr_hf .OR. xcpot%icorr == icorr_vhse ) ) THEN
ALLOCATE(rhoc(atoms%jmtd,atoms%ntype,DIMENSION%jspd), rhoc_vx(atoms%jmtd))
ALLOCATE(tec(atoms%ntype,DIMENSION%jspd),qintc(atoms%ntype,DIMENSION%jspd))
CALL readCoreDensity(input,atoms,dimension,rhoc,tec,qintc)
......@@ -721,8 +722,8 @@ CONTAINS
rht(:,:,js),v%vacz(:,:,js), rho(1,0,1,js),veffr(1,0,1,js), results%te_veff)
!HF
IF ( xcpot%icorr == icorr_pbe0 .OR. xcpot%icorr == icorr_hse .OR.&
xcpot%icorr == icorr_hf .OR. xcpot%icorr == icorr_vhse ) THEN
IF (hybrid%l_addhf.and.( xcpot%icorr == icorr_pbe0 .OR. xcpot%icorr == icorr_hse .OR.&
xcpot%icorr == icorr_hf .OR. xcpot%icorr == icorr_vhse ) ) THEN
nat = 1
DO n = 1,atoms%ntype
DO j = 1, atoms%jri(n)
......@@ -747,10 +748,10 @@ CONTAINS
370 CONTINUE
!HF
IF ( xcpot%icorr == icorr_pbe0 .OR. xcpot%icorr == icorr_hse .OR.&
xcpot%icorr == icorr_hf .OR. xcpot%icorr == icorr_vhse ) THEN
DEALLOCATE( rhoc, rhoc_vx )
END IF
!IF ( xcpot%icorr == icorr_pbe0 .OR. xcpot%icorr == icorr_hse .OR.&
! xcpot%icorr == icorr_hf .OR. xcpot%icorr == icorr_vhse ) THEN
! DEALLOCATE( rhoc, rhoc_vx )
!END IF
!HF end kinetic energy correction
DEALLOCATE( veffpw_w,veffr )
......
......@@ -18,7 +18,6 @@ xc-pot/vxcepbe.f
xc-pot/vxcl91.f
xc-pot/vxcpw91.f
xc-pot/vxcwb91.f
xc-pot/wrapper.F
xc-pot/xcall.f
xc-pot/xcallg.f
xc-pot/xcbh.f
......@@ -28,9 +27,4 @@ xc-pot/xcvwn.f
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
)
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