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