Commit 1730364b authored by Matthias Redies's avatar Matthias Redies

format all the hybrid code

parent 567d369d
MODULE m_hf_init
!
! preparations for HF and hybrid functional calculation
!
!
! preparations for HF and hybrid functional calculation
!
CONTAINS
SUBROUTINE hf_init(hybrid,kpts,atoms,input,DIMENSION,hybdat,l_real)
USE m_types
USE m_read_core
USE m_util
USE m_io_hybrid
IMPLICIT NONE
TYPE(t_hybrid),INTENT(INOUT) :: hybrid
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_input),INTENT(IN) :: input
TYPE(t_dimension),INTENT(IN) :: DIMENSION
TYPE(t_hybdat),INTENT(OUT) :: hybdat
LOGICAL,INTENT(IN) :: l_real
INTEGER:: itype,ieq,l,m,i,nk,l1,l2,m1,m2,ok
SUBROUTINE hf_init(hybrid, kpts, atoms, input, DIMENSION, hybdat, l_real)
USE m_types
USE m_read_core
USE m_util
USE m_io_hybrid
IMPLICIT NONE
TYPE(t_hybrid), INTENT(INOUT) :: hybrid
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_input), INTENT(IN) :: input
TYPE(t_dimension), INTENT(IN) :: DIMENSION
TYPE(t_hybdat), INTENT(OUT) :: hybdat
LOGICAL, INTENT(IN) :: l_real
!initialize hybdat%gridf for radial integration
CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
!Alloc variables
ALLOCATE(hybdat%lmaxc(atoms%ntype))
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))
ALLOCATE(hybdat%drbas1_MT(hybrid%maxindx,0:atoms%lmaxd,atoms%ntype))
!sym%tau = oneD%ods%tau
INTEGER:: itype, ieq, l, m, i, nk, l1, l2, m1, m2, ok
! preparations for core states
CALL core_init(dimension,input,atoms, hybdat%lmaxcd,hybdat%maxindxc)
ALLOCATE( hybdat%nindxc(0:hybdat%lmaxcd,atoms%ntype), stat = ok )
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation hybdat%nindxc'
ALLOCATE( hybdat%core1(atoms%jmtd,hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype), stat=ok )
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation core1'
ALLOCATE( hybdat%core2(atoms%jmtd,hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype), stat=ok )
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation core2'
ALLOCATE( hybdat%eig_c(hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype), stat=ok )
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
!initialize hybdat%gridf for radial integration
CALL intgrf_init(atoms%ntype, atoms%jmtd, atoms%jri, atoms%dx, atoms%rmsh, hybdat%gridf)
! pre-calculate gaunt coefficients
!Alloc variables
ALLOCATE (hybdat%lmaxc(atoms%ntype))
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))
ALLOCATE (hybdat%drbas1_MT(hybrid%maxindx, 0:atoms%lmaxd, atoms%ntype))
hybdat%maxfac = max(2*atoms%lmaxd+hybrid%maxlcutm1+1,2*hybdat%lmaxcd+2*atoms%lmaxd+1)
ALLOCATE ( hybdat%fac( 0:hybdat%maxfac),hybdat%sfac( 0:hybdat%maxfac),stat=ok)
IF( ok .ne. 0 ) STOP 'eigen_hf: failure allocation fac,hybdat%sfac'
hybdat%fac(0) = 1
hybdat%sfac(0) = 1
DO i=1,hybdat%maxfac
hybdat%fac(i) = hybdat%fac(i-1)*i ! hybdat%fac(i) = i!
hybdat%sfac(i) = hybdat%sfac(i-1)*sqrt(i*1.0) ! hybdat%sfac(i) = sqrt(i!)
END DO
!sym%tau = oneD%ods%tau
! preparations for core states
CALL core_init(dimension, input, atoms, hybdat%lmaxcd, hybdat%maxindxc)
ALLOCATE (hybdat%nindxc(0:hybdat%lmaxcd, atoms%ntype), stat=ok)
IF (ok /= 0) STOP 'eigen_hf: failure allocation hybdat%nindxc'
ALLOCATE (hybdat%core1(atoms%jmtd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok)
IF (ok /= 0) STOP 'eigen_hf: failure allocation core1'
ALLOCATE (hybdat%core2(atoms%jmtd, hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok)
IF (ok /= 0) STOP 'eigen_hf: failure allocation core2'
ALLOCATE (hybdat%eig_c(hybdat%maxindxc, 0:hybdat%lmaxcd, atoms%ntype), stat=ok)
IF (ok /= 0) STOP 'eigen_hf: failure allocation hybdat%eig_c'
hybdat%nindxc = 0; hybdat%core1 = 0; hybdat%core2 = 0; hybdat%eig_c = 0
ALLOCATE ( hybdat%gauntarr( 2, 0:atoms%lmaxd, 0:atoms%lmaxd, 0:hybrid%maxlcutm1, -atoms%lmaxd:atoms%lmaxd ,-hybrid%maxlcutm1:hybrid%maxlcutm1 ),stat=ok)
IF( ok .ne. 0 ) STOP 'eigen: failure allocation hybdat%gauntarr'
hybdat%gauntarr = 0
DO l2 = 0,atoms%lmaxd
DO l1 = 0,atoms%lmaxd
DO l = abs(l1-l2),min(l1+l2,hybrid%maxlcutm1)
DO m = -l,l
DO m1 = -l1,l1
m2 = m1 + m ! Gaunt condition -m1+m2-m = 0
IF(abs(m2).le.l2) hybdat%gauntarr(1,l1,l2,l,m1,m) = gaunt(l1,l2,l,m1,m2,m,hybdat%maxfac,hybdat%fac,hybdat%sfac)
m2 = m1 - m ! switch role of l2-index
IF(abs(m2).le.l2) hybdat%gauntarr(2,l1,l2,l,m1,m) = gaunt(l2,l1,l,m2,m1,m,hybdat%maxfac,hybdat%fac,hybdat%sfac)
END DO
END DO
END DO
END DO
END DO
! pre-calculate gaunt coefficients
!skip_kpt = .false.
hybdat%maxfac = max(2*atoms%lmaxd + hybrid%maxlcutm1 + 1, 2*hybdat%lmaxcd + 2*atoms%lmaxd + 1)
ALLOCATE (hybdat%fac(0:hybdat%maxfac), hybdat%sfac(0:hybdat%maxfac), stat=ok)
IF (ok /= 0) STOP 'eigen_hf: failure allocation fac,hybdat%sfac'
hybdat%fac(0) = 1
hybdat%sfac(0) = 1
DO i = 1, hybdat%maxfac
hybdat%fac(i) = hybdat%fac(i - 1)*i ! hybdat%fac(i) = i!
hybdat%sfac(i) = hybdat%sfac(i - 1)*sqrt(i*1.0) ! hybdat%sfac(i) = sqrt(i!)
END DO
END SUBROUTINE hf_init
ALLOCATE (hybdat%gauntarr(2, 0:atoms%lmaxd, 0:atoms%lmaxd, 0:hybrid%maxlcutm1, -atoms%lmaxd:atoms%lmaxd, -hybrid%maxlcutm1:hybrid%maxlcutm1), stat=ok)
IF (ok /= 0) STOP 'eigen: failure allocation hybdat%gauntarr'
hybdat%gauntarr = 0
DO l2 = 0, atoms%lmaxd
DO l1 = 0, atoms%lmaxd
DO l = abs(l1 - l2), min(l1 + l2, hybrid%maxlcutm1)
DO m = -l, l
DO m1 = -l1, l1
m2 = m1 + m ! Gaunt condition -m1+m2-m = 0
IF (abs(m2) <= l2) hybdat%gauntarr(1, l1, l2, l, m1, m) = gaunt(l1, l2, l, m1, m2, m, hybdat%maxfac, hybdat%fac, hybdat%sfac)
m2 = m1 - m ! switch role of l2-index
IF (abs(m2) <= l2) hybdat%gauntarr(2, l1, l2, l, m1, m) = gaunt(l2, l1, l, m2, m1, m, hybdat%maxfac, hybdat%fac, hybdat%sfac)
END DO
END DO
END DO
END DO
END DO
!skip_kpt = .false.
END SUBROUTINE hf_init
END MODULE m_hf_init
......@@ -40,95 +40,95 @@ MODULE m_add_vnonlocal
! c
! M.Betzinger (09/07) c
! c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c
CONTAINS
CONTAINS
SUBROUTINE add_vnonlocal(nk,lapw,atoms,hybrid,dimension,kpts,jsp,results,xcpot,noco,hmat)
SUBROUTINE add_vnonlocal(nk, lapw, atoms, hybrid, dimension, kpts, jsp, results, xcpot, noco, hmat)
USE m_symm_hf, ONLY: symm_hf
USE m_util, ONLY: intgrf,intgrf_init
USE m_symm_hf, ONLY: symm_hf
USE m_util, ONLY: intgrf, intgrf_init
USE m_exchange_valence_hf
USE m_exchange_core
USE m_symmetrizeh
USE m_wrapper
USE m_hsefunctional, ONLY: exchange_vccvHSE,exchange_ccccHSE
USE m_hsefunctional, ONLY: exchange_vccvHSE, exchange_ccccHSE
USE m_types
USE m_io_hybrid
IMPLICIT NONE
TYPE(t_results), INTENT(INOUT) :: results
CLASS(t_xcpot), INTENT(IN) :: xcpot
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_hybrid), INTENT(INOUT) :: hybrid
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_lapw), INTENT(IN) :: lapw
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_mat), INTENT(INOUT) :: hmat
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: nk
TYPE(t_results), INTENT(INOUT) :: results
CLASS(t_xcpot), INTENT(IN) :: xcpot
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_hybrid), INTENT(INOUT) :: hybrid
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_lapw), INTENT(IN) :: lapw
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_mat), INTENT(INOUT) :: hmat
INTEGER, INTENT(IN) :: jsp
INTEGER, INTENT(IN) :: nk
! local scalars
INTEGER :: n,nn,iband,nbasfcn
INTEGER :: n, nn, iband, nbasfcn
REAL :: a_ex
TYPE(t_mat) :: olap,tmp,v_x,z
COMPLEX :: exch(dimension%neigd,dimension%neigd)
TYPE(t_mat) :: olap, tmp, v_x, z
COMPLEX :: exch(dimension%neigd, dimension%neigd)
! initialize weighting factor for HF exchange part
a_ex=xcpot%get_exchange_weight()
a_ex = xcpot%get_exchange_weight()
nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
CALL v_x%init(hmat%l_real,nbasfcn,nbasfcn)
nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*atoms%nlotot, lapw%nv(1) + atoms%nlotot, noco%l_noco)
CALL v_x%init(hmat%l_real, nbasfcn, nbasfcn)
CALL read_v_x(v_x,kpts%nkpt*(jsp-1)+nk)
CALL read_v_x(v_x, kpts%nkpt*(jsp - 1) + nk)
! add non-local x-potential to the hamiltonian hmat
DO n = 1, v_x%matsize1
DO nn = 1, n
DO nn = 1, n
IF (hmat%l_real) THEN
hmat%data_r(nn,n) = hmat%data_r(nn,n) - a_ex*v_x%data_r(nn,n)
hmat%data_r(nn, n) = hmat%data_r(nn, n) - a_ex*v_x%data_r(nn, n)
ELSE
hmat%data_c(nn,n) = hmat%data_c(nn,n) - a_ex*v_x%data_c(nn,n)
hmat%data_c(nn, n) = hmat%data_c(nn, n) - a_ex*v_x%data_c(nn, n)
ENDIF
END DO
END DO
! calculate HF energy
IF(hybrid%l_calhf) THEN
WRITE(6,'(A)') new_line('n')//new_line('n')//' ### '// ' diagonal HF exchange elements (eV) ###'
WRITE(6,'(A)') new_line('n') // ' k-point '// 'band tail pole total(valence+core)'
IF (hybrid%l_calhf) THEN
WRITE (6, '(A)') new_line('n')//new_line('n')//' ### '//' diagonal HF exchange elements (eV) ###'
WRITE (6, '(A)') new_line('n')//' k-point '//'band tail pole total(valence+core)'
END IF
! read in lower triangle part of overlap matrix from direct acces file olap
CALL olap%init(hmat%l_real,nbasfcn,nbasfcn)
CALL read_olap(olap,kpts%nkpt*(jsp-1)+nk)
IF (.NOT.olap%l_real) olap%data_c=conjg(olap%data_c)
CALL olap%init(hmat%l_real, nbasfcn, nbasfcn)
CALL read_olap(olap, kpts%nkpt*(jsp - 1) + nk)
IF (.NOT. olap%l_real) olap%data_c = conjg(olap%data_c)
CALL z%init(olap%l_real, nbasfcn, dimension%neigd)
CALL z%init(olap%l_real,nbasfcn,dimension%neigd)
CALL read_z(z, kpts%nkpt*(jsp - 1) + nk)
CALL read_z(z,kpts%nkpt*(jsp-1)+nk)
! calculate exchange contribution of current k-point nk to total energy (te_hfex)
! in the case of a spin-unpolarized calculation the factor 2 is added in eigen.F90
IF (.NOT.v_x%l_real) v_x%data_c=conjg(v_x%data_c)
! in the case of a spin-unpolarized calculation the factor 2 is added in eigen.F90
IF (.NOT. v_x%l_real) v_x%data_c = conjg(v_x%data_c)
exch = 0
z%matsize1=MIN(z%matsize1,v_x%matsize2)
z%matsize1 = MIN(z%matsize1, v_x%matsize2)
CALL v_x%multiply(z,tmp)
CALL v_x%multiply(z, tmp)
DO iband = 1, hybrid%nbands(nk)
IF (z%l_real) THEN
exch(iband,iband) = dot_product(z%data_r(:z%matsize1,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_c(:z%matsize1,iband),tmp%data_c(:,iband))
exch(iband, iband) = dot_product(z%data_c(:z%matsize1, iband), tmp%data_c(:, iband))
END IF
IF(iband.LE.hybrid%nobd(nk)) THEN
results%te_hfex%valence = results%te_hfex%valence -a_ex*results%w_iks(iband,nk,jsp)*exch(iband,iband)
IF (iband <= hybrid%nobd(nk)) THEN
results%te_hfex%valence = results%te_hfex%valence - a_ex*results%w_iks(iband, nk, jsp)*exch(iband, iband)
END IF
IF(hybrid%l_calhf) THEN
WRITE(6, '( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,4X,3F15.5)')&
kpts%bkf(:,nk),iband, (REAL(exch(iband,iband))-hybrid%div_vv(iband,nk,jsp))*(-27.211608),&
hybrid%div_vv(iband,nk,jsp)*(-27.211608),REAL(exch(iband,iband))*(-27.211608)
IF (hybrid%l_calhf) THEN
WRITE (6, '( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,4X,3F15.5)') &
kpts%bkf(:, nk), iband, (REAL(exch(iband, iband)) - hybrid%div_vv(iband, nk, jsp))*(-27.211608), &
hybrid%div_vv(iband, nk, jsp)*(-27.211608), REAL(exch(iband, iband))*(-27.211608)
END IF
END DO
END SUBROUTINE add_vnonlocal
......
......@@ -2,321 +2,320 @@
CONTAINS
SUBROUTINE checkolap(atoms,hybdat,&
& hybrid,&
& nkpti,kpts,&
& dimension,mpi,skip_kpt,&
& input,sym,noco,&
& cell,lapw,jsp)
USE m_util , ONLY: intgrf,intgrf_init,chr,sphbessel,harmonicsr
USE m_constants
USE m_types
USE m_io_hybrid
IMPLICIT NONE
TYPE(t_hybdat),INTENT(IN) :: hybdat
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) :: nkpti
! - arrays -
LOGICAL, INTENT(IN) :: skip_kpt(nkpti)
! - local scalars -
INTEGER :: i,itype,iatom,ikpt,ineq,igpt,iband
INTEGER :: irecl_cmt
INTEGER :: j,m
INTEGER :: l
INTEGER :: lm,lm1
INTEGER :: n,nred, nbasfcn
REAL :: rdum,rdum1
REAL :: qnorm
COMPLEX :: cexp,cdum
COMPLEX , PARAMETER :: img = (0.0,1.0)
! -local arrays -
INTEGER :: iarr(2),gpt(3)
INTEGER , ALLOCATABLE :: olapcv_loc(:,:,:,:,:)
REAL :: sphbes(0:atoms%lmaxd)
REAL :: q(3)
REAL :: integrand(atoms%jmtd)
REAL :: bkpt(3)
REAL :: rarr(maxval(hybrid%nbands))
REAL :: rtaual(3)
REAL , ALLOCATABLE :: olapcb(:)
REAL , ALLOCATABLE :: olapcv_avg(:,:,:,:),olapcv_max(:,:,:,:)
TYPE(t_mat),ALLOCATABLE :: z(:)
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.
ALLOCATE(z(nkpti))
DO ikpt=1,nkpti
CALL lapw%init(input,noco,kpts,atoms,sym,ikpt,cell,sym%zrfs)
nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
call z(ikpt)%alloc(sym%invs,nbasfcn,dimension%neigd)
ENDDO
IF ( mpi%irank == 0 ) WRITE(6,'(//A)') '### checkolap ###'
cmt = 0
! initialize gridf -> was done in eigen_HF_init
!CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
! read in cmt
DO ikpt = 1,nkpti
SUBROUTINE checkolap(atoms, hybdat,&
& hybrid,&
& nkpti, kpts,&
& dimension, mpi, skip_kpt,&
& input, sym, noco,&
& cell, lapw, jsp)
USE m_util, ONLY: intgrf, intgrf_init, chr, sphbessel, harmonicsr
USE m_constants
USE m_types
USE m_io_hybrid
IMPLICIT NONE
TYPE(t_hybdat), INTENT(IN) :: hybdat
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) :: nkpti
! - arrays -
LOGICAL, INTENT(IN) :: skip_kpt(nkpti)
! - local scalars -
INTEGER :: i, itype, iatom, ikpt, ineq, igpt, iband
INTEGER :: irecl_cmt
INTEGER :: j, m
INTEGER :: l
INTEGER :: lm, lm1
INTEGER :: n, nred, nbasfcn
REAL :: rdum, rdum1
REAL :: qnorm
COMPLEX :: cexp, cdum
COMPLEX, PARAMETER :: img = (0.0, 1.0)
! -local arrays -
INTEGER :: iarr(2), gpt(3)
INTEGER, ALLOCATABLE :: olapcv_loc(:, :, :, :, :)
REAL :: sphbes(0:atoms%lmaxd)
REAL :: q(3)
REAL :: integrand(atoms%jmtd)
REAL :: bkpt(3)
REAL :: rarr(maxval(hybrid%nbands))
REAL :: rtaual(3)
REAL, ALLOCATABLE :: olapcb(:)
REAL, ALLOCATABLE :: olapcv_avg(:, :, :, :), olapcv_max(:, :, :, :)
TYPE(t_mat), ALLOCATABLE :: z(:)
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.
ALLOCATE (z(nkpti))
DO ikpt = 1, nkpti
CALL lapw%init(input, noco, kpts, atoms, sym, ikpt, cell, sym%zrfs)
nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*atoms%nlotot, lapw%nv(1) + atoms%nlotot, noco%l_noco)
call z(ikpt)%alloc(sym%invs, nbasfcn, dimension%neigd)
ENDDO
IF (mpi%irank == 0) WRITE (6, '(//A)') '### checkolap ###'
cmt = 0
! initialize gridf -> was done in eigen_HF_init
!CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
! read in cmt
DO ikpt = 1, nkpti
#ifdef CPP_MPI
IF ( skip_kpt(ikpt) ) CYCLE
IF (skip_kpt(ikpt)) CYCLE
#endif
call read_cmt(cmt(:,:,:,ikpt),ikpt)
END DO
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,hybdat%lmaxc(itype)
DO i=1,hybdat%nindxc(l,itype)
IF ( mpi%irank == 0 )&
& WRITE(6,'(1x,I1,A,2X)',advance='no') i+l,lchar(l)
DO j=1,i
integrand = hybdat%core1(:,i,l,itype)*hybdat%core1(:,j,l,itype)&
& + hybdat%core2(:,i,l,itype)*hybdat%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,hybdat%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(maxval(hybrid%nbands),nkpti),&
& olapcv_avg( -hybdat%lmaxcd:hybdat%lmaxcd,hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype),&
& olapcv_max( -hybdat%lmaxcd:hybdat%lmaxcd,hybdat%maxindxc,0:hybdat%lmaxcd,atoms%ntype),&
& olapcv_loc(2,-hybdat%lmaxcd:hybdat%lmaxcd,hybdat%maxindxc,0:hybdat%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,hybdat%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,hybdat%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 = hybdat%core1(:,i,l,itype)*hybdat%bas1(:,j,l,itype)&
& + hybdat%core2(:,i,l,itype)*hybdat%bas2(:,j,l,itype)
olapcb(j) = &
& intgrf(integrand,atoms%jri,atoms%jmtd,atoms%rmsh,atoms%dx,atoms%ntype,itype,hybdat%gridf)
IF ( mpi%irank == 0 )&
& WRITE(6,'(F10.6)',advance='no') olapcb(j)
call read_cmt(cmt(:, :, :, ikpt), ikpt)
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(:maxval(hybrid%nbands),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(hybrid%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,hybdat%lmaxc(itype)
DO i=1,hybdat%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,hybdat%lmaxc(itype)
DO i=1,hybdat%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)