Commit 8c05f82e authored by Gregor Michalicek's avatar Gregor Michalicek

Introduction of t_eigVecCoeffs type to cdn/cdnval.F90 - part 1

parent 329bfac7
......@@ -157,8 +157,6 @@ CONTAINS
REAL, ALLOCATABLE :: svac(:,:),pvac(:,:),mcd(:,:,:)
REAL, ALLOCATABLE :: enerlo(:,:,:),qmat(:,:,:,:)
COMPLEX, ALLOCATABLE :: acof(:,:,:,:),bcof(:,:,:,:),ccof(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:),m_mcd(:,:,:,:)
TYPE (t_orb) :: orb
......@@ -166,6 +164,7 @@ CONTAINS
TYPE (t_denCoeffsOffdiag) :: denCoeffsOffdiag
TYPE (t_force) :: force
TYPE (t_slab) :: slab
TYPE (t_eigVecCoeffs) :: eigVecCoeffs
TYPE (t_usdus) :: usdus
TYPE (t_zMat) :: zMat
......@@ -562,53 +561,41 @@ CONTAINS
END IF
!---> valence density in the atomic spheres
!---> construct a(tilta) and b(tilta)
IF (noco%l_mperp) THEN
ALLOCATE ( acof(noccbd,0:dimension%lmd,atoms%nat,dimension%jspd),&
! Deallocated before call to sympsi
bcof(noccbd,0:dimension%lmd,atoms%nat,dimension%jspd), &
ccof(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat,dimension%jspd) )
ELSE
ALLOCATE ( acof(noccbd,0:dimension%lmd,atoms%nat,jspin:jspin),&
bcof(noccbd,0:dimension%lmd,atoms%nat,jspin:jspin),&
ccof(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat,jspin:jspin) )
END IF
CALL eigVecCoeffs%init(dimension,atoms,noco,jspin,noccbd)
DO ispin = jsp_start,jsp_end
IF (input%l_f) THEN
CALL timestart("cdnval: to_pulay")
CALL force%init2(noccbd,input,atoms)
CALL abcof(input,atoms,sym, cell,lapw,noccbd,usdus, noco,ispin,oneD,&
acof(:,0:,:,ispin),bcof(:,0:,:,ispin),ccof(-atoms%llod:,:,:,:,ispin),zMat,&
eig,force)
eigVecCoeffs%acof(:,0:,:,ispin),eigVecCoeffs%bcof(:,0:,:,ispin),&
eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat,eig,force)
CALL timestop("cdnval: to_pulay")
ELSE
CALL timestart("cdnval: abcof")
CALL abcof(input,atoms,sym, cell,lapw,noccbd,usdus, noco,ispin,oneD,&
acof(:,0:,:,ispin),bcof(:,0:,:,ispin),ccof(-atoms%llod:,:,:,:,ispin),zMat)
eigVecCoeffs%acof(:,0:,:,ispin),eigVecCoeffs%bcof(:,0:,:,ispin),&
eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat)
CALL timestop("cdnval: abcof")
END IF
IF (atoms%n_u.GT.0) THEN
CALL n_mat(atoms,sym,noccbd,usdus,ispin,we,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
ccof(-atoms%llod:,:,:,:,ispin),den%mmpMat(:,:,:,jspin))
CALL n_mat(atoms,sym,noccbd,usdus,ispin,we,eigVecCoeffs,den%mmpMat(:,:,:,jspin))
END IF
!
!---> perform Brillouin zone integration and summation over the
!---> bands in order to determine the energy parameters for each
!---> atom and angular momentum
!
IF (.not.sliceplot%slice) THEN
CALL eparas(ispin,atoms,noccbd,mpi,ikpt,noccbd,we,eig,ccof,&
skip_t,l_evp,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),usdus,&
CALL eparas(ispin,atoms,noccbd,mpi,ikpt,noccbd,we,eig,&
skip_t,l_evp,eigVecCoeffs,usdus,&
ncore,l_mcd,m_mcd,enerlo(1,1,ispin),sqlo(1,1,ispin),&
ener(0,1,ispin),sqal(0,1,ispin),&
qal(0:,:,:,ispin),mcd)
IF (noco%l_mperp.AND.(ispin == jsp_end)) THEN
CALL qal_21(atoms,input,noccbd,we,ccof,&
noco,acof,bcof,denCoeffsOffdiag,qal,qmat)
CALL qal_21(atoms,input,noccbd,we,noco,eigVecCoeffs,denCoeffsOffdiag,qal,qmat)
END IF
END IF
!
......@@ -617,75 +604,64 @@ CONTAINS
!---> from the mt-sphere region of the film
!
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
CALL q_mt_sl(ispin,atoms,noccbd,ikpt,noccbd,ccof(-atoms%llod,1,1,1,ispin),&
skip_t,noccbd,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),usdus,slab)
CALL q_mt_sl(ispin,atoms,noccbd,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab)
INQUIRE (file='orbcomprot',exist=l_orbcomprot)
IF (l_orbcomprot) THEN ! rotate ab-coeffs
CALL abcrot2(atoms,noccbd,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
ccof(-atoms%llod:,:,:,:,ispin))
CALL abcrot2(atoms,noccbd,eigVecCoeffs,ispin)
END IF
CALL orb_comp(ispin,noccbd,atoms,noccbd,usdus,acof(1:,0:,1:,ispin),bcof(1:,0:,1:,ispin),&
ccof(-atoms%llod:,1:,1:,1:,ispin),orbcomp,qmtp)
CALL orb_comp(ispin,noccbd,atoms,noccbd,usdus,eigVecCoeffs,orbcomp,qmtp)
END IF
!-new
!---> set up coefficients for the spherical and
CALL timestart("cdnval: rhomt")
CALL rhomt(atoms,we,noccbd,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),denCoeffs,ispin)
CALL rhomt(atoms,we,noccbd,eigVecCoeffs,denCoeffs,ispin)
CALL timestop("cdnval: rhomt")
!+soc
IF (noco%l_soc) THEN
CALL orbmom(atoms,noccbd, we,ispin,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
ccof(-atoms%llod:,:,:,:,ispin),orb)
END IF
! -soc
IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb)
!---> non-spherical m.t. density
CALL timestart("cdnval: rhonmt")
CALL rhonmt(atoms,sphhar,we,noccbd,sym,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),denCoeffs,ispin)
CALL rhonmt(atoms,sphhar,we,noccbd,sym,eigVecCoeffs,denCoeffs,ispin)
CALL timestop("cdnval: rhonmt")
!---> set up coefficients of the local orbitals and the
!---> flapw - lo cross terms for the spherical and
!---> non-spherical mt density
CALL timestart("cdnval: rho(n)mtlo")
CALL rhomtlo(atoms,noccbd,we,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
ccof(-atoms%llod:,:,:,:,ispin),denCoeffs,ispin)
CALL rhomtlo(atoms,noccbd,we,eigVecCoeffs,denCoeffs,ispin)
CALL rhonmtlo(atoms,sphhar,noccbd,we,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
ccof(-atoms%llod:,:,:,:,ispin),denCoeffs,ispin)
CALL rhonmtlo(atoms,sphhar,noccbd,we,eigVecCoeffs,denCoeffs,ispin)
CALL timestop("cdnval: rho(n)mtlo")
IF (input%l_f) THEN
CALL timestart("cdnval: force_a12/21")
IF (.not.input%l_useapw) THEN
CALL force_a12(atoms,noccbd,sym, dimension,cell,oneD,&
we,ispin,noccbd,usdus,acof(:,0:,:,ispin),&
bcof(:,0:,:,ispin),force,results)
we,ispin,noccbd,usdus,eigVecCoeffs%acof(:,0:,:,ispin),&
eigVecCoeffs%bcof(:,0:,:,ispin),force,results)
ENDIF
CALL force_a21(input,atoms,dimension,noccbd,sym,&
oneD,cell,we,ispin,enpara%el0(0:,:,ispin),noccbd,eig,usdus,acof(:,0:,:,ispin),&
bcof(:,0:,:,ispin),ccof(-atoms%llod:,:,:,:,ispin),force,results)
oneD,cell,we,ispin,enpara%el0(0:,:,ispin),noccbd,eig,usdus,eigVecCoeffs%acof(:,0:,:,ispin),&
eigVecCoeffs%bcof(:,0:,:,ispin),eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),force,results)
CALL timestop("cdnval: force_a12/21")
END IF
IF(l_cs) THEN
CALL corespec_dos(atoms,usdus,ispin,dimension%lmd,kpts%nkpt,ikpt,&
dimension%neigd,noccbd,results%ef,banddos%sig_dos,&
eig,we,acof(1,0,1,ispin),bcof(1,0,1,ispin),&
ccof(-atoms%llod,1,1,1,ispin))
eig,we,eigVecCoeffs%acof(1,0,1,ispin),eigVecCoeffs%bcof(1,0,1,ispin),&
eigVecCoeffs%ccof(-atoms%llod,1,1,1,ispin))
END IF
END DO !---> end loop over ispin
IF (noco%l_mperp) THEN
CALL rhomt21(atoms,we,noccbd,acof,bcof,ccof,denCoeffsOffdiag)
CALL rhomt21(atoms,we,noccbd,eigVecCoeffs%acof,eigVecCoeffs%bcof,eigVecCoeffs%ccof,denCoeffsOffdiag)
IF (l_fmpl) THEN
CALL rhonmt21(atoms,llpd,sphhar,we,noccbd,sym,acof,bcof,denCoeffsOffdiag)
CALL rhonmt21(atoms,llpd,sphhar,we,noccbd,sym,eigVecCoeffs%acof,eigVecCoeffs%bcof,denCoeffsOffdiag)
END IF
END IF
DEALLOCATE (acof,bcof,ccof)
!
199 CONTINUE
IF ((banddos%dos .OR. banddos%vacdos .OR. input%cdinf) ) THEN
CALL timestart("cdnval: write_info")
......
......@@ -23,13 +23,14 @@ MODULE m_eparas
!***********************************************************************
!
CONTAINS
SUBROUTINE eparas(jsp,atoms,noccbd, mpi,ikpt,ne,we,eig,ccof, skip_t,l_evp,acof,bcof,&
SUBROUTINE eparas(jsp,atoms,noccbd, mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
usdus, ncore,l_mcd,m_mcd, enerlo,sqlo,ener,sqal,qal,mcd)
USE m_types
IMPLICIT NONE
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: noccbd,jsp
......@@ -40,9 +41,6 @@ CONTAINS
INTEGER, INTENT (IN) :: ncore(atoms%ntype)
REAL, INTENT (IN) :: eig(:)!(dimension%neigd),
REAL, INTENT (IN) :: we(noccbd)
COMPLEX, INTENT (IN) :: ccof(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat)
COMPLEX, INTENT (IN) :: acof(:,0:,:)!(noccbd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (IN) :: bcof(:,0:,:)!(noccbd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (IN) :: m_mcd(:,:,:,:)!(dimension%nstd,(3+1)**2,3*ntypd ,2)
REAL, INTENT (INOUT) :: enerlo(atoms%nlod,atoms%ntype),sqlo(atoms%nlod,atoms%ntype)
REAL, INTENT (INOUT) :: ener(0:3,atoms%ntype),sqal(0:3,atoms%ntype)
......@@ -91,17 +89,17 @@ CONTAINS
lm = ll1 + m
IF ( .NOT.l_mcd ) THEN
DO natom = nt1,nt2
suma = suma + acof(i,lm,natom)*CONJG(acof(i,lm,natom))
sumb = sumb + bcof(i,lm,natom)*CONJG(bcof(i,lm,natom))
suma = suma + eigVecCoeffs%acof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%acof(i,lm,natom,jsp))
sumb = sumb + eigVecCoeffs%bcof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp))
ENDDO
ELSE
suma = CMPLX(0.,0.) ; sumab = CMPLX(0.,0.)
sumb = CMPLX(0.,0.) ; sumba = CMPLX(0.,0.)
DO natom = nt1,nt2
suma = suma + acof(i,lm,natom)*CONJG(acof(i,lm,natom))
sumb = sumb + bcof(i,lm,natom)*CONJG(bcof(i,lm,natom))
sumab= sumab + acof(i,lm,natom) *CONJG(bcof(i,lm,natom))
sumba= sumba + bcof(i,lm,natom) *CONJG(acof(i,lm,natom))
suma = suma + eigVecCoeffs%acof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%acof(i,lm,natom,jsp))
sumb = sumb + eigVecCoeffs%bcof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp))
sumab= sumab + eigVecCoeffs%acof(i,lm,natom,jsp) *CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp))
sumba= sumba + eigVecCoeffs%bcof(i,lm,natom,jsp) *CONJG(eigVecCoeffs%acof(i,lm,natom,jsp))
ENDDO
DO icore = 1, ncore(n)
DO ipol = 1, 3
......@@ -153,9 +151,11 @@ CONTAINS
lm = ll1 + m
DO i = 1,ne
qbclo(i,lo,ntyp) = qbclo(i,lo,ntyp) +REAL(&
bcof(i,lm,natom)*CONJG(ccof(m,i,lo,natom))+ccof(m,i,lo,natom)*CONJG(bcof(i,lm,natom)) )
eigVecCoeffs%bcof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,jsp))+&
eigVecCoeffs%ccof(m,i,lo,natom,jsp)*CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp)) )
qaclo(i,lo,ntyp) = qaclo(i,lo,ntyp) + REAL(&
acof(i,lm,natom)*CONJG(ccof(m,i,lo,natom))+ccof(m,i,lo,natom)*CONJG(acof(i,lm,natom)) )
eigVecCoeffs%acof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,jsp))+&
eigVecCoeffs%ccof(m,i,lo,natom,jsp)*CONJG(eigVecCoeffs%acof(i,lm,natom,jsp)) )
ENDDO
ENDDO
DO lop = 1,atoms%nlo(ntyp)
......@@ -163,7 +163,7 @@ CONTAINS
DO m = -l,l
DO i = 1,ne
qlo(i,lop,lo,ntyp) = qlo(i,lop,lo,ntyp) + REAL(&
CONJG(ccof(m,i,lop,natom))*ccof(m,i,lo,natom))
CONJG(eigVecCoeffs%ccof(m,i,lop,natom,jsp))*eigVecCoeffs%ccof(m,i,lo,natom,jsp))
ENDDO
ENDDO
ENDIF
......
......@@ -14,24 +14,22 @@ MODULE m_nmat
! Extension to multiple U per atom type by G.M. 2017
! ************************************************************
CONTAINS
SUBROUTINE n_mat(atoms,sym, ne,usdus,jspin,we, acof,bcof,ccof, n_mmp)
SUBROUTINE n_mat(atoms,sym, ne,usdus,jspin,we,eigVecCoeffs,n_mmp)
!
USE m_types
USE m_constants
IMPLICIT NONE
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne,jspin
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: we(:)!(dimension%neigd)
COMPLEX, INTENT (IN) :: acof(:,0:,:)!(nobd,0:atoms%lmaxd*(lmaxd+2) ,natd)
COMPLEX, INTENT (IN) :: bcof(:,0:,:)!(nobd,0:atoms%lmaxd*(lmaxd+2) ,natd)
COMPLEX, INTENT (IN) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,atoms%nat)
COMPLEX, INTENT (INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
! ..
! .. Local Scalars ..
......@@ -69,8 +67,8 @@ CONTAINS
c_0 = cmplx(0.0,0.0)
DO i = 1,ne
c_0 = c_0 + we(i) * ( usdus%ddn(l,n,jspin) *&
conjg(bcof(i,lmp,natomTemp))*bcof(i,lm,natomTemp) +&
conjg(acof(i,lmp,natomTemp))*acof(i,lm,natomTemp) )
conjg(eigVecCoeffs%bcof(i,lmp,natomTemp,jspin))*eigVecCoeffs%bcof(i,lm,natomTemp,jspin) +&
conjg(eigVecCoeffs%acof(i,lmp,natomTemp,jspin))*eigVecCoeffs%acof(i,lm,natomTemp,jspin) )
ENDDO
n_tmp(m,mp) = c_0
ENDDO
......@@ -88,17 +86,17 @@ CONTAINS
c_0 = cmplx(0.0,0.0)
DO i = 1,ne
c_0 = c_0 + we(i) * ( usdus%uulon(ilo,n,jspin) * (&
conjg(acof(i,lmp,natomTemp))*ccof(m,i,ilo,natomTemp) +&
conjg(ccof(mp,i,ilo,natomTemp))*acof(i,lm,natomTemp) )&
conjg(eigVecCoeffs%acof(i,lmp,natomTemp,jspin))*eigVecCoeffs%ccof(m,i,ilo,natomTemp,jspin) +&
conjg(eigVecCoeffs%ccof(mp,i,ilo,natomTemp,jspin))*eigVecCoeffs%acof(i,lm,natomTemp,jspin) )&
+ usdus%dulon(ilo,n,jspin) * (&
conjg(bcof(i,lmp,natomTemp))*ccof(m,i,ilo,natomTemp) +&
conjg(ccof(mp,i,ilo,natomTemp))*bcof(i,lm,natomTemp)))
conjg(eigVecCoeffs%bcof(i,lmp,natomTemp,jspin))*eigVecCoeffs%ccof(m,i,ilo,natomTemp,jspin) +&
conjg(eigVecCoeffs%ccof(mp,i,ilo,natomTemp,jspin))*eigVecCoeffs%bcof(i,lm,natomTemp,jspin)))
ENDDO
DO ilop = 1, atoms%nlo(n)
IF (atoms%llo(ilop,n).EQ.l) THEN
DO i = 1,ne
c_0 = c_0 + we(i) * usdus%uloulopn(ilo,ilop,n,jspin) *&
conjg(ccof(mp,i,ilop,natomTemp)) *ccof(m ,i,ilo ,natomTemp)
conjg(eigVecCoeffs%ccof(mp,i,ilop,natomTemp,jspin)) *eigVecCoeffs%ccof(m,i,ilo,natomTemp,jspin)
ENDDO
ENDIF
ENDDO
......
......@@ -8,22 +8,18 @@ CONTAINS
!
!***********************************************************************
!
SUBROUTINE q_mt_sl(jsp,atoms,nobd,ikpt,ne,ccof, skip_t,noccbd,acof,bcof,usdus,slab)
SUBROUTINE q_mt_sl(jsp,atoms,nobd,ikpt,ne,skip_t,noccbd,eigVecCoeffs,usdus,slab)
USE m_types
IMPLICIT NONE
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_slab), INTENT(INOUT) :: slab
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
TYPE(t_slab), INTENT(INOUT) :: slab
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: nobd,jsp
INTEGER, INTENT (IN) :: ne,ikpt ,skip_t,noccbd
! ..
! .. Array Arguments ..
COMPLEX, INTENT (IN) :: ccof(-atoms%llod:atoms%llod,nobd,atoms%nlod,atoms%nat)
COMPLEX, INTENT (IN) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (IN) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
! ..
! .. Local Scalars ..
INTEGER i,l,lo ,natom,nn,ntyp,nt1,nt2,m
INTEGER lm,n,ll1,ipol,icore,index,nl
......@@ -58,8 +54,8 @@ CONTAINS
DO m = -l,l
lm = ll1 + m
DO natom = nt1,nt2
suma = suma + acof(i,lm,natom)*CONJG(acof(i,lm,natom))
sumb = sumb + bcof(i,lm,natom)*CONJG(bcof(i,lm,natom))
suma = suma + eigVecCoeffs%acof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%acof(i,lm,natom,jsp))
sumb = sumb + eigVecCoeffs%bcof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp))
ENDDO
enddo
ss = suma + sumb*usdus%ddn(l,n,jsp)
......@@ -89,13 +85,13 @@ CONTAINS
DO m = -l,l
lm = ll1 + m
qlo(i,lo,ntyp) = qlo(i,lo,ntyp) +&
ccof(m,i,lo,natom)*CONJG(ccof(m,i,lo,natom))
eigVecCoeffs%ccof(m,i,lo,natom,jsp)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,jsp))
qbclo(i,lo,ntyp) = qbclo(i,lo,ntyp) +&
bcof(i,lm,natom)*CONJG(ccof(m,i,lo,natom)) +&
ccof(m,i,lo,natom)*CONJG(bcof(i,lm,natom))
eigVecCoeffs%bcof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,jsp)) +&
eigVecCoeffs%ccof(m,i,lo,natom,jsp)*CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp))
qaclo(i,lo,ntyp) = qaclo(i,lo,ntyp) +&
acof(i,lm,natom)*CONJG(ccof(m,i,lo,natom)) +&
ccof(m,i,lo,natom)*CONJG(acof(i,lm,natom))
eigVecCoeffs%acof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,jsp)) +&
eigVecCoeffs%ccof(m,i,lo,natom,jsp)*CONJG(eigVecCoeffs%acof(i,lm,natom,jsp))
ENDDO
ENDDO
ENDDO
......
......@@ -5,23 +5,21 @@ MODULE m_qal21
!***********************************************************************
!
CONTAINS
SUBROUTINE qal_21(atoms,input,noccbd,we,ccof,noco,acof,bcof,denCoeffsOffdiag,qal,qmat)
SUBROUTINE qal_21(atoms,input,noccbd,we,noco,eigVecCoeffs,denCoeffsOffdiag,qal,qmat)
USE m_rotdenmat
USE m_types
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: noccbd
! ..
! .. Array Arguments ..
REAL, INTENT (INout) :: we(noccbd),qal(0:,:,:,:)!(0:3,atoms%ntype,DIMENSION%neigd,input%jspins)
COMPLEX, INTENT (IN) :: ccof(-atoms%llod:atoms%llod,noccbd,atoms%nlod,atoms%nat,input%jspins)
COMPLEX, INTENT (IN) :: acof(:,0:,:,:)!(noccbd,0:DIMENSION%lmd,atoms%nat,input%jspins)
COMPLEX, INTENT (IN) :: bcof(:,0:,:,:)!(noccbd,0:DIMENSION%lmd,atoms%nat,input%jspins)
REAL, INTENT (OUT) :: qmat(0:,:,:,:)!(0:3,atoms%ntype,DIMENSION%neigd,4)
TYPE (t_denCoeffsOffdiag), INTENT (IN) :: denCoeffsOffdiag
......@@ -59,10 +57,10 @@ CONTAINS
ms : DO m = -l,l
lm = ll1 + m
atoms_loop : DO natom = nt1,nt2
sumaa = sumaa + acof(i,lm,natom,1)* CONJG(acof(i,lm,natom,input%jspins))
sumbb = sumbb + bcof(i,lm,natom,1)* CONJG(bcof(i,lm,natom,input%jspins))
sumba = sumba + acof(i,lm,natom,1) * CONJG(bcof(i,lm,natom,input%jspins))
sumab = sumab + bcof(i,lm,natom,1) * CONJG(acof(i,lm,natom,input%jspins))
sumaa = sumaa + eigVecCoeffs%acof(i,lm,natom,1)* CONJG(eigVecCoeffs%acof(i,lm,natom,input%jspins))
sumbb = sumbb + eigVecCoeffs%bcof(i,lm,natom,1)* CONJG(eigVecCoeffs%bcof(i,lm,natom,input%jspins))
sumba = sumba + eigVecCoeffs%acof(i,lm,natom,1) * CONJG(eigVecCoeffs%bcof(i,lm,natom,input%jspins))
sumab = sumab + eigVecCoeffs%bcof(i,lm,natom,1) * CONJG(eigVecCoeffs%acof(i,lm,natom,input%jspins))
ENDDO atoms_loop
ENDDO ms
qal21(l,n,i) = sumaa * denCoeffsOffdiag%uu21n(l,n) + sumbb * denCoeffsOffdiag%dd21n(l,n) +&
......@@ -93,13 +91,13 @@ CONTAINS
lm = ll1 + m
DO i = 1, noccbd
qbclo(i,lo,ntyp) = qbclo(i,lo,ntyp) + &
bcof(i,lm,natom,1)*CONJG(ccof(m,i,lo,natom,input%jspins))
eigVecCoeffs%bcof(i,lm,natom,1)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins))
qbclo(i,lo,ntyp) = qbclo(i,lo,ntyp) + &
ccof(m,i,lo,natom,1)*CONJG(bcof(i,lm,natom,input%jspins))
eigVecCoeffs%ccof(m,i,lo,natom,1)*CONJG(eigVecCoeffs%bcof(i,lm,natom,input%jspins))
qaclo(i,lo,ntyp) = qaclo(i,lo,ntyp) + &
acof(i,lm,natom,1)*CONJG(ccof(m,i,lo,natom,input%jspins))
eigVecCoeffs%acof(i,lm,natom,1)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins))
qaclo(i,lo,ntyp) = qaclo(i,lo,ntyp) + &
ccof(m,i,lo,natom,1)*CONJG(acof(i,lm,natom,input%jspins))
eigVecCoeffs%ccof(m,i,lo,natom,1)*CONJG(eigVecCoeffs%acof(i,lm,natom,input%jspins))
ENDDO
ENDDO
DO lop = 1,atoms%nlo(ntyp)
......@@ -107,8 +105,8 @@ CONTAINS
DO m = -l,l
DO i = 1, noccbd
qlo(i,lop,lo,ntyp) = qlo(i,lop,lo,ntyp) + &
CONJG(ccof(m,i,lop,natom,input%jspins))*ccof(m,i,lo,natom,1) +&
CONJG(ccof(m,i,lo,natom,input%jspins))*ccof(m,i,lop,natom,1)
CONJG(eigVecCoeffs%ccof(m,i,lop,natom,input%jspins))*eigVecCoeffs%ccof(m,i,lo,natom,1) +&
CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins))*eigVecCoeffs%ccof(m,i,lop,natom,1)
ENDDO
ENDDO
ENDIF
......
......@@ -8,21 +8,16 @@ MODULE m_abcrot2
PRIVATE
PUBLIC :: abcrot2
CONTAINS
SUBROUTINE abcrot2(atoms, neig, acof,bcof,ccof)
SUBROUTINE abcrot2(atoms,neig,eigVecCoeffs,jsp)
USE m_dwigner
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs),INTENT(INOUT) :: eigVecCoeffs
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: neig
! ..
! .. Array Arguments ..
COMPLEX, INTENT (INOUT) :: acof(:,0:,:)!(dimension%neigd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (INOUT) :: bcof(:,0:,:)!dimension%neigd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (INOUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,dimension%neigd,atoms%nlod,atoms%nat)
INTEGER, INTENT (IN) :: neig,jsp
! ..
! .. Local Scalars ..
INTEGER itype,ineq,iatom,iop,ilo,i,l ,lm,lmp,ifac
......@@ -50,18 +45,18 @@ CONTAINS
DO l = 1, atoms%lmax(itype)
DO i = 1, neig
acof(i,l**2:l*(l+2),iatom) = MATMUL(CONJG(d_wgn(-l:l,-l:l,l,iop)),&
acof(i,l**2:l*(l+2),iatom))
bcof(i,l**2:l*(l+2),iatom) = MATMUL(CONJG(d_wgn(-l:l,-l:l,l,iop)),&
bcof(i,l**2:l*(l+2),iatom))
eigVecCoeffs%acof(i,l**2:l*(l+2),iatom,jsp) = MATMUL(CONJG(d_wgn(-l:l,-l:l,l,iop)),&
eigVecCoeffs%acof(i,l**2:l*(l+2),iatom,jsp))
eigVecCoeffs%bcof(i,l**2:l*(l+2),iatom,jsp) = MATMUL(CONJG(d_wgn(-l:l,-l:l,l,iop)),&
eigVecCoeffs%bcof(i,l**2:l*(l+2),iatom,jsp))
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) = MATMUL(CONJG(d_wgn(-l:l,-l:l,l,iop)),&
ccof(-l:l,i,ilo,iatom))
eigVecCoeffs%ccof(-l:l,i,ilo,iatom,jsp) = MATMUL(CONJG(d_wgn(-l:l,-l:l,l,iop)),&
eigVecCoeffs%ccof(-l:l,i,ilo,iatom,jsp))
ENDDO
ENDIF
ENDDO
......
This diff is collapsed.
MODULE m_rhomt
CONTAINS
SUBROUTINE rhomt(atoms,we,ne,acof,bcof,denCoeffs,ispin)
SUBROUTINE rhomt(atoms,we,ne,eigVecCoeffs,denCoeffs,ispin)
! ***************************************************************
! perform the sum over m (for each l) and bands to set up the
! coefficient of spherical charge densities in subroutine
......@@ -10,12 +10,11 @@ CONTAINS
USE m_types
IMPLICIT NONE
INTEGER, INTENT(IN) :: ne, ispin
COMPLEX, INTENT(IN) :: acof(:,0:,:)!(nobd,0:lmaxd* (lmaxd+2),natd)
COMPLEX, INTENT(IN) :: bcof(:,0:,:)
REAL, INTENT(IN) :: we(:)!(nobd)
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_denCoeffs), INTENT(INOUT) :: denCoeffs
INTEGER, INTENT(IN) :: ne, ispin
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
REAL, INTENT(IN) :: we(:)!(nobd)
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_denCoeffs), INTENT(INOUT) :: denCoeffs
INTEGER i,l,lm ,n,na,natom,m
......@@ -29,9 +28,12 @@ CONTAINS
lm = l* (l+1) + m
! -----> sum over occupied bands
DO i = 1,ne
denCoeffs%uu(l,n,ispin) = denCoeffs%uu(l,n,ispin) + we(i) * REAL(acof(i,lm,natom)*CONJG(acof(i,lm,natom)))
denCoeffs%dd(l,n,ispin) = denCoeffs%dd(l,n,ispin) + we(i) * REAL(bcof(i,lm,natom)*CONJG(bcof(i,lm,natom)))
denCoeffs%du(l,n,ispin) = denCoeffs%du(l,n,ispin) + we(i) * REAL(acof(i,lm,natom)*CONJG(bcof(i,lm,natom)))
denCoeffs%uu(l,n,ispin) = denCoeffs%uu(l,n,ispin) +&
we(i) * REAL(eigVecCoeffs%acof(i,lm,natom,ispin)*CONJG(eigVecCoeffs%acof(i,lm,natom,ispin)))
denCoeffs%dd(l,n,ispin) = denCoeffs%dd(l,n,ispin) +&
we(i) * REAL(eigVecCoeffs%bcof(i,lm,natom,ispin)*CONJG(eigVecCoeffs%bcof(i,lm,natom,ispin)))
denCoeffs%du(l,n,ispin) = denCoeffs%du(l,n,ispin) +&
we(i) * REAL(eigVecCoeffs%acof(i,lm,natom,ispin)*CONJG(eigVecCoeffs%bcof(i,lm,natom,ispin)))
ENDDO
ENDDO
ENDDO
......
......@@ -14,23 +14,19 @@ MODULE m_rhomtlo
!***********************************************************************
!
CONTAINS
SUBROUTINE rhomtlo(atoms, ne,we,acof,bcof,ccof,denCoeffs,ispin)
SUBROUTINE rhomtlo(atoms,ne,we,eigVecCoeffs,denCoeffs,ispin)
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_denCoeffs),INTENT(INOUT) :: denCoeffs
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_denCoeffs), INTENT(INOUT) :: denCoeffs
INTEGER, INTENT (IN) :: ne, ispin
REAL, INTENT (IN) :: we(:)!(nobd)
COMPLEX, INTENT (IN) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (IN) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (IN) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:llod,nobd,atoms%nlod,atoms%nat)
INTEGER i,l,lm,lo,lop ,natom,nn,ntyp,m
! ..
natom = 0
!---> loop over atoms
......@@ -45,9 +41,9 @@ CONTAINS
lm = l* (l+1) + m
DO i = 1,ne
denCoeffs%aclo(lo,ntyp,ispin) = denCoeffs%aclo(lo,ntyp,ispin) + we(i)*2*&
real(conjg(acof(i,lm,natom))*ccof(m,i,lo,natom))
real(conjg(eigVecCoeffs%acof(i,lm,natom,ispin))*eigVecCoeffs%ccof(m,i,lo,natom,ispin))
denCoeffs%bclo(lo,ntyp,ispin) = denCoeffs%bclo(lo,ntyp,ispin) + we(i)*2*&
real(conjg(bcof(i,lm,natom))*ccof(m,i,lo,natom))
real(conjg(eigVecCoeffs%bcof(i,lm,natom,ispin))*eigVecCoeffs%ccof(m,i,lo,natom,ispin))
END DO
END DO
!---> contribution of local orbital - local orbital terms
......@@ -57,7 +53,7 @@ CONTAINS
DO m = -l,l
DO i = 1,ne
denCoeffs%cclo(lop,lo,ntyp,ispin) = denCoeffs%cclo(lop,lo,ntyp,ispin) + we(i)*&
real(conjg(ccof(m,i,lop,natom))*ccof(m,i,lo ,natom))
real(conjg(eigVecCoeffs%ccof(m,i,lop,natom,ispin))*eigVecCoeffs%ccof(m,i,lo,natom,ispin))
END DO
END DO
END IF
......
MODULE m_rhonmt
CONTAINS
SUBROUTINE rhonmt(atoms,sphhar,we,ne,sym, acof,bcof,denCoeffs,ispin)
SUBROUTINE rhonmt(atoms,sphhar,we,ne,sym,eigVecCoeffs,denCoeffs,ispin)
! *************************************************************
! subroutine sets up the coefficients of non-sphereical
! muffin-tin density c.l.fu
......@@ -8,15 +8,14 @@ CONTAINS
USE m_gaunt,ONLY:gaunt1
USE m_types
IMPLICIT NONE
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_denCoeffs), INTENT(INOUT) :: denCoeffs
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_denCoeffs), INTENT(INOUT) :: denCoeffs
INTEGER, INTENT(IN) :: ne, ispin