Commit 73087055 authored by Daniel Wortmann's avatar Daniel Wortmann

More bugfixes

Removed most of CPP_INVERSION
parent 2d811c6b
......@@ -76,7 +76,7 @@ CONTAINS
CALL setabc1locdn1(jspin, atoms,lapw, sym,usdus,kveclo,enough,nkvec,kvec,&
nbasf0,alo1,blo1,clo1)
nvmax=lapw%nv(jspin)
!---> loop over lapws
DO k = 1,nvmax
!calculate k+G
......
......@@ -53,7 +53,7 @@ CONTAINS
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
lapw%rk = 0 ; lapw%k1 = 0 ; lapw%k2 = 0 ; lapw%k3 = 0 ;lapw%nv=0
! ..
! ..
!---> in a spin-spiral calculation different basis sets are used for
......
......@@ -9,7 +9,7 @@ MODULE m_eigen
CONTAINS
SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,&
sym,kpts,DIMENSION, vacuum, input, cell, enpara_in,banddos, noco,jij, oneD,hybrid,&
it,eig_id,results,v)
it,eig_id,results,v,vx)
!*********************************************************************
! sets up and solves the eigenvalue problem for a basis of lapws.
!
......@@ -65,7 +65,7 @@ CONTAINS
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(INOUT) :: atoms!in u_setup n_u might be modified
TYPE(t_potden),INTENT(INOUT) :: v
TYPE(t_potden),INTENT(INOUT) :: v,vx
#ifdef CPP_MPI
INCLUDE 'mpif.h'
#endif
......@@ -291,6 +291,7 @@ CONTAINS
WRITE (*,*) 'the tlmplm%tuu, tlmplm%tdd etc.: ',err,' size: ',mlotot
CALL juDFT_error("eigen: Error during allocation of tlmplm, tdd etc.",calledby ="eigen")
ENDIF
lh0=1
CALL tlmplm(sphhar,atoms,DIMENSION,enpara, jsp,1,mpi, v%mt(1,0,1,jsp),lh0,input, td,ud)
IF (input%l_f) CALL write_tlmplm(td,vs_mmp,atoms%n_u>0,1,jsp,input%jspins)
CALL timestop("tlmplm")
......@@ -358,7 +359,7 @@ CONTAINS
IF( hybrid%l_hybrid ) THEN
!write overlap matrix b to direct access file olap
print *,"Wrong overlap matrix used, fix this later"
call olap%from_packed(dimension%nbasfcn,l_real,hamovlp%b_r,hamovlp%b_c)
call olap%from_packed(l_real,dimension%nbasfcn,hamovlp%b_r,hamovlp%b_c)
call write_olap(olap,nrec)
......@@ -371,7 +372,7 @@ CONTAINS
IF( hybrid%l_subvxc ) THEN
CALL subvxc(lapw,kpts%bk(:,nk),DIMENSION,input,jsp,vr0,atoms,ud,hybrid,enpara%el0,enpara%ello0,&
sym, atoms%nlotot,kveclo, cell,sphhar, stars, xcpot,mpi,&
oneD, hamovlp)
oneD, hamovlp,vx)
END IF
END IF ! hybrid%l_hybrid
......@@ -419,13 +420,13 @@ CONTAINS
zmat%nbands=ne_found
CALL write_eig(eig_id, nk,jsp,ne_found,ne_all,lapw%nv(jsp),lapw%nmat,&
lapw%k1(:lapw%nv(jsp),jsp),lapw%k2 (:lapw%nv(jsp),jsp),lapw%k3(:lapw%nv(jsp),jsp),&
bkpt, kpts%wtkpt(nk),eig(:ne_found),enpara%el0(0:,:,jsp), enpara%ello0(:,:,jsp),enpara%evac0(:,jsp),&
atoms%nlotot,kveclo,mpi%n_size,mpi%n_rank,zMat)
bkpt, kpts%wtkpt(nk),eig(:ne_found),el=enpara%el0(0:,:,jsp),ello=enpara%ello0(:,:,jsp),evac=enpara%evac0(:,jsp),&
nlotot=atoms%nlotot,kveclo=kveclo,n_start=mpi%n_size,n_end=mpi%n_rank,zmat=zMat)
IF (noco%l_noco) THEN
CALL write_eig(eig_id, nk,2,ne_found,ne_all,lapw%nv(2),lapw%nmat,&
lapw%k1(:lapw%nv(2),2),lapw%k2 (:lapw%nv(2),2),lapw%k3(:lapw%nv(2),2),&
bkpt, kpts%wtkpt(nk),eig(:ne_found),enpara%el0(0:,:,2), enpara%ello0(:,:,2),enpara%evac0(:,2),&
atoms%nlotot,kveclo)
bkpt, kpts%wtkpt(nk),eig(:ne_found),el=enpara%el0(0:,:,2),ello= enpara%ello0(:,:,2),evac=enpara%evac0(:,2),&
nlotot=atoms%nlotot,kveclo=kveclo)
ENDIF
#if defined(CPP_MPI)
!RMA synchronization
......
......@@ -28,7 +28,7 @@ CONTAINS
!-----------------------------------------------------------------------
USE m_eig66_io, ONLY : read_eig
USE m_eig66_io, ONLY : read_eig,write_eig
#if defined(CPP_MPI)&&defined(CPP_NEVER)
USE m_mpi_col_eigJ
#endif
......@@ -235,6 +235,13 @@ CONTAINS
WRITE(attributes(2),'(a)') 'Htr'
IF (mpi%irank.EQ.0) CALL writeXMLElement('FermiEnergy',(/'value','units'/),attributes(1:2))
!Put w_iks into eig-file
DO jsp = 1,nspins
DO k = 1,kpts%nkpt
CALL write_eig(eig_id,k,jsp,w_iks=results%w_iks(:,k,jsp))
ENDDO
ENDDO
RETURN
8020 FORMAT (/,'FERMIE:',/,&
& 10x,'first approx. to ef (T=0) :',f10.6,' htr',&
......
......@@ -401,6 +401,7 @@ MODULE m_types
INTEGER :: lexp
INTEGER :: bands1 !Only read in
INTEGER :: bands2 !Only read in
INTEGER :: nbasp
INTEGER :: maxlcutm1
INTEGER :: maxindxm1
INTEGER :: maxbasm1
......@@ -452,7 +453,6 @@ MODULE m_types
INTEGER :: l1,l2,n1,n2
END TYPE prodtype
TYPE t_hybdat
INTEGER :: nbasp
INTEGER :: lmaxcd,maxindxc
REAL, ALLOCATABLE :: gridf(:,:) !alloc in util.F
INTEGER , ALLOCATABLE:: nindxc(:,:) !alloc in eigen_HF_init
......
......@@ -12,6 +12,8 @@ module m_types_rcmat
PROCEDURE :: multiply=>t_mat_multiply
PROCEDURE :: transpose=>t_mat_transpose
PROCEDURE :: from_packed=>t_mat_from_packed
PROCEDURE :: inverse =>t_mat_inverse
PROCEDURE :: to_packed=>t_mat_to_packed
END type t_mat
CONTAINS
......@@ -33,7 +35,9 @@ module m_types_rcmat
IF (mat%l_real) THEN
ALLOCATE(mat%data_r(mat%matsize1,mat%matsize2),STAT=err)
ALLOCATE(mat%data_c(0,0))
ELSE
ALLOCATE(mat%data_r(0,0))
ALLOCATE(mat%data_c(mat%matsize1,mat%matsize2),STAT=err)
ENDIF
......@@ -86,7 +90,7 @@ module m_types_rcmat
end IF
end SUBROUTINE t_mat_transpose
SUBROUTINE t_mat_from_packed(mat1,matsize,l_real,packed_r,packed_c)
SUBROUTINE t_mat_from_packed(mat1,l_real,matsize,packed_r,packed_c)
CLASS(t_mat),INTENT(INOUT) :: mat1
INTEGER,INTENT(IN) :: matsize
LOGICAL,INTENT(IN) :: l_real
......@@ -94,17 +98,68 @@ module m_types_rcmat
COMPLEX,INTENT(IN) :: packed_c(:)
INTEGER:: n,nn,i
call mat1%alloc(l_real,matsize)
call mat1%alloc(l_real,matsize,matsize)
i=1
DO n=1,matsize
DO nn=1,n
if (l_real) THEN
mat1%data_r(n,nn)=packed_r(i)
mat1%data_r(nn,n)=packed_r(i)
else
mat1%data_c(n,nn)=packed_c(i)
mat1%data_c(n,nn)=conjg(packed_c(i))
mat1%data_c(nn,n)=packed_c(i)
end if
i=i+1
end DO
end DO
end SUBROUTINE t_mat_from_packed
function t_mat_to_packed(mat)result(packed)
CLASS(t_mat),INTENT(IN) :: mat
COMPLEX :: packed(mat%matsize1*(mat%matsize1+1)/2)
integer :: n,nn,i
real,parameter :: tol=1e-5
if (mat%matsize1.ne.mat%matsize2) call judft_error("Could not pack no-square matrix",hint='This is a BUG, please report')
i=1
DO n=1,mat%matsize1
DO nn=1,n
if (mat%l_real) THEN
packed(i)=(mat%data_r(n,nn)+mat%data_r(nn,n))/2.
if (abs(mat%data_r(n,nn)-mat%data_r(nn,n))>tol) call judft_warn("Large unsymmetry in matrix packing")
else
packed(i)=(conjg(mat%data_c(n,nn))+mat%data_c(nn,n))/2.
if (abs(conjg(mat%data_c(n,nn))-mat%data_c(nn,n))>tol) call judft_warn("Large unsymmetry in matrix packing")
endif
i=i+1
end DO
end DO
end function t_mat_to_packed
subroutine t_mat_inverse(mat)
implicit none
CLASS(t_mat),INTENT(INOUT) :: mat
integer :: info
real, allocatable :: work_r(:)
integer, allocatable :: ipiv(:)
complex,allocatable :: work_c(:)
if (mat%matsize1.ne.mat%matsize2) call judft_error("Can only invert square matrices",hint="This is a BUG in FLEUR, please report")
ALLOCATE(ipiv(mat%matsize1))
if (mat%l_real) THEN
ALLOCATE(work_r(mat%matsize1))
call dgetrf(mat%matsize1,mat%matsize1,mat%data_r,size(mat%data_r,1),ipiv,info)
if(info.ne.0) call judft_error("Failed to invert matrix: dpotrf failed.")
call dgetri(mat%matsize1,mat%data_r,size(mat%data_r,1),ipiv,work_r,size(work_r),info)
if(info.ne.0) call judft_error("Failed to invert matrix: dpotrf failed.")
else
ALLOCATE(work_c(mat%matsize1))
call zgetrf(mat%matsize1,mat%matsize1,mat%data_c,size(mat%data_c,1),ipiv,info)
if(info.ne.0) call judft_error("Failed to invert matrix: dpotrf failed.")
call zgetri(mat%matsize1,mat%data_c,size(mat%data_c,1),ipiv,work_c,size(work_c),info)
if(info.ne.0) call judft_error("Failed to invert matrix: dpotrf failed.")
end if
end subroutine t_mat_inverse
end module m_types_rcmat
......@@ -41,7 +41,7 @@
! - local scalars -
INTEGER :: i,itype,iatom,ikpt,ineq,igpt,iband
INTEGER :: irecl_cmt,irecl_z
INTEGER :: irecl_cmt
INTEGER :: j,m
INTEGER :: l
INTEGER :: lm,lm1
......@@ -66,13 +66,7 @@
REAL :: rtaual(3)
REAL , ALLOCATABLE :: olapcb(:)
REAL , ALLOCATABLE :: olapcv_avg(:,:,:,:),olapcv_max(:,:,:,:)
#ifdef CPP_INVERSION
REAL , ALLOCATABLE :: olappp(:,:)
REAL :: z(dimension%nbasfcn,dimension%neigd,nkpti)
#else
COMPLEX , ALLOCATABLE :: olappp(:,:)
COMPLEX :: z(dimension%nbasfcn,dimension%neigd,nkpti)
#endif
TYPE(t_mat),ALLOCATABLE :: z(:)
COMPLEX :: cmt(dimension%neigd,hybrid%maxlmindx,atoms%nat,nkpti)
COMPLEX :: y((atoms%lmaxd+1)**2)
......@@ -85,7 +79,11 @@
& 'x','x','x','x','x','x','x','x','x','x','x','x','x' /)
LOGICAL :: l_mism = .true.
ALLOCATE(z(nkpti))
DO ikpt=1,nkpti
call z(ikpt)%alloc(sym%invs,dimension%nbasfcn,dimension%neigd)
ENDDO
IF ( mpi%irank == 0 ) WRITE(6,'(//A)') '### checkolap ###'
cmt = 0
......@@ -238,18 +236,9 @@
ALLOCATE (carr1(maxval(hybdat%nbands),(atoms%lmaxd+1)**2))
ALLOCATE (carr2(maxval(hybdat%nbands),(atoms%lmaxd+1)**2))
ALLOCATE (carr3(maxval(hybdat%nbands),(atoms%lmaxd+1)**2))
#ifdef CPP_INVERSION
irecl_z = dimension%nbasfcn*dimension%neigd*8
#else
irecl_z = dimension%nbasfcn*dimension%neigd*16
#endif
OPEN(unit=778,file='z',form='unformatted',access='direct',&
& recl=irecl_z)
DO ikpt = 1,nkpti
READ(778,rec=ikpt) z(:,:,ikpt)
call read_z(z(ikpt),ikpt)
END DO
CLOSE(778)
iatom = 0
DO itype = 1,atoms%ntype
......@@ -292,8 +281,12 @@
DO m = -l,l
lm = lm + 1
DO iband = 1,hybdat%nbands(ikpt)
carr2(iband,lm) = carr2(iband,lm) + cdum * z(igpt,iband,ikpt) * y(lm)
END DO
if (z(1)%l_real) THEN
carr2(iband,lm) = carr2(iband,lm) + cdum * z(ikpt)%data_r(igpt,iband) * y(lm)
Else
carr2(iband,lm) = carr2(iband,lm) + cdum * z(ikpt)%data_c(igpt,iband) * y(lm)
END if
end DO
END DO
END DO
END DO
......
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -43,8 +43,6 @@ contains
END IF
IF( hybrid%l_calhf ) THEN
hybrid%maxlmindx = MAXVAL((/ ( SUM( (/ (hybrid%nindx(l,itype)*(2*l+1), l=0,atoms%lmax(itype)) /) ),itype=1,atoms%ntype) /) )
call open_hybrid_io(hybrid,dimension,atoms,l_real)
!initialize hybdat%gridf for radial integration
CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
......@@ -72,25 +70,11 @@ contains
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)
hybdat%nbasm(nk) = hybrid%nbasp + hybrid%ngptm(nk)
END DO
! pre-calculate gaunt coefficients
......
......@@ -21,7 +21,7 @@ CONTAINS
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_results),INTENT(IN) :: results
TYPE(t_results),INTENT(INOUT):: results
INTEGER,INTENT(IN) :: irank2(:),it
INTEGER,INTENT(IN) :: jsp,eig_id_hf
......@@ -40,7 +40,7 @@ CONTAINS
INTEGER :: degenerat(DIMENSION%neigd2+1,kpts%nkpt)
INTEGER :: matind(DIMENSION%nbasfcn,2),nred
TYPE(t_lapw) :: lapw
LOGICAL:: skip_kpt(kpts%nkpt)
REAL :: g(3)
skip_kpt=.FALSE.
......@@ -72,12 +72,14 @@ CONTAINS
zmat(nk)%nbands=dimension%neigd2
if (l_real) THEN
ALLOCATE(zmat(nk)%z_r(dimension%nbasfcn,dimension%neigd2))
ALLOCATE(zmat(nk)%z_c(0,0))
else
ALLOCATE(zmat(nk)%z_c(dimension%nbasfcn,dimension%neigd2))
ALLOCATE(zmat(nk)%z_r(0,0))
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))
CALL read_eig(eig_id_hf,nk,jsp,el=el_eig,ello=ello_eig, neig=hybdat%ne_eig(nk),eig=eig_irr(:,nk), w_iks=results%w_iks(:,nk,jsp),kveclo=hybdat%kveclo_eig(:,nk),zmat=zmat(nk))
print *,"Done"
END DO
......@@ -144,7 +146,7 @@ CONTAINS
END DO
DO i = 1,hybdat%ne_eig(nk)
IF( results%w_iks(i,nk,jsp) .GT. 0d0 ) hybdat%nobd(nk) = hybdat%nobd(nk) + 1
IF(results%w_iks(i,nk,jsp) .GT. 0d0 ) hybdat%nobd(nk) = hybdat%nobd(nk) + 1
END DO
......@@ -294,8 +296,8 @@ CONTAINS
! Reading the eig file
!DO nk = n_start,kpts%nkpt,n_stride
DO nk = 1,kpts%nkpt,1
CALL read_eig(eig_id_hf,nk,jsp,el=el_eig, ello=ello_eig,neig=hybdat%ne_eig(nk))
hybdat%nobd(nk) = COUNT( results%w_iks(:hybdat%ne_eig(nk),nk,jsp) > 0.0 )
CALL read_eig(eig_id_hf,nk,jsp,el=el_eig, ello=ello_eig,neig=hybdat%ne_eig(nk),w_iks=results%w_iks(:,nk,jsp))
hybdat%nobd(nk) = COUNT(results%w_iks(:hybdat%ne_eig(nk),nk,jsp) > 0.0 )
END DO
hybrid%maxlmindx = MAXVAL((/ ( SUM( (/ (hybrid%nindx(l,itype)*(2*l+1), l=0,atoms%lmax(itype)) /) ),itype=1,atoms%ntype) /) )
......
This diff is collapsed.
This diff is collapsed.
......@@ -67,7 +67,7 @@
! - - local scalars - -
INTEGER :: ilo,idum ,m
COMPLEX :: cdum
TYPE(t_mat) :: zhlp
! local scalars for apws
INTEGER :: nred
INTEGER :: ikpt0,ikpt,itype,iop,ispin,ieq,indx,iatom
......@@ -87,9 +87,7 @@
INTEGER :: map_lo(atoms%nlod)
INTEGER :: iarr(0:atoms%lmaxd,atoms%ntype)
COMPLEX,ALLOCATABLE :: acof(:,:,:),bcof(:,:,:),ccof(:,:,:,:)
REAL,ALLOCATABLE :: zhlp_r(:,:)
COMPLEX,ALLOCATABLE :: zhlp_c(:,:)
COMPLEX,ALLOCATABLE :: cmt(:,:,:),cmthlp(:,:,:)
......@@ -114,12 +112,14 @@
INTEGER :: irecl_cmt,irecl_z
TYPE(t_lapw) :: lapw(kpts%nkpt)
TYPE(t_lapw) :: lapw(kpts%nkptf)
TYPE(t_usdus):: usdus
!CALL CPU_TIME(time1)
call usdus%init(atoms,dimension%jspd)
call zhlp%alloc(zmat(1)%l_real,zmat(1)%nbasfcn,zmat(1)%nbands)
! setup rotations in reciprocal space
DO iop=1,sym%nsym
IF( iop .le. sym%nop ) THEN
......@@ -131,7 +131,7 @@
! generate G-vectors, which fulfill |k+G|<rkmax
! for all k-points
DO ikpt=1,kpts%nkpt
DO ikpt=1,kpts%nkptf
CALL apws(dimension,input,noco,&
& kpts,ikpt,cell,sym%zrfs,&
& 1,jsp,bkpt,lapw(ikpt),matind,nred)
......@@ -271,23 +271,9 @@
IF( ok .ne. 0 ) STOP 'gen_wavf: Failure allocation cmt'
ALLOCATE ( cmthlp(dimension%neigd,hybrid%maxlmindx,atoms%nat), stat=ok)
IF( ok .ne. 0) STOP 'gen_wavf: failure allocation cmthlp'
if (zmat(1)%l_real) THEN
ALLOCATE ( zhlp_r(dimension%nbasfcn,dimension%neigd), stat=ok)
ELSE
ALLOCATE ( zhlp_c(dimension%nbasfcn,dimension%neigd), stat=ok)
ENDIF
IF( ok .ne. 0) STOP 'gen_wavf: failure allocation zhlp'
# ifdef CPP_INVERSION
irecl_z = dimension%nbasfcn*dimension%neigd*8
# else
irecl_z = dimension%nbasfcn*dimension%neigd*16
# endif
OPEN(unit=778,file='z',form='unformatted',access='direct',&
& recl=irecl_z)
DO ikpt0 = lower, upper
acof = 0; bcof = 0; ccof = 0
......@@ -299,7 +285,7 @@
input,atoms,hybdat%nbands(ikpt0),sym, cell, Kpts%bk(:,ikpt0), lapw(ikpt0), &
hybdat%nbands(ikpt0),usdus,noco,jsp,hybdat%kveclo_eig(:,ikpt0),&
oneD,acof(: hybdat%nbands(ikpt0),:,:),bcof(: hybdat%nbands(ikpt0),:,:),ccof(:,: hybdat%nbands(ikpt0),:,:),&
zmat(ikpt))
zmat(ikpt0))
! call was ...
......@@ -383,37 +369,30 @@
! write cmt at irreducible k-points in direct-access file cmt
call write_cmt(cmt,ikpt0)
! write z at irreducible k-points in direct-access file z
IF (zmat(1)%l_real) THEN
WRITE(778,rec=ikpt0) zmat(ikpt0)%z_r(:,:)
call zhlp%alloc(zmat(1)%l_real,zmat(1)%nbasfcn,zmat(1)%nbands)
IF (zhlp%l_real) THEN
zhlp%data_r=zmat(ikpt0)%z_r
ELSE
WRITE(778,rec=ikpt0) zmat(ikpt0)%z_c(:,:)
ENDIF
zhlp%data_c=zmat(ikpt0)%z_c
end IF
call write_z(zhlp,ikpt0)
! generate wavefunctions coefficients at all k-points from
! irreducible k-points
DO ikpt=1,kpts%nkpt
DO ikpt=1,kpts%nkptf
IF ( kpts%bkp(ikpt) .eq. ikpt0 .and. ikpt0 .ne. ikpt ) THEN
iop = kpts%bksym(ikpt)
CALL waveftrafo_genwavf( cmthlp,zhlp_r,zhlp_c,&
CALL waveftrafo_genwavf( cmthlp,zhlp%data_r,zhlp%data_c,&
& cmt(:,:,:),zmat(1)%l_real,zmat(ikpt0)%z_r(:,:),zmat(ikpt0)%z_c(:,:),ikpt0,iop,atoms,&
& hybrid,kpts,sym,&
& jsp,dimension,hybdat%nbands(ikpt0),&
& cell,lapw(ikpt0),lapw(ikpt),.true.)
call write_cmt(cmthlp,ikpt)
IF (zmat(1)%l_real) THEN
WRITE(778,rec=ikpt) zhlp_r
ELSE
WRITE(778,rec=ikpt) zhlp_c
ENDIF
call write_z(zhlp,ikpt)
END IF
END DO !ikpt
END DO !ikpt0
......@@ -421,9 +400,7 @@
DEALLOCATE( acof,bcof,ccof )
DEALLOCATE( cmt,cmthlp)
!close file cmt and z
CLOSE(778)
END SUBROUTINE gen_wavf
END MODULE m_gen_wavf
......@@ -319,12 +319,13 @@ MODULE m_hsfock
! in the case of a spin-unpolarized calculation the factor 2 is added in eigen_hf.F
if (.not.v_x%l_real) v_x%data_c=conjg(v_x%data_c)
exch = 0
print *,"sizes:",shape(z%data_r),shape(v_x%data_r)
call v_x%multiply(z,tmp)
DO iband = 1,hybdat%nbands(nk)
if (z%l_real) THEN
exch(iband,iband) = dot_product(z%data_r(:,iband),tmp%data_r(:,iband))
exch(iband,iband) = dot_product(z%data_r(:z%matsize1,iband),tmp%data_r(:,iband))
else
exch(iband,iband) = dot_product(z%data_r(:,iband),tmp%data_r(:,iband))
exch(iband,iband) = dot_product(z%data_r(:z%matsize1,iband),tmp%data_r(:,iband))
endif
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)
......
......@@ -19,6 +19,7 @@
USE m_apws
USE m_util
USE m_types
USE m_io_hybrid
IMPLICIT NONE
TYPE(t_hybdat),INTENT(IN) :: hybdat
......@@ -89,11 +90,9 @@
COMPLEX,ALLOCATABLE :: u1(:,:,:,:,:),u2(:,:,:,:,:)
COMPLEX,ALLOCATABLE :: cmt_lo(:,:,:,:)
COMPLEX,ALLOCATABLE :: cmt_apw(:,:,:)
#ifdef CPP_INVERSION
REAL :: z(dimension%nbasfcn,dimension%neigd),work(dimension%neigd)
#else
COMPLEX :: z(dimension%nbasfcn,dimension%neigd),work(dimension%neigd)
#endif
TYPE(t_mat) :: z
REAL :: work_r(dimension%neigd)
COMPLEX :: work_c(dimension%neigd)
!CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
......@@ -115,14 +114,8 @@
! read in z coefficient from direct access file z at k-point nk
#ifdef CPP_INVERSION
irecl_z = dimension%nbasfcn*dimension%neigd*8
#else
irecl_z = dimension%nbasfcn*dimension%neigd*16
#endif
OPEN(unit=778,file='z',form='unformatted',access='direct', recl=irecl_z)
READ(778,rec=nk) z
CLOSE(778)
call read_z(z,nk)
! construct local orbital consisting of radial function times spherical harmonic
! where the radial function vanishes on the MT sphere boundary
......@@ -189,7 +182,6 @@
DO ikvec = 1,invsfct*(2*l+1)
ic = ic + 1
ibas = ibas + 1
work = z(ibas,:)
kvec = kpts%bk(:,nk) +(/ lapw%k1(hybdat%kveclo_eig(ic,nk),jsp), lapw%k2(hybdat%kveclo_eig(ic,nk),jsp), lapw%k3(hybdat%kveclo_eig(ic,nk),jsp)/)
phase=exp(img*tpi_const*dot_product(atoms%taual(:,iatom),kvec))
......@@ -201,15 +193,29 @@
DO M = -l,l
lm = lm + 1
cdum2 = cdum1*conjg(ylm(lm))
DO iband = 1,hybdat%nbands(nk)
cmt_lo(iband,M,ilo,iatom ) = cmt_lo(iband,M,ilo,iatom) + cdum2*work(iband)
IF( invsfct .eq. 2 ) THEN
if (z%l_real) THEN
work_r = z%data_r(ibas,:)
DO iband = 1,hybdat%nbands(nk)
cmt_lo(iband,M,ilo,iatom ) = cmt_lo(iband,M,ilo,iatom) + cdum2*work_r(iband)
IF( invsfct .eq. 2 ) THEN
! the factor (-1)**l is necessary as we do not calculate
! the cmt_lo in the local coordinate system of the atom
cmt_lo(iband,-M,ilo,iatom1) = cmt_lo(iband,-M,ilo,iatom1) + (-1)**(l+M)*conjg(cdum2)*work(iband)
END IF
END DO
END DO
cmt_lo(iband,-M,ilo,iatom1) = cmt_lo(iband,-M,ilo,iatom1) + (-1)**(l+M)*conjg(cdum2)*work_r(iband)
END IF
END DO
else
work_c = z%data_c(ibas,:)
DO iband = 1,hybdat%nbands(nk)
cmt_lo(iband,M,ilo,iatom ) = cmt_lo(iband,M,ilo,iatom) + cdum2*work_c(iband)
IF( invsfct .eq. 2 ) THEN
! the factor (-1)**l is necessary as we do not calculate
! the cmt_lo in the local coordinate system of the atom
cmt_lo(iband,-M,ilo,iatom1) = cmt_lo(iband,-M,ilo,iatom1) + (-1)**(l+M)*conjg(cdum2)*work_c(iband)
END IF
END DO
end if
END DO
END DO !ikvec
END DO ! ilo
......@@ -235,8 +241,7 @@
ALLOCATE( cmt_apw(dimension%neigd,idum,atoms%nat) )
cmt_apw = 0
DO i = 1,lapw%nv(jsp)
work = z(i,:)
kvec = kpts%bk(:,nk) + (/ lapw%k1(i,jsp),lapw%k2(i,jsp),lapw%k3(i,jsp) /)
kvec = kpts%bk(:,nk) + (/ lapw%k1(i,jsp),lapw%k2(i,jsp),lapw%k3(i,jsp) /)
kvecn = sqrt(dot_product(matmul(kvec,cell%bmat),matmul(kvec,cell%bmat)))
iatom = 0
......@@ -275,12 +280,17 @@
wronskian( bas1_MT_tmp(p1,l,itype), drbas1_MT_tmp(p1,l,itype), AIMAG(cj),AIMAG(cdj)))
cdum = (-1)**(p+1)*enum/denom
if (z%l_real) THEN
work_r = z%data_r(i,:)
DO iband = 1,hybdat%nbands(nk)
cmt_apw(iband,lmp,iatom) = cmt_apw(iband,lmp,iatom) + cdum*work(iband)
cmt_apw(iband,lmp,iatom) = cmt_apw(iband,lmp,iatom) + cdum*work_r(iband)
END DO
else
work_c = z%data_c(i,:)
DO iband = 1,hybdat%nbands(nk)
cmt_apw(iband,lmp,iatom) = cmt_apw(iband,lmp,iatom) + cdum*work_c(iband)
END DO
end if
END DO !p
END DO !M
END DO !l
......@@ -829,12 +839,7 @@
! - arrays -
#if ( !defined(CPP_INVERSION) || defined(CPP_SOC) )
COMPLEX :: z(dimension%nbasfcn,dimension%neigd)
#else
REAL :: z(dimension%nbasfcn,dimension%neigd)
#endif
TYPE(t_mat):: z
COMPLEX,INTENT(OUT) :: momentum(bandi2:bandf2,bandi1:bandf1,3)
! - local scalars -
......@@ -857,31 +862,18 @@
COMPLEX :: cmt1(hybrid%maxlmindx,bandi1:bandf1), cmt2(hybrid%maxlmindx,bandi2:bandf2)
COMPLEX :: carr1(3),carr2(3)