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
MODULE m_checkolap
CONTAINS
SUBROUTINE checkolap(atoms,lmaxc,lmaxcd,nindxc,maxindxc,&
& core1,core2,hybrid,&
& bas1,bas2,nkpti,kpts,&
& dimension,mpi,irank2,skip_kpt,&
& input,sym,noco,&
& cell,lapw,jsp,&
& maxbands,nbands)
USE m_util , ONLY: intgrf,intgrf_init,chr,sphbessel,harmonicsr
USE m_constants
USE m_apws
USE m_types
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_hybrid),INTENT(IN) :: 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(INOUT) :: lapw
! - scalars -
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: lmaxcd
INTEGER, INTENT(IN) :: maxindxc ,maxbands
INTEGER, INTENT(IN) :: nkpti
! - arrays -
INTEGER, INTENT(IN) :: lmaxc(atoms%ntype)
INTEGER, INTENT(IN) :: nindxc(0:lmaxcd,atoms%ntype)
INTEGER, INTENT(IN) :: nbands(nkpti)
INTEGER, INTENT(IN) :: irank2(nkpti)
REAL , INTENT(IN) :: bas1 (atoms%jmtd,hybrid%maxindx ,0:atoms%lmaxd ,atoms%ntype),&
& bas2 (atoms%jmtd,hybrid%maxindx ,0:atoms%lmaxd ,atoms%ntype)
REAL , INTENT(IN) :: core1(atoms%jmtd,maxindxc,0:lmaxcd,atoms%ntype),&
& core2(atoms%jmtd,maxindxc,0:lmaxcd,atoms%ntype)
LOGICAL, INTENT(IN) :: skip_kpt(nkpti)
! - local scalars -
INTEGER :: i,itype,iatom,ikpt,ineq,igpt,iband
INTEGER :: irecl_cmt,irecl_z
INTEGER :: j,m
INTEGER :: l
INTEGER :: lm,lm1
INTEGER :: n,nred
REAL :: rdum,rdum1
REAL :: qnorm
COMPLEX :: cexp,cdum
COMPLEX , PARAMETER :: img = (0d0,1d0)
! -local arrays -
INTEGER :: iarr(2),gpt(3)
INTEGER :: matind(dimension%nbasfcn,2)
INTEGER , ALLOCATABLE :: olapcv_loc(:,:,:,:,:)
REAL :: sphbes(0:atoms%lmaxd)
REAL :: q(3)
REAL :: integrand(atoms%jmtd)
REAL :: bkpt(3)
REAL :: rarr(maxbands)
REAL :: rtaual(3)
REAL , ALLOCATABLE :: gridf(:,:)
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
COMPLEX :: cmt(dimension%neigd,hybrid%maxlmindx,atoms%nat,nkpti)
COMPLEX :: y((atoms%lmaxd+1)**2)
COMPLEX , ALLOCATABLE :: olapcv(:,:),olapww(:,:)
COMPLEX , ALLOCATABLE :: carr1(:,:),carr2(:,:),carr3(:,:)
CHARACTER, PARAMETER :: lchar(0:38) =&
& (/'s','p','d','f','g','h','i','j','k','l','m','n','o',&
& '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.
IF ( mpi%irank == 0 ) WRITE(6,'(//A)') '### checkolap ###'
cmt = 0
! initialize gridf
CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,gridf)
! read in cmt
irecl_cmt = dimension%neigd*hybrid%maxlmindx*atoms%nat*16
OPEN(unit=777,file='cmt',form='unformatted',access='direct',&
& recl=irecl_cmt)
DO ikpt = 1,nkpti
#ifdef CPP_MPI
IF ( skip_kpt(ikpt) ) CYCLE
#endif
READ(777,rec=ikpt) cmt(:,:,:,ikpt)
END DO
CLOSE(777)
IF ( mpi%irank == 0 ) WRITE(6,'(/A)') ' Overlap <core|core>'
DO itype=1,atoms%ntype
IF(atoms%ntype.gt.1 .AND. mpi%irank==0) &
& WRITE(6,'(A,I3)') ' Atom type',itype
DO l=0,lmaxc(itype)
DO i=1,nindxc(l,itype)
IF ( mpi%irank == 0 )&
& WRITE(6,'(1x,I1,A,2X)',advance='no') i+l,lchar(l)
DO j=1,i
integrand = core1(:,i,l,itype)*core1(:,j,l,itype)&
& + core2(:,i,l,itype)*core2(:,j,l,itype)
IF ( mpi%irank == 0 ) WRITE(6,'(F10.6)', advance='no')&
& intgrf(integrand,atoms%jri,atoms%jmtd,atoms%rmsh,atoms%dx,atoms%ntype,itype,gridf)
END DO
IF ( mpi%irank == 0 ) WRITE(6,*)
END DO
END DO
END DO
IF ( mpi%irank == 0 ) WRITE(6,'(/A)') ' Overlap <core|basis>'
ALLOCATE( olapcb(hybrid%maxindx),olapcv(maxbands,nkpti),&
& olapcv_avg( -lmaxcd:lmaxcd,maxindxc,0:lmaxcd,atoms%ntype),&
& olapcv_max( -lmaxcd:lmaxcd,maxindxc,0:lmaxcd,atoms%ntype),&
& olapcv_loc(2,-lmaxcd:lmaxcd,maxindxc,0:lmaxcd,atoms%ntype) )
DO itype=1,atoms%ntype
IF(atoms%ntype.gt.1 .AND. mpi%irank==0) &
& WRITE(6,'(A,I3)') ' Atom type',itype
DO l=0,lmaxc(itype)
IF(l.gt.atoms%lmax(itype)) EXIT ! very improbable case
IF ( mpi%irank == 0 ) &
& WRITE(6,"(9X,'u(',A,')',4X,'udot(',A,')',:,3X,'ulo(',A,"//&
& "') ...')") (lchar(l),i=1,min(3,hybrid%nindx(l,itype)))
DO i=1,nindxc(l,itype)
IF ( mpi%irank == 0 )&
& WRITE(6,'(1x,I1,A,2X)',advance='no') i+l,lchar(l)
DO j=1,hybrid%nindx(l,itype)
integrand = core1(:,i,l,itype)*bas1(:,j,l,itype)&
& + core2(:,i,l,itype)*bas2(:,j,l,itype)
olapcb(j) = &
& intgrf(integrand,atoms%jri,atoms%jmtd,atoms%rmsh,atoms%dx,atoms%ntype,itype,gridf)
IF ( mpi%irank == 0 )&
& WRITE(6,'(F10.6)',advance='no') olapcb(j)
END DO
lm = sum ( (/ (hybrid%nindx(j,itype)*(2*j+1),j=0,l-1) /) )
iatom = sum(atoms%neq(1:itype-1))+1 ! take first of group of equivalent atoms
DO m=-l,l
olapcv = 0
DO j=1,hybrid%nindx(l,itype)
lm = lm + 1
olapcv(:,:) = olapcv(:,:) + &
& olapcb(j)*cmt(:maxbands,lm,iatom,:nkpti)
END DO
rdum = sum ( abs(olapcv(:,:))**2 )
rdum1 = maxval ( abs(olapcv(:,:)) )
iarr = maxloc ( abs(olapcv(:,:)) )
olapcv_avg( m,i,l,itype) = &
& sqrt( rdum / nkpti / sum(nbands(:nkpti)) * nkpti )
olapcv_max( m,i,l,itype) = rdum1
olapcv_loc(:,m,i,l,itype) = iarr
END DO
IF ( mpi%irank == 0 ) WRITE(6,*)
END DO
END DO
END DO
IF( mpi%irank == 0 ) THEN
WRITE(6,'(/A)') ' Average overlap <core|val>'
DO itype=1,atoms%ntype
IF(atoms%ntype.gt.1) write(6,'(A,I3)') ' Atom type',itype
DO l=0,lmaxc(itype)
DO i=1,nindxc(l,itype)
WRITE(6,'(1x,I1,A,2X)',advance='no') i+l,lchar(l)
WRITE(6,'('//chr(2*l+1)//'F10.6)') &
& olapcv_avg(-l:l,i,l,itype)
END DO
END DO
END DO
WRITE(6,'(/A)') ' Maximum overlap <core|val> at (band/kpoint)'
DO itype=1,atoms%ntype
IF(atoms%ntype.gt.1) write(6,'(A,I3)') ' Atom type',itype
DO l=0,lmaxc(itype)
DO i=1,nindxc(l,itype)
WRITE(6,'(1x,I1,A,2X)',advance='no') i+l,lchar(l)
WRITE(6,'('//chr(2*l+1)//&
& '(F10.6,'' ('',I3.3,''/'',I4.3,'')''))')&
& (olapcv_max( m,i,l,itype),&
& olapcv_loc(:,m,i,l,itype),m=-l,l)
END DO
END DO
END DO
END IF ! mpi%irank == 0
DEALLOCATE (olapcb,olapcv,olapcv_avg,olapcv_max,olapcv_loc)
IF ( mpi%irank == 0 ) WRITE(6,'(/A)') ' Overlap <basis|basis>'
DO itype=1,atoms%ntype
IF(atoms%ntype.gt.1 .AND. mpi%irank==0) &
& WRITE(6,'(A,I3)') ' Atom type',itype
DO l=0,atoms%lmax(itype)
DO i=1,hybrid%nindx(l,itype)
IF ( mpi%irank == 0 ) THEN
SELECT CASE(i)
CASE(1)
WRITE(6,'(1x,'' u('',A,'')'')',advance='no') lchar(l)
CASE(2)
WRITE(6,'(1x,''udot('',A,'')'')',advance='no') lchar(l)
CASE DEFAULT
WRITE(6,'(1x,'' ulo('',A,'')'')',advance='no') lchar(l)
END SELECT
END IF
DO j=1,i
integrand = bas1(:,i,l,itype)*bas1(:,j,l,itype)&
& + bas2(:,i,l,itype)*bas2(:,j,l,itype)
IF ( mpi%irank == 0 ) WRITE(6,'(F10.6)',advance='no')&
& intgrf(integrand,atoms%jri,atoms%jmtd,atoms%rmsh,atoms%dx,atoms%ntype,itype,gridf)
END DO
IF ( mpi%irank == 0 ) WRITE(6,*)
END DO
END DO
END DO
IF( .not. l_mism ) RETURN
IF ( mpi%irank == 0 ) WRITE(6,'(/A)') &
& 'Mismatch of wave functions at the MT-sphere boundaries'
ALLOCATE (carr1(maxbands,(atoms%lmaxd+1)**2))
ALLOCATE (carr2(maxbands,(atoms%lmaxd+1)**2))
ALLOCATE (carr3(maxbands,(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)
END DO
CLOSE(778)
iatom = 0
DO itype = 1,atoms%ntype
DO ineq = 1,atoms%neq(itype)
iatom = iatom + 1
IF ( mpi%irank == 0 ) THEN
if(atoms%nat.gt.1) WRITE(6,'(2X,A,I3)') 'Atom',iatom
WRITE(6,'(2X,A)') 'k-point average ( maximum )'
END IF
DO ikpt = 1,nkpti