Commit 73087055 authored by Daniel Wortmann's avatar Daniel Wortmann

More bugfixes

Removed most of CPP_INVERSION
parent 2d811c6b
...@@ -76,7 +76,7 @@ CONTAINS ...@@ -76,7 +76,7 @@ CONTAINS
CALL setabc1locdn1(jspin, atoms,lapw, sym,usdus,kveclo,enough,nkvec,kvec,& CALL setabc1locdn1(jspin, atoms,lapw, sym,usdus,kveclo,enough,nkvec,kvec,&
nbasf0,alo1,blo1,clo1) nbasf0,alo1,blo1,clo1)
nvmax=lapw%nv(jspin)
!---> loop over lapws !---> loop over lapws
DO k = 1,nvmax DO k = 1,nvmax
!calculate k+G !calculate k+G
......
...@@ -53,7 +53,7 @@ CONTAINS ...@@ -53,7 +53,7 @@ CONTAINS
ALLOCATE ( lapw%k1(DIMENSION%nvd,DIMENSION%jspd),lapw%k2(DIMENSION%nvd,DIMENSION%jspd),& 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) ) lapw%k3(DIMENSION%nvd,DIMENSION%jspd),lapw%rk(DIMENSION%nvd,DIMENSION%jspd) )
ENDIF 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 !---> in a spin-spiral calculation different basis sets are used for
......
...@@ -9,7 +9,7 @@ MODULE m_eigen ...@@ -9,7 +9,7 @@ MODULE m_eigen
CONTAINS CONTAINS
SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,& SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,&
sym,kpts,DIMENSION, vacuum, input, cell, enpara_in,banddos, noco,jij, oneD,hybrid,& 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. ! sets up and solves the eigenvalue problem for a basis of lapws.
! !
...@@ -65,7 +65,7 @@ CONTAINS ...@@ -65,7 +65,7 @@ CONTAINS
TYPE(t_kpts),INTENT(IN) :: kpts TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(INOUT) :: atoms!in u_setup n_u might be modified 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 #ifdef CPP_MPI
INCLUDE 'mpif.h' INCLUDE 'mpif.h'
#endif #endif
...@@ -291,6 +291,7 @@ CONTAINS ...@@ -291,6 +291,7 @@ CONTAINS
WRITE (*,*) 'the tlmplm%tuu, tlmplm%tdd etc.: ',err,' size: ',mlotot WRITE (*,*) 'the tlmplm%tuu, tlmplm%tdd etc.: ',err,' size: ',mlotot
CALL juDFT_error("eigen: Error during allocation of tlmplm, tdd etc.",calledby ="eigen") CALL juDFT_error("eigen: Error during allocation of tlmplm, tdd etc.",calledby ="eigen")
ENDIF ENDIF
lh0=1
CALL tlmplm(sphhar,atoms,DIMENSION,enpara, jsp,1,mpi, v%mt(1,0,1,jsp),lh0,input, td,ud) 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) IF (input%l_f) CALL write_tlmplm(td,vs_mmp,atoms%n_u>0,1,jsp,input%jspins)
CALL timestop("tlmplm") CALL timestop("tlmplm")
...@@ -358,7 +359,7 @@ CONTAINS ...@@ -358,7 +359,7 @@ CONTAINS
IF( hybrid%l_hybrid ) THEN IF( hybrid%l_hybrid ) THEN
!write overlap matrix b to direct access file olap !write overlap matrix b to direct access file olap
print *,"Wrong overlap matrix used, fix this later" 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) call write_olap(olap,nrec)
...@@ -371,7 +372,7 @@ CONTAINS ...@@ -371,7 +372,7 @@ CONTAINS
IF( hybrid%l_subvxc ) THEN IF( hybrid%l_subvxc ) THEN
CALL subvxc(lapw,kpts%bk(:,nk),DIMENSION,input,jsp,vr0,atoms,ud,hybrid,enpara%el0,enpara%ello0,& 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,& sym, atoms%nlotot,kveclo, cell,sphhar, stars, xcpot,mpi,&
oneD, hamovlp) oneD, hamovlp,vx)
END IF END IF
END IF ! hybrid%l_hybrid END IF ! hybrid%l_hybrid
...@@ -419,13 +420,13 @@ CONTAINS ...@@ -419,13 +420,13 @@ CONTAINS
zmat%nbands=ne_found zmat%nbands=ne_found
CALL write_eig(eig_id, nk,jsp,ne_found,ne_all,lapw%nv(jsp),lapw%nmat,& 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),& 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),& bkpt, kpts%wtkpt(nk),eig(:ne_found),el=enpara%el0(0:,:,jsp),ello=enpara%ello0(:,:,jsp),evac=enpara%evac0(:,jsp),&
atoms%nlotot,kveclo,mpi%n_size,mpi%n_rank,zMat) nlotot=atoms%nlotot,kveclo=kveclo,n_start=mpi%n_size,n_end=mpi%n_rank,zmat=zMat)
IF (noco%l_noco) THEN IF (noco%l_noco) THEN
CALL write_eig(eig_id, nk,2,ne_found,ne_all,lapw%nv(2),lapw%nmat,& 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),& 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),& bkpt, kpts%wtkpt(nk),eig(:ne_found),el=enpara%el0(0:,:,2),ello= enpara%ello0(:,:,2),evac=enpara%evac0(:,2),&
atoms%nlotot,kveclo) nlotot=atoms%nlotot,kveclo=kveclo)
ENDIF ENDIF
#if defined(CPP_MPI) #if defined(CPP_MPI)
!RMA synchronization !RMA synchronization
......
...@@ -28,7 +28,7 @@ CONTAINS ...@@ -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) #if defined(CPP_MPI)&&defined(CPP_NEVER)
USE m_mpi_col_eigJ USE m_mpi_col_eigJ
#endif #endif
...@@ -235,6 +235,13 @@ CONTAINS ...@@ -235,6 +235,13 @@ CONTAINS
WRITE(attributes(2),'(a)') 'Htr' WRITE(attributes(2),'(a)') 'Htr'
IF (mpi%irank.EQ.0) CALL writeXMLElement('FermiEnergy',(/'value','units'/),attributes(1:2)) 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 RETURN
8020 FORMAT (/,'FERMIE:',/,& 8020 FORMAT (/,'FERMIE:',/,&
& 10x,'first approx. to ef (T=0) :',f10.6,' htr',& & 10x,'first approx. to ef (T=0) :',f10.6,' htr',&
......
...@@ -401,6 +401,7 @@ MODULE m_types ...@@ -401,6 +401,7 @@ MODULE m_types
INTEGER :: lexp INTEGER :: lexp
INTEGER :: bands1 !Only read in INTEGER :: bands1 !Only read in
INTEGER :: bands2 !Only read in INTEGER :: bands2 !Only read in
INTEGER :: nbasp
INTEGER :: maxlcutm1 INTEGER :: maxlcutm1
INTEGER :: maxindxm1 INTEGER :: maxindxm1
INTEGER :: maxbasm1 INTEGER :: maxbasm1
...@@ -452,7 +453,6 @@ MODULE m_types ...@@ -452,7 +453,6 @@ MODULE m_types
INTEGER :: l1,l2,n1,n2 INTEGER :: l1,l2,n1,n2
END TYPE prodtype END TYPE prodtype
TYPE t_hybdat TYPE t_hybdat
INTEGER :: nbasp
INTEGER :: lmaxcd,maxindxc INTEGER :: lmaxcd,maxindxc
REAL, ALLOCATABLE :: gridf(:,:) !alloc in util.F REAL, ALLOCATABLE :: gridf(:,:) !alloc in util.F
INTEGER , ALLOCATABLE:: nindxc(:,:) !alloc in eigen_HF_init INTEGER , ALLOCATABLE:: nindxc(:,:) !alloc in eigen_HF_init
......
...@@ -12,6 +12,8 @@ module m_types_rcmat ...@@ -12,6 +12,8 @@ module m_types_rcmat
PROCEDURE :: multiply=>t_mat_multiply PROCEDURE :: multiply=>t_mat_multiply
PROCEDURE :: transpose=>t_mat_transpose PROCEDURE :: transpose=>t_mat_transpose
PROCEDURE :: from_packed=>t_mat_from_packed PROCEDURE :: from_packed=>t_mat_from_packed
PROCEDURE :: inverse =>t_mat_inverse
PROCEDURE :: to_packed=>t_mat_to_packed
END type t_mat END type t_mat
CONTAINS CONTAINS
...@@ -33,7 +35,9 @@ module m_types_rcmat ...@@ -33,7 +35,9 @@ module m_types_rcmat
IF (mat%l_real) THEN IF (mat%l_real) THEN
ALLOCATE(mat%data_r(mat%matsize1,mat%matsize2),STAT=err) ALLOCATE(mat%data_r(mat%matsize1,mat%matsize2),STAT=err)
ALLOCATE(mat%data_c(0,0))
ELSE ELSE
ALLOCATE(mat%data_r(0,0))
ALLOCATE(mat%data_c(mat%matsize1,mat%matsize2),STAT=err) ALLOCATE(mat%data_c(mat%matsize1,mat%matsize2),STAT=err)
ENDIF ENDIF
...@@ -86,7 +90,7 @@ module m_types_rcmat ...@@ -86,7 +90,7 @@ module m_types_rcmat
end IF end IF
end SUBROUTINE t_mat_transpose 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 CLASS(t_mat),INTENT(INOUT) :: mat1
INTEGER,INTENT(IN) :: matsize INTEGER,INTENT(IN) :: matsize
LOGICAL,INTENT(IN) :: l_real LOGICAL,INTENT(IN) :: l_real
...@@ -94,17 +98,68 @@ module m_types_rcmat ...@@ -94,17 +98,68 @@ module m_types_rcmat
COMPLEX,INTENT(IN) :: packed_c(:) COMPLEX,INTENT(IN) :: packed_c(:)
INTEGER:: n,nn,i INTEGER:: n,nn,i
call mat1%alloc(l_real,matsize) call mat1%alloc(l_real,matsize,matsize)
i=1 i=1
DO n=1,matsize DO n=1,matsize
DO nn=1,n DO nn=1,n
if (l_real) THEN if (l_real) THEN
mat1%data_r(n,nn)=packed_r(i) mat1%data_r(n,nn)=packed_r(i)
mat1%data_r(nn,n)=packed_r(i)
else 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 end if
i=i+1 i=i+1
end DO end DO
end DO end DO
end SUBROUTINE t_mat_from_packed 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 end module m_types_rcmat
...@@ -41,7 +41,7 @@ ...@@ -41,7 +41,7 @@
! - local scalars - ! - local scalars -
INTEGER :: i,itype,iatom,ikpt,ineq,igpt,iband INTEGER :: i,itype,iatom,ikpt,ineq,igpt,iband
INTEGER :: irecl_cmt,irecl_z INTEGER :: irecl_cmt
INTEGER :: j,m INTEGER :: j,m
INTEGER :: l INTEGER :: l
INTEGER :: lm,lm1 INTEGER :: lm,lm1
...@@ -66,13 +66,7 @@ ...@@ -66,13 +66,7 @@
REAL :: rtaual(3) REAL :: rtaual(3)
REAL , ALLOCATABLE :: olapcb(:) REAL , ALLOCATABLE :: olapcb(:)
REAL , ALLOCATABLE :: olapcv_avg(:,:,:,:),olapcv_max(:,:,:,:) REAL , ALLOCATABLE :: olapcv_avg(:,:,:,:),olapcv_max(:,:,:,:)
#ifdef CPP_INVERSION TYPE(t_mat),ALLOCATABLE :: z(:)
REAL , ALLOCATABLE :: olappp(:,:)
REAL :: z(dimension%nbasfcn,dimension%neigd,nkpti)
#else
COMPLEX , ALLOCATABLE :: olappp(:,:)
COMPLEX :: z(dimension%nbasfcn,dimension%neigd,nkpti)
#endif
COMPLEX :: cmt(dimension%neigd,hybrid%maxlmindx,atoms%nat,nkpti) COMPLEX :: cmt(dimension%neigd,hybrid%maxlmindx,atoms%nat,nkpti)
COMPLEX :: y((atoms%lmaxd+1)**2) COMPLEX :: y((atoms%lmaxd+1)**2)
...@@ -85,7 +79,11 @@ ...@@ -85,7 +79,11 @@
& 'x','x','x','x','x','x','x','x','x','x','x','x','x' /) & 'x','x','x','x','x','x','x','x','x','x','x','x','x' /)
LOGICAL :: l_mism = .true. 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 ###' IF ( mpi%irank == 0 ) WRITE(6,'(//A)') '### checkolap ###'
cmt = 0 cmt = 0
...@@ -238,18 +236,9 @@ ...@@ -238,18 +236,9 @@
ALLOCATE (carr1(maxval(hybdat%nbands),(atoms%lmaxd+1)**2)) ALLOCATE (carr1(maxval(hybdat%nbands),(atoms%lmaxd+1)**2))
ALLOCATE (carr2(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)) 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 DO ikpt = 1,nkpti
READ(778,rec=ikpt) z(:,:,ikpt) call read_z(z(ikpt),ikpt)
END DO END DO
CLOSE(778)
iatom = 0 iatom = 0
DO itype = 1,atoms%ntype DO itype = 1,atoms%ntype
...@@ -292,8 +281,12 @@ ...@@ -292,8 +281,12 @@
DO m = -l,l DO m = -l,l
lm = lm + 1 lm = lm + 1
DO iband = 1,hybdat%nbands(ikpt) DO iband = 1,hybdat%nbands(ikpt)
carr2(iband,lm) = carr2(iband,lm) + cdum * z(igpt,iband,ikpt) * y(lm) if (z(1)%l_real) THEN
END DO 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 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 ...@@ -43,8 +43,6 @@ contains
END IF END IF
IF( hybrid%l_calhf ) THEN 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 !initialize hybdat%gridf for radial integration
CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf) CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
...@@ -72,25 +70,11 @@ contains ...@@ -72,25 +70,11 @@ contains
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation hybdat%eig_c' 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 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) ALLOCATE( hybdat%nbasm(kpts%nkptf) ,stat=ok)
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation hybdat%nbasm' IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation hybdat%nbasm'
DO nk = 1,kpts%nkptf DO nk = 1,kpts%nkptf
hybdat%nbasm(nk) = hybdat%nbasp + hybrid%ngptm(nk) hybdat%nbasm(nk) = hybrid%nbasp + hybrid%ngptm(nk)
END DO END DO
! pre-calculate gaunt coefficients ! pre-calculate gaunt coefficients
......
...@@ -21,7 +21,7 @@ CONTAINS ...@@ -21,7 +21,7 @@ CONTAINS
TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym 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) :: irank2(:),it
INTEGER,INTENT(IN) :: jsp,eig_id_hf INTEGER,INTENT(IN) :: jsp,eig_id_hf
...@@ -40,7 +40,7 @@ CONTAINS ...@@ -40,7 +40,7 @@ CONTAINS
INTEGER :: degenerat(DIMENSION%neigd2+1,kpts%nkpt) INTEGER :: degenerat(DIMENSION%neigd2+1,kpts%nkpt)
INTEGER :: matind(DIMENSION%nbasfcn,2),nred INTEGER :: matind(DIMENSION%nbasfcn,2),nred
TYPE(t_lapw) :: lapw TYPE(t_lapw) :: lapw
LOGICAL:: skip_kpt(kpts%nkpt) LOGICAL:: skip_kpt(kpts%nkpt)
REAL :: g(3) REAL :: g(3)
skip_kpt=.FALSE. skip_kpt=.FALSE.
...@@ -72,12 +72,14 @@ CONTAINS ...@@ -72,12 +72,14 @@ CONTAINS
zmat(nk)%nbands=dimension%neigd2 zmat(nk)%nbands=dimension%neigd2
if (l_real) THEN if (l_real) THEN
ALLOCATE(zmat(nk)%z_r(dimension%nbasfcn,dimension%neigd2)) ALLOCATE(zmat(nk)%z_r(dimension%nbasfcn,dimension%neigd2))
ALLOCATE(zmat(nk)%z_c(0,0))
else else
ALLOCATE(zmat(nk)%z_c(dimension%nbasfcn,dimension%neigd2)) ALLOCATE(zmat(nk)%z_c(dimension%nbasfcn,dimension%neigd2))
ALLOCATE(zmat(nk)%z_r(0,0))
endif endif
print *,"eigen_HF_Setup: read_eig:",nk print *,"eigen_HF_Setup: read_eig:",nk
print *,zmat(nk)%nbasfcn,zmat(nk)%nbands,hybdat%ne_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" print *,"Done"
END DO END DO
...@@ -144,7 +146,7 @@ CONTAINS ...@@ -144,7 +146,7 @@ CONTAINS
END DO END DO
DO i = 1,hybdat%ne_eig(nk) 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 END DO
...@@ -294,8 +296,8 @@ CONTAINS ...@@ -294,8 +296,8 @@ CONTAINS
! Reading the eig file ! Reading the eig file
!DO nk = n_start,kpts%nkpt,n_stride !DO nk = n_start,kpts%nkpt,n_stride
DO nk = 1,kpts%nkpt,1 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)) 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 ) hybdat%nobd(nk) = COUNT(results%w_iks(:hybdat%ne_eig(nk),nk,jsp) > 0.0 )
END DO END DO
hybrid%maxlmindx = MAXVAL((/ ( SUM( (/ (hybrid%nindx(l,itype)*(2*l+1), l=0,atoms%lmax(itype)) /) ),itype=1,atoms%ntype) /) ) 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 @@ ...@@ -67,7 +67,7 @@
! - - local scalars - - ! - - local scalars - -
INTEGER :: ilo,idum ,m INTEGER :: ilo,idum ,m
COMPLEX :: cdum COMPLEX :: cdum
TYPE(t_mat) :: zhlp
! local scalars for apws ! local scalars for apws
INTEGER :: nred INTEGER :: nred
INTEGER :: ikpt0,ikpt,itype,iop,ispin,ieq,indx,iatom INTEGER :: ikpt0,ikpt,itype,iop,ispin,ieq,indx,iatom
...@@ -87,9 +87,7 @@ ...@@ -87,9 +87,7 @@
INTEGER :: map_lo(atoms%nlod) INTEGER :: map_lo(atoms%nlod)
INTEGER :: iarr(0:atoms%lmaxd,atoms%ntype) INTEGER :: iarr(0:atoms%lmaxd,atoms%ntype)
COMPLEX,ALLOCATABLE :: acof(:,:,:),bcof(:,:,:),ccof(:,:,:,:) COMPLEX,ALLOCATABLE :: acof(:,:,:),bcof(:,:,:),ccof(:,:,:,:)
REAL,ALLOCATABLE :: zhlp_r(:,:)
COMPLEX,ALLOCATABLE :: zhlp_c(:,:)
COMPLEX,ALLOCATABLE :: cmt(:,:,:),cmthlp(:,:,:) COMPLEX,ALLOCATABLE :: cmt(:,:,:),cmthlp(:,:,:)
...@@ -114,12 +112,14 @@ ...@@ -114,12 +112,14 @@
INTEGER :: irecl_cmt,irecl_z INTEGER :: irecl_cmt,irecl_z
TYPE(t_lapw) :: lapw(kpts%nkpt) TYPE(t_lapw) :: lapw(kpts%nkptf)
TYPE(t_usdus):: usdus TYPE(t_usdus):: usdus
!CALL CPU_TIME(time1) !CALL CPU_TIME(time1)
call usdus%init(atoms,dimension%jspd) call usdus%init(atoms,dimension%jspd)
call zhlp%alloc(zmat(1)%l_real,zmat(1)%nbasfcn,zmat(1)%nbands)
! setup rotations in reciprocal space ! setup rotations in reciprocal space
DO iop=1,sym%nsym DO iop=1,sym%nsym
IF( iop .le. sym%nop ) THEN IF( iop .le. sym%nop ) THEN
...@@ -131,7 +131,7 @@ ...@@ -131,7 +131,7 @@
! generate G-vectors, which fulfill |k+G|<rkmax ! generate G-vectors, which fulfill |k+G|<rkmax
! for all k-points ! for all k-points
DO ikpt=1,kpts%nkpt DO ikpt=1,kpts%nkptf
CALL apws(dimension,input,noco,& CALL apws(dimension,input,noco,&
& kpts,ikpt,cell,sym%zrfs,& & kpts,ikpt,cell,sym%zrfs,&
& 1,jsp,bkpt,lapw(ikpt),matind,nred) & 1,jsp,bkpt,lapw(ikpt),matind,nred)
...@@ -271,23 +271,9 @@ ...@@ -271,23 +271,9 @@
IF( ok .ne. 0 ) STOP 'gen_wavf: Failure allocation cmt' IF( ok .ne. 0 ) STOP 'gen_wavf: Failure allocation cmt'
ALLOCATE ( cmthlp(dimension%neigd,hybrid%maxlmindx,atoms%nat), stat=ok) ALLOCATE ( cmthlp(dimension%neigd,hybrid%maxlmindx,atoms%nat), stat=ok)
IF( ok .ne. 0) STOP 'gen_wavf: failure allocation cmthlp' 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 DO ikpt0 = lower, upper
acof = 0; bcof = 0; ccof = 0 acof = 0; bcof = 0; ccof = 0
...@@ -299,7 +285,7 @@ ...@@ -299,7 +285,7 @@
input,atoms,hybdat%nbands(ikpt0),sym, cell, Kpts%bk(:,ikpt0), lapw(ikpt0), & input,atoms,hybdat%nbands(ikpt0),sym, cell, Kpts%bk(:,ikpt0), lapw(ikpt0), &
hybdat%nbands(ikpt0),usdus,noco,jsp,hybdat%kveclo_eig(:,ikpt0),& hybdat%nbands(ikpt0),usdus,noco,jsp,hybdat%kveclo_eig(:,ikpt0),&
oneD,acof(: hybdat%nbands(ikpt0),:,:),bcof(: hybdat%nbands(ikpt0),:,:),ccof(:,: hybdat%nbands(ikpt0),:,:),& oneD,acof(: hybdat%nbands(ikpt0),:,:),bcof(: hybdat%nbands(ikpt0),:,:),ccof(:,: hybdat%nbands(ikpt0),:,:),&
zmat(ikpt)) zmat(ikpt0))
! call was ... ! call was ...
...@@ -383,37 +369,30 @@ ...@@ -383,37 +369,30 @@
! write cmt at irreducible k-points in direct-access file cmt ! write cmt at irreducible k-points in direct-access file cmt
call write_cmt(cmt,ikpt0) call write_cmt(cmt,ikpt0)
call zhlp%alloc(zmat(1)%l_real,zmat(1)%nbasfcn,zmat(1)%nbands)
! write z at irreducible k-points in direct-access file z
IF (zmat(1)%l_real) THEN IF (zhlp%l_real) THEN
WRITE(778,rec=ikpt0) zmat(ikpt0)%z_r(:,:) zhlp%data_r=zmat(ikpt0)%z_r
ELSE ELSE
WRITE(778,rec=ikpt0) zmat(ikpt0)%z_c(:,:) zhlp%data_c=zmat(ikpt0)%z_c
ENDIF end IF
call write_z(zhlp,ikpt0)