Skip to content

GitLab

fleur
fleur
Commit 09b6c67a authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

More fixes..

parent f10fd0f8
Hide whitespace changes
Inline Side-by-side
Showing with 209 additions and 182 deletions
eigen/apws.F90
View file @ 09b6c67a
......@@ -49,6 +49,11 @@ CONTAINS
REAL, ALLOCATABLE :: rk_help(:)
INTEGER, ALLOCATABLE :: k_help(:,:) ,pos(:)
#endif
IF (.not.allocated(lapw%k1)) THEN
ALLOCATE ( lapw%k1(DIMENSION%nvd,DIMENSION%jspd),lapw%k2(DIMENSION%nvd,DIMENSION%jspd),&
lapw%k3(DIMENSION%nvd,DIMENSION%jspd),lapw%rk(DIMENSION%nvd,DIMENSION%jspd) )
ENDIF
lapw%rk = 0 ; lapw%k1 = 0 ; lapw%k2 = 0 ; lapw%k3 = 0
! ..
! ..
!---> in a spin-spiral calculation different basis sets are used for
......
eigen/eigen.F90
View file @ 09b6c67a
......@@ -82,7 +82,6 @@ CONTAINS
INTEGER nspins,isp,i,j,err
INTEGER mlotot,mlolotot
LOGICAL l_wu,l_file,l_real,l_zref
INTEGER ::eig_id_hf=-1
! ..
! .. Local Arrays ..
......@@ -120,8 +119,7 @@ CONTAINS
call ud%init(atoms,DIMENSION%jspd)
ALLOCATE ( nv2(DIMENSION%jspd) )
ALLOCATE ( eig(DIMENSION%neigd),bkpt(3) )
ALLOCATE ( lapw%k1(DIMENSION%nvd,DIMENSION%jspd),lapw%k2(DIMENSION%nvd,DIMENSION%jspd),&
lapw%k3(DIMENSION%nvd,DIMENSION%jspd),lapw%rk(DIMENSION%nvd,DIMENSION%jspd) )
!
! --> some parameters first
!
......@@ -216,16 +214,14 @@ 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 (hybrid%l_hybrid.OR.hybrid%l_calhf) THEN
eig_id_hf=eig_id
ENDIF
eig_id=open_eig(&
IF (.not.hybrid%l_calhf) THEN
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
......@@ -270,7 +266,7 @@ CONTAINS
!---> loop over k-points: each can be a separate task
DO jsp = 1,nspins
CALL eigen_HF_setup(hybrid,input,sym,kpts,dimension,atoms,mpi,noco,cell,oneD,results,jsp,eig_id_hf,&
CALL eigen_HF_setup(hybrid,input,sym,kpts,dimension,atoms,mpi,noco,cell,oneD,results,jsp,eig_id,&
hybdat,irank2,it,l_real,vr0)
!
......@@ -331,7 +327,6 @@ CONTAINS
!---> set up lapw list
!
CALL timestart("Setup of LAPW")
lapw%rk = 0 ; lapw%k1 = 0 ; lapw%k2 = 0 ; lapw%k3 = 0
CALL apws(DIMENSION,input,noco, kpts,nk,cell,l_zref, mpi%n_size,jsp, bkpt,lapw,matind,nred)
CALL timestop("Setup of LAPW")
......@@ -359,7 +354,7 @@ CONTAINS
!
IF( hybrid%l_hybrid ) THEN
CALL hsfock(nk,atoms,hybrid,lapw,DIMENSION,kpts,kpts%nkpt,jsp,input,hybdat,eig_irr,&
CALL hsfock(nk,atoms,hybrid,lapw,DIMENSION,kpts,jsp,input,hybdat,eig_irr,&
sym,cell,noco,results,it,maxval(hybdat%nobd),xcpot,&
mpi,irank2(nk),isize2(nk),comm(nk), hamovlp)
......@@ -508,7 +503,7 @@ ENDIF
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#endif
IF (hybrid%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)
atoms%n_u=n_u_in
......
global/types.F90
View file @ 09b6c67a
......@@ -3,7 +3,7 @@
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_types
!*************************************************************
! This module contains definitions for all kind of types
......@@ -764,6 +764,15 @@ MODULE m_types
REAL, ALLOCATABLE :: a_r(:), b_r(:)
COMPLEX, ALLOCATABLE :: a_c(:), b_c(:)
END TYPE t_hamOvlp
TYPE t_lapwmat
LOGICAL :: l_real
INTEGER :: matsize
REAL, ALLOCATABLE :: mat_r(:)
COMPLEX, ALLOCATABLE :: mat_c(:)
CONTAINS
PROCEDURE allocate_space =>t_lapwmat_allocate
END TYPE t_lapwmat
!
! type for wannier-functions
!
......@@ -937,4 +946,20 @@ CONTAINS
pd%vacxy=0.0
ENDIF
END SUBROUTINE init_potden_simple
SUBROUTINE t_lapwmat_allocate(mat)
USE m_judft
IMPLICIT NONE
CLASS(t_lapwmat),INTENT(INOUT) :: mat
INTEGER:: err
IF (mat%l_real) THEN
if (allocated(mat%mat_r)) CALL juDFT_error("Matrix already allocated",hint="this is a bug in the code,please report")
allocate(mat%mat_r(mat%matsize),stat=err)
ELSE
if (allocated(mat%mat_c)) CALL juDFT_error("Matrix already allocated",hint="this is a bug in the code,please report")
allocate(mat%mat_c(mat%matsize),stat=err)
endif
IF (err>0) CALL judft_error("Not enough memory allocating a lapw-matrix")
end SUBROUTINE t_lapwmat_allocate
END MODULE m_types
hybrid/coulombmatrix.F90
View file @ 09b6c67a
......@@ -294,7 +294,7 @@
rrot(:,:,isym) = transpose(sym%mrot(:,:,inviop))
DO l = 0,hybrid%maxlcutm1
dwgn(:,:,l,isym) = transpose( &
& sym%d_wgn(-hybrid%maxlcutm1:hybrid%maxlcutm1,-hybrid%maxlcutm1:hybrid%maxlcutm1,l,isym) )
& hybrid%d_wgn2(-hybrid%maxlcutm1:hybrid%maxlcutm1,-hybrid%maxlcutm1:hybrid%maxlcutm1,l,isym) )
END DO
ELSE
inviop = isym - sym%nop
......@@ -339,8 +339,8 @@
nsym1(ikpt) = isym1
END DO
! Define reduced lists of G points -> pgptm1(:,ikpt), ikpt=1,..,nkpt
ALLOCATE ( hybrid%pgptm1(hybrid%maxgptm,kpts%nkpt),iarr(hybrid%maxgptm),&
& pointer(kpts%nkpt,&
!ALLOCATE ( hybrid%pgptm1(hybrid%maxgptm,kpts%nkpt)) !in mixedbasis
ALLOCATE (iarr(hybrid%maxgptm), pointer(kpts%nkpt,&
& minval(hybrid%gptm(1,:))-1:maxval(hybrid%gptm(1,:))+1,&
& minval(hybrid%gptm(2,:))-1:maxval(hybrid%gptm(2,:))+1,&
& minval(hybrid%gptm(3,:))-1:maxval(hybrid%gptm(3,:))+1))
......@@ -1296,7 +1296,7 @@
ALLOCATE( olapm(hybrid%ngptm(ikpt),hybrid%ngptm(ikpt)) )
olapm = 0
CALL olap_pw(olapm,hybrid%gptm(:hybrid%ngptm(ikpt),ikpt),hybrid%ngptm(ikpt), atoms,cell )
CALL olap_pw(olapm,hybrid%gptm(:,hybrid%pgptm(:hybrid%ngptm(ikpt),ikpt)),hybrid%ngptm(ikpt), atoms,cell )
! !calculate eigenvalues of olapm
! ALLOCATE( eval(ngptm(ikpt)),evec(ngptm(ikpt),ngptm(ikpt)) )
......
hybrid/eigen_HF_setup.F90
View file @ 09b6c67a
......@@ -30,7 +30,7 @@ CONTAINS
TYPE(t_hybdat),INTENT(INOUT):: hybdat
INTEGER:: ok,nk,nrec1,i,j,bands,ll,l1,l2,ng,itype,n,l,n1,n2,nn
INTEGER:: ok,nk,nrec1,i,j,ll,l1,l2,ng,itype,n,l,n1,n2,nn
TYPE(t_zmat),ALLOCATABLE :: zmat(:)
......@@ -51,7 +51,7 @@ CONTAINS
!
CALL timestart("gen_bz and gen_wavf")
ALLOCATE(zmat(kpts%nkpt))
ALLOCATE(zmat(kpts%nkptf),stat=ok)
IF( ok .NE. 0 ) STOP 'eigen_hf: failure allocation z_c'
ALLOCATE ( eig_irr(DIMENSION%neigd2,kpts%nkpt) ,stat=ok )
IF( ok .NE. 0 ) STOP'eigen_hf: failure allocation eig_irr'
......@@ -74,8 +74,10 @@ CONTAINS
else
ALLOCATE(zmat(nk)%z_c(dimension%nbasfcn,dimension%neigd2))
endif
print *,"eigen_HF_Setup: read_eig:",nk
print *,zmat(nk)%nbasfcn,zmat(nk)%nbands,hybdat%ne_eig(nk)
CALL read_eig(eig_id_hf,nk,jsp,el=el_eig,ello=ello_eig, neig=hybdat%ne_eig(nk),eig=eig_irr(:,nk), kveclo=hybdat%kveclo_eig(:,nk),zmat=zmat(nk)) !TODO introduce zmat!!,z=z_irr(:,:,nk))
print *,"Done"
END DO
......@@ -114,7 +116,7 @@ CONTAINS
! set the size of the exchange matrix in the space of the wavefunctions
hybdat%nbands(nk)=bands
hybdat%nbands(nk)=hybrid%bands1
IF(hybdat%nbands(nk).GT.hybdat%ne_eig(nk)) THEN
IF ( mpi%irank == 0 ) THEN
WRITE(*,*) ' maximum for hybdat%nbands is', hybdat%ne_eig(nk)
......@@ -290,7 +292,7 @@ CONTAINS
DEALLOCATE ( eig_irr , hybdat%kveclo_eig )
hybrid%maxlmindx = MAXVAL((/ ( SUM( (/ (hybrid%nindx(l,itype)*(2*l+1), l=0,atoms%lmax(itype)) /) ),itype=1,atoms%ntype) /) )
hybdat%nbands = MIN( bands, DIMENSION%neigd )
hybdat%nbands = MIN( hybrid%bands1, DIMENSION%neigd )
ENDIF ! hybrid%l_calhf
END SUBROUTINE eigen_hf_setup
......
hybrid/exchange_core.F90
View file @ 09b6c67a
......@@ -21,7 +21,7 @@
CONTAINS
SUBROUTINE exchange_vccv(&
& nk,bkpt,kpts,nkpti,atoms,&
& nk,atoms,&
& hybrid,hybdat,&
& dimension,jsp,lapw,&
& maxbands,mnobd,mpi,irank2,&
......@@ -40,22 +40,20 @@
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_hybrid),INTENT(IN) :: hybrid
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_lapw),INTENT(IN) :: lapw
! -scalars -
INTEGER,INTENT(IN) :: jsp
INTEGER,INTENT(IN) ::nk ,maxbands, mnobd
INTEGER,INTENT(IN) :: nkpti ,irank2
INTEGER,INTENT(IN) :: irank2
! - arays -
INTEGER,INTENT(IN) :: degenerat(hybdat%ne_eig(nk))
REAL,INTENT(IN) :: bkpt(3)
#ifdef CPP_INVERSION
REAL ,INTENT(INOUT) :: ex_vv(maxbands,mnobd,nkpti)
REAL ,INTENT(INOUT) :: ex_vv(:,:,:)!(maxbands,mnobd,nkpti)
#else
COMPLEX ,INTENT(INOUT) :: ex_vv(maxbands,mnobd,nkpti)
COMPLEX ,INTENT(INOUT) :: ex_vv(:,:,:)!(maxbands,mnobd,nkpti)
#endif
LOGICAL :: symequivalent(count(degenerat .ge. 1),&
& count(degenerat .ge. 1))
......@@ -251,7 +249,7 @@
END SUBROUTINE exchange_vccv
SUBROUTINE exchange_vccv1(nk,kpts,nkpti,atoms,&
SUBROUTINE exchange_vccv1(nk,atoms,&
& hybrid,hybdat,&
& dimension,jsp,&
& lapw,&
......@@ -270,14 +268,12 @@
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_hybrid),INTENT(IN) :: hybrid
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_lapw),INTENT(IN) :: lapw
! -scalars -
INTEGER,INTENT(IN) :: jsp
INTEGER,INTENT(IN) :: nk
INTEGER,INTENT(IN) :: nkpti
INTEGER,INTENT(IN) :: nsymop
REAL,INTENT(IN) :: a_ex
! - arays -
......@@ -445,7 +441,7 @@
END SUBROUTINE exchange_vccv1
SUBROUTINE exchange_cccc(nk,nkpti,atoms,hybdat, ncstd,&
SUBROUTINE exchange_cccc(nk,atoms,hybdat, ncstd,&
sym,kpts,a_ex,mpi, results)
......@@ -464,7 +460,7 @@
TYPE(t_atoms),INTENT(IN) :: atoms
! - scalars -
INTEGER,INTENT(IN) :: nk,nkpti ,ncstd
INTEGER,INTENT(IN) :: nk, ncstd
REAL ,INTENT(IN) :: a_ex
......@@ -593,7 +589,7 @@
END SUBROUTINE exchange_cccc
SUBROUTINE exchange_cccv( &
& nk,nkpti,atoms,hybdat,&
& nk,atoms,hybdat,&
& hybrid,dimension,maxbands,ncstd,&
& bkpt,sym,mpi,&
& exch_cv )
......@@ -613,15 +609,15 @@
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_atoms),INTENT(IN) :: atoms
! - scalars -
INTEGER,INTENT(IN) :: nk,nkpti ,ncstd
INTEGER,INTENT(IN) :: nk ,ncstd
INTEGER,INTENT(IN) :: maxbands
! - arays -
REAL ,INTENT(IN) :: bkpt(3)
#ifdef CPP_INVERSION
REAL ,INTENT(INOUT) :: exch_cv(maxbands,ncstd,nkpti)
REAL ,INTENT(INOUT) :: exch_cv(:,:,:)!(maxbands,ncstd,nkpti)
#else
COMPLEX,INTENT(INOUT) :: exch_cv(maxbands,ncstd,nkpti)
COMPLEX,INTENT(INOUT) :: exch_cv(:,:,:) !(maxbands,ncstd,nkpti)
#endif
! - local scalars -
INTEGER :: itype,ieq,icst,icst1,icst2,iatom,iatom0,&
......
hybrid/exchange_val_hf.F90
View file @ 09b6c67a
......@@ -53,7 +53,7 @@
CONTAINS
SUBROUTINE exchange_valence_hf(&
nk,kpts,nkpti,nkpt_EIBZ, sym,atoms,hybrid,&
nk,kpts,nkpt_EIBZ, sym,atoms,hybrid,&
cell, dimension,input,jsp, hybdat, mnobd, lapw,&
eig_irr,results,parent,pointer_EIBZ,n_q,wl_iks,&
it,xcpot, noco,nsest,indx_sest,&
......@@ -93,7 +93,7 @@
! - scalars -
INTEGER,INTENT(IN) :: it ,irank2 ,isize2,comm
INTEGER,INTENT(IN) :: jsp
INTEGER,INTENT(IN) :: nk ,nkpti ,nkpt_EIBZ
INTEGER,INTENT(IN) :: nk ,nkpt_EIBZ
INTEGER,INTENT(IN) :: mnobd
......@@ -106,7 +106,7 @@
INTEGER,INTENT(IN) :: nsest(hybdat%nbands(nk)),indx_sest(hybdat%nbands(nk),hybdat%nbands(nk))
REAL ,INTENT(IN) :: eig_irr(dimension%neigd,nkpti)
REAL ,INTENT(IN) :: eig_irr(dimension%neigd,kpts%nkpt)
REAL ,INTENT(IN) :: wl_iks(dimension%neigd,kpts%nkptf)
REAL ,INTENT(OUT) :: div_vv(hybdat%nbands(nk))
......@@ -377,14 +377,14 @@
#ifdef CPP_IRAPPROX
CALL wavefproducts_inv(&
1,hybdat,dimension,jsp,atoms,&
lapw,obsolete,nkpti,kpts,kpts,nkpt_EIBZ,&
lapw,obsolete,kpts,&
nk,ikpt0,mnobd,hybrid, parent,cell, sym,&
time_mt,time_ir,nkqpt,cprod_vv)
#else
CALL wavefproducts_inv5(&
1,hybdat,ibando,ibando+psize-1,&
dimension,input,jsp,atoms,&
lapw,obsolete,nkpti,kpts,kpts,nkpt_EIBZ,&
lapw,obsolete,kpts,&
nk,ikpt0,mnobd,hybrid,&
parent,cell, sym,&
noco,noco,&
......@@ -424,7 +424,7 @@
IF ( xcpot%icorr == icorr_hse .OR. xcpot%icorr == icorr_vhse ) THEN
iband1 = hybdat%nobd(nkqpt)
exch_vv = exch_vv + dynamic_hse_adjustment(&
atoms%rmsh,atoms%rmt,atoms%dx,atoms%jri,atoms%jmtd,kpts%bk(:,ikpt0),ikpt0,kpts%nkptf,&
atoms%rmsh,atoms%rmt,atoms%dx,atoms%jri,atoms%jmtd,kpts%bkf(:,ikpt0),ikpt0,kpts%nkptf,&
cell%bmat,vol,atoms%ntype,atoms%neq,atoms%nat,atoms%taual,hybrid%lcutm1,hybrid%maxlcutm1,&
hybrid%nindxm1,hybrid%maxindxm1,hybrid%gptm,hybrid%ngptm(ikpt0),hybrid%pgptm(:,ikpt0),&
hybrid%gptmd,hybrid%basm1,hybdat%nbasm(ikpt0),iband1,hybdat%nbands(nk),nsest,&
......@@ -545,7 +545,7 @@
IF( zero_order ) THEN
CALL dwavefproducts( &
dcprod,nk,1,hybdat%nbands(nk),1,hybdat%nbands(nk),.false., atoms,hybrid,&
cell,hybdat, kpts,nkpti,lapw,&
cell,hybdat, kpts,kpts%nkpt,lapw,&
dimension,jsp,&
eig_irr )
......@@ -563,7 +563,7 @@
nk,atoms,&
dimension,input,jsp,&
hybdat,hybrid,&
lapw,kpts,nkpti,&
lapw,kpts,kpts%nkpt,&
cell,mnobd,&
sym,&
proj_ibsc,olap_ibsc)
......@@ -643,10 +643,10 @@
! Calculate distances from the eight reciprocal unit-cell corners
knorm = k0
DO i = 1,8
rdum=sqrt(sum(matmul(kpts%bk(:,ikpt)-kcorner(:,i),cell%bmat)**2))
rdum=sqrt(sum(matmul(kpts%bkf(:,ikpt)-kcorner(:,i),cell%bmat)**2))
IF(rdum.lt.k0) THEN
knorm = rdum
kvec = ( kpts%bk(:,ikpt) - kcorner(:,i) ) / knorm
kvec = ( kpts%bkf(:,ikpt) - kcorner(:,i) ) / knorm
END IF
END DO
......
hybrid/gen_wavf.F90
View file @ 09b6c67a
......@@ -137,9 +137,10 @@
TYPE(t_lapw) :: lapw
TYPE(t_usdus):: usdus
CALL CPU_TIME(time1)
CALL CPU_TIME(time1)
call usdus%init(atoms,dimension%jspd)
! setup rotations in reciprocal space
DO iop=1,sym%nsym
IF( iop .le. sym%nop ) THEN
......
hybrid/hsfock.F90
View file @ 09b6c67a
......@@ -20,8 +20,8 @@ MODULE m_hsfock
! | calculate valence-core contribution c
! c
! variables: c
! nkptf := number of kpoints c
! nkpti := number of irreducible kpoints c
! kpts%nkptf := number of kpoints c
! kpts%nkpt := number of irreducible kpoints c
! nbands := number of bands for which the exchange matrix (mat_ex) c
! in the space of the wavefunctions is calculated c
! te_hfex := hf exchange contribution to the total energy c
......@@ -38,7 +38,7 @@ MODULE m_hsfock
SUBROUTINE hsfock(&
& nk,atoms,hybrid,lapw,dimension,&
& kpts,nkpti,jsp,input,&
& kpts,jsp,input,&
& hybdat,&
& eig_irr,sym,&
& cell,noco,&
......@@ -59,30 +59,30 @@ MODULE m_hsfock
USE m_icorrkeys
USE m_types
IMPLICIT NONE
TYPE(t_hybdat),INTENT(IN) :: hybdat
TYPE(t_hybdat),INTENT(IN) :: hybdat
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_hybrid),INTENT(INOUT) :: hybrid
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_hybrid),INTENT(INOUT) :: hybrid
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_lapw),INTENT(IN) :: lapw
! - scalars -
INTEGER,INTENT(IN) :: jsp
INTEGER,INTENT(IN) :: it
INTEGER,INTENT(IN) :: irank2 ,isize2,comm
INTEGER,INTENT(IN) :: nkpti ,nk
INTEGER,INTENT(IN) :: mnobd
INTEGER,INTENT(IN) :: nk
INTEGER,INTENT(IN) :: mnobd
! - arrays -
REAL,INTENT(IN) :: eig_irr(dimension%neigd,nkpti)
REAL,INTENT(IN) :: eig_irr(dimension%neigd,kpts%nkpt)
TYPE(t_hamovlp),INTENT(INOUT)::hamovlp
#if ( !defined(CPP_INVERSION) )
......@@ -184,7 +184,7 @@ MODULE m_hsfock
#else
irecl_olap = dimension%nbasfcn*(dimension%nbasfcn+1)*8
#endif
irec = nkpti*(jsp-1) + nk
irec = kpts%nkpt*(jsp-1) + nk
print *, "Olap read:",irec
OPEN(88,file='olap',form='unformatted',access='direct',&
& recl=irecl_olap)
......@@ -220,14 +220,13 @@ MODULE m_hsfock
& WRITE(*,*) 'calculate new HF matrix'
IF( nk .eq. 1 .and. jsp .eq. 1 .and. input%imix .gt. 10)&
& CALL system('rm -f broyd*')
! calculate all symmetrie operations, which yield k invariant
ALLOCATE( parent(kpts%nkptf),symop(kpts%nkptf) ,stat=ok)
IF( ok .ne. 0 ) STOP 'mhsfock: failure allocation parent/symop'
parent = 0 ; symop = 0
CALL symm_hf( kpts,nkpti,nk,sym,&
CALL symm_hf( kpts,nk,sym,&
& dimension,hybdat,eig_irr,&
& atoms,hybrid,cell,&
& lapw,jsp,&
......@@ -253,7 +252,7 @@ MODULE m_hsfock
CALL timestart("valence exchange calculation")
CALL exchange_valence_hf(&
& nk,kpts,nkpti,nkpt_EIBZ, sym,atoms,hybrid,&
& nk,kpts,nkpt_EIBZ, sym,atoms,hybrid,&
& cell, dimension,input,jsp, hybdat, mnobd, lapw,&
& eig_irr,results,parent,pointer_EIBZ,n_q,wl_iks,&
& it,xcpot,&
......@@ -273,7 +272,7 @@ MODULE m_hsfock
IF ( xcpot%icorr.eq.icorr_hse .OR. xcpot%icorr.eq.icorr_vhse ) THEN
#ifdef CPP_NEVER
CALL exchange_vccvHSE(&
& nk,kpts,nkpti,atoms,&
& nk,atoms,&
& hybrid,hybdat,&
& dimension,jsp,&
& lapw,&
......@@ -281,7 +280,7 @@ MODULE m_hsfock
& a_ex,results,&
& mat_ex%core )
CALL exchange_ccccHSE(&
& nk,nkpti,obsolete,atoms,hybdat,&
& nk,obsolete,atoms,hybdat,&
& ncstd,&
& kpts(:,nk),&
& sym,a_ex,mpi,&
......@@ -290,7 +289,7 @@ MODULE m_hsfock
STOP "HSE not implemented in hsfock"
ELSE
CALL exchange_vccv1(&
& nk,kpts,nkpti,atoms,&
& nk,atoms,&
& hybrid,hybdat,&
& dimension,jsp,&
& lapw,&
......@@ -298,7 +297,7 @@ MODULE m_hsfock
& a_ex,results,&
& mat_ex)
CALL exchange_cccc(&
& nk,nkpti,atoms,hybdat,&
& nk,atoms,hybdat,&
& ncstd,&
& sym,kpts,a_ex,mpi,&
& results )
......@@ -382,7 +381,7 @@ MODULE m_hsfock
END DO
CALL symmetrizeh(atoms,&
& kpts%bk(:,nk),dimension,jsp,lapw,gpt,&
& kpts%bkf(:,nk),dimension,jsp,lapw,gpt,&
& sym,hybdat%kveclo_eig,&
& cell,nsymop,psym,&
& v_x )
......@@ -396,7 +395,7 @@ MODULE m_hsfock
irecl_vx = dimension%nbasfcn*(dimension%nbasfcn+1)*8
#endif
irec = nkpti*(jsp-1) + nk
irec = kpts%nkpt*(jsp-1) + nk
OPEN(778,file='vex',form='unformatted',access='direct',&
& recl=irecl_vx)
#ifdef CPP_INVERSION
......@@ -431,7 +430,7 @@ MODULE m_hsfock
#else
irecl_vx = dimension%nbasfcn*(dimension%nbasfcn+1)*8
#endif
irec = nkpti*(jsp-1) + nk
irec = kpts%nkpt*(jsp-1) + nk
OPEN(778,file='vex',form='unformatted',access='direct',&
& recl=irecl_vx)
READ(778,rec=irec) v_x
......@@ -471,7 +470,7 @@ MODULE m_hsfock
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),&
& kpts%bkf(:,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
......
hybrid/mixedbasis.F90
View file @ 09b6c67a
......@@ -151,7 +151,7 @@ CONTAINS
! Test if file exists
INQUIRE(FILE=ioname,EXIST=l_found)
IF ( l_found ) THEN
IF ( l_found .and..false.) THEN !reading not working yet
! Open file
OPEN(UNIT=iounit,FILE=ioname,FORM='unformatted',STATUS='old')
......@@ -319,7 +319,7 @@ CONTAINS
i = 0
n =-1
rdum1 = MAXVAL( (/ (SQRT(SUM(MATMUL(kpts%bk(:,ikpt),cell%bmat)**2)),ikpt=1,kpts%nkptf ) /) )
rdum1 = MAXVAL( (/ (SQRT(SUM(MATMUL(kpts%bkf(:,ikpt),cell%bmat)**2)),ikpt=1,kpts%nkptf ) /) )
! a first run for the determination of the dimensions of the fields
! gptm,pgptm
......@@ -337,7 +337,7 @@ CONTAINS
IF(rdum.GT. gcutm) CYCLE
ldum1 = .FALSE.
DO ikpt = 1,kpts%nkptf
kvec = kpts%bk(:,ikpt)
kvec = kpts%bkf(:,ikpt)
rdum = SUM(MATMUL(kvec+g,cell%bmat)**2)
IF(rdum.LE.gcutm**2) THEN
......@@ -390,7 +390,7 @@ CONTAINS
IF(rdum.GT. gcutm) CYCLE
ldum1 = .FALSE.
DO ikpt = 1,kpts%nkptf
kvec = kpts%bk(:,ikpt)
kvec = kpts%bkf(:,ikpt)
rdum = SUM(MATMUL(kvec+g,cell%bmat)**2)
IF(rdum.LE.(gcutm)**2) THEN
......@@ -444,7 +444,7 @@ CONTAINS
DO igpt = 1,hybrid%gptmd
g = hybrid%gptm(:,igpt)