Commit 1931e8c5 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce t_orbcomp type to cdn/cdnval.F90

parent e7813772
......@@ -118,7 +118,7 @@ CONTAINS
#endif
! .. Local Scalars ..
INTEGER :: llpd,ikpt,jsp_start,jsp_end,ispin
INTEGER :: i,ie,iv,ivac,j,k,l,n,ilo,isp,nbands,noccbd,nslibd,na
INTEGER :: i,ie,iv,ivac,j,k,l,n,ilo,isp,nbands,noccbd,nslibd
INTEGER :: skip_t,skip_tt, nkpt_extended
INTEGER :: n_size,i_rec,n_rank,n_start,n_end,noccbd_l,nbasfcn
LOGICAL :: l_fmpl,l_evp,l_orbcomprot,l_real, l_write
......@@ -126,7 +126,6 @@ CONTAINS
INTEGER :: n_bands(0:dimension%neigd)
REAL :: eig(dimension%neigd)
REAL, ALLOCATABLE :: orbcomp(:,:,:),qmtp(:,:) ! orbcomp
INTEGER, ALLOCATABLE :: gvac1d(:),gvac2d(:)
INTEGER, ALLOCATABLE :: jsym(:),ksym(:)
REAL, ALLOCATABLE :: we(:)
......@@ -142,6 +141,7 @@ CONTAINS
TYPE (t_mcd) :: mcd
TYPE (t_usdus) :: usdus
TYPE (t_zMat) :: zMat
TYPE (t_orbcomp) :: orbcomp
l_real = sym%invs.AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco)
......@@ -177,6 +177,8 @@ CONTAINS
CALL force%init1(input,atoms)
CALL orb%init(atoms,noco,jsp_start,jsp_end)
CALL mcd%init1(banddos,dimension,input,atoms)
CALL slab%init(banddos,dimension,atoms,cell)
CALL orbcomp%init(banddos,dimension,atoms)
IF ((l_fmpl).AND.(.not.noco%l_mperp)) CALL juDFT_error("for fmpl set noco%l_mperp = T!" ,calledby ="cdnval")
......@@ -202,8 +204,6 @@ CONTAINS
skip_tt = dot_product(enpara%skiplo(:atoms%ntype,jspin),atoms%neq(:atoms%ntype))
IF (noco%l_soc.OR.noco%l_noco) skip_tt = 2 * skip_tt
na = 1
l_write = input%cdinf.AND.mpi%irank==0
DO n = 1,atoms%ntype
......@@ -226,20 +226,12 @@ CONTAINS
IF(l_cs) CALL corespec_rme(atoms,input,n,dimension%nstd,&
input%jspins,jspin,results%ef,&
dimension%msh,vTot%mt(:,0,:,:),f,g)
na = na + atoms%neq(n)
END DO
DEALLOCATE (f,g,flo)
CALL slab%init(banddos,dimension,atoms,cell)
IF ((banddos%ndir.EQ.-3).AND.banddos%dos) THEN
IF (oneD%odi%d1) CALL juDFT_error("layer-resolved feature does not work with 1D",calledby ="cdnval")
ALLOCATE ( orbcomp(dimension%neigd,23,atoms%nat) )
ALLOCATE ( qmtp(dimension%neigd,atoms%nat) )
ELSE
ALLOCATE(orbcomp(1,1,1),qmtp(1,1))
END IF
!--> loop over k-points: each can be a separate task
......@@ -496,7 +488,7 @@ CONTAINS
CALL abcrot2(atoms,noccbd,eigVecCoeffs,ispin)
END IF
CALL orb_comp(ispin,noccbd,atoms,noccbd,usdus,eigVecCoeffs,orbcomp,qmtp)
CALL orb_comp(ispin,noccbd,atoms,noccbd,usdus,eigVecCoeffs,orbcomp)
END IF
!-new
!---> set up coefficients for the spherical and
......@@ -560,7 +552,7 @@ CONTAINS
!--dw now write k-point data to tmp_dos
CALL write_dos(eig_id,ikpt,jspin,regCharges%qal(:,:,:,jspin),regCharges%qvac(:,:,ikpt,jspin),regCharges%qis(:,ikpt,jspin),&
regCharges%qvlay(:,:,:,ikpt,jspin),regCharges%qstars,ksym,jsym,mcd%mcd,slab%qintsl,&
slab%qmtsl(:,:),qmtp(:,:),orbcomp)
slab%qmtsl(:,:),orbcomp%qmtp(:,:),orbcomp%comp)
CALL timestop("cdnval: write_info")
!-new_sl
......
MODULE m_orbcomp
CONTAINS
SUBROUTINE orb_comp(jspin,nobd,atoms,ne,usdus,eigVecCoeffs,orbcomp,qmtp)
SUBROUTINE orb_comp(jspin,nobd,atoms,ne,usdus,eigVecCoeffs,orbcomp)
!***********************************************************************
! Calculates an orbital composition of eigen states
!
......@@ -28,7 +28,7 @@ CONTAINS
! nlo(ntypd) : in,
! llo(nlod,ntypd) : in,
!-----------------------------------------------------------------------
! orbcomp(nobd,16,natd) : out, an orbital composition of states
! comp(nobd,16,natd) : out, an orbital composition of states
! qmtp(nobd,natd) : out, the portion of the state in mt-sphere
!-----------------------------------------------------------------------
USE m_types
......@@ -36,14 +36,11 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
! ..
TYPE(t_orbcomp),INTENT(INOUT) :: orbcomp
! ..Scalar Argument
INTEGER, INTENT (IN) :: nobd,ne,jspin
! ..
! ..Array Arguments
REAL, INTENT (OUT) :: orbcomp(:,:,:)!(dimension%neigd,23,atoms%nat)
REAL, INTENT (OUT) :: qmtp(:,:)!(dimension%neigd,atoms%nat)
! ..
! ..Local Scalars
INTEGER n,mt,ityp,imt,lm,lo
INTEGER l,lme,nate,lmaxe,jspe,nobc,nei
......@@ -324,8 +321,8 @@ CONTAINS
sum = sum + comp(lm)
ENDDO
cf = 100.0/sum
qmtp(n,mt) = sum*100.0
orbcomp(n,:,mt) = comp(:)*cf
orbcomp%qmtp(n,mt) = sum*100.0
orbcomp%comp(n,:,mt) = comp(:)*cf
!----------------------------------------------------
ENDDO ! bands (n)
ENDDO ! atoms (imt) -> mt (=atoms%nat)
......
......@@ -188,7 +188,17 @@ PRIVATE
PROCEDURE,PASS :: init => moments_init
END TYPE t_moments
PUBLIC t_orb, t_denCoeffs, t_denCoeffsOffdiag, t_force, t_slab, t_eigVecCoeffs, t_mcd, t_regionCharges, t_moments
TYPE t_orbcomp
REAL, ALLOCATABLE :: comp(:,:,:)
REAL, ALLOCATABLE :: qmtp(:,:)
CONTAINS
PROCEDURE,PASS :: init => orbcomp_init
END TYPE t_orbcomp
PUBLIC t_orb, t_denCoeffs, t_denCoeffsOffdiag, t_force, t_slab, t_eigVecCoeffs
PUBLIC t_mcd, t_regionCharges, t_moments, t_orbcomp
CONTAINS
......@@ -684,4 +694,28 @@ SUBROUTINE moments_init(thisMoments,input,atoms)
END SUBROUTINE moments_init
SUBROUTINE orbcomp_init(thisOrbcomp,banddos,dimension,atoms)
USE m_types_setup
IMPLICIT NONE
CLASS(t_orbcomp), INTENT(INOUT) :: thisOrbcomp
TYPE(t_banddos), INTENT(IN) :: banddos
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_atoms), INTENT(IN) :: atoms
IF ((banddos%ndir.EQ.-3).AND.banddos%dos) THEN
ALLOCATE(thisOrbcomp%comp(dimension%neigd,23,atoms%nat))
ALLOCATE(thisOrbcomp%qmtp(dimension%neigd,atoms%nat))
ELSE
ALLOCATE(thisOrbcomp%comp(1,1,1))
ALLOCATE(thisOrbcomp%qmtp(1,1))
END IF
thisOrbcomp%comp = 0.0
thisOrbcomp%qmtp = 0.0
END SUBROUTINE orbcomp_init
END MODULE m_types_cdnval
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment