Commit 1d247030 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce some more types to cdn/cdnval.F90

parent 5fbb6a4b
This diff is collapsed.
......@@ -8,38 +8,52 @@ MODULE m_int21
!
!-----------------------------------------------------------
CONTAINS
SUBROUTINE int_21(f,g,atoms,ityp,l, uun21,udn21,dun21,ddn21)
SUBROUTINE int_21(f,g,atoms,ityp,l,denCoeffsOffdiag)
USE m_types
IMPLICIT NONE
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_denCoeffsOffdiag), INTENT(INOUT) :: denCoeffsOffdiag
INTEGER, INTENT (IN) :: l,ityp
REAL, INTENT (IN) :: f(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL, INTENT (IN) :: g(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
CALL int_21_arrays(f,g,atoms,ityp,l,denCoeffsOffdiag%uu21n,denCoeffsOffdiag%ud21n,&
denCoeffsOffdiag%du21n,denCoeffsOffdiag%dd21n)
END SUBROUTINE int_21
SUBROUTINE int_21_arrays(f,g,atoms,ityp,l,uu21n,ud21n,du21n,dd21n)
USE m_intgr, ONLY : intgr3
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
TYPE(t_atoms), INTENT(IN) :: atoms
INTEGER, INTENT (IN) :: l,ityp
REAL, INTENT (OUT):: uun21,udn21,dun21,ddn21
! ... Array Arguments
REAL, INTENT (IN) :: f(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL, INTENT (IN) :: g(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
! ...local arrays
REAL uu_tmp(atoms%jri(ityp))
REAL, INTENT (INOUT) :: uu21n(0:atoms%lmaxd,atoms%ntype),ud21n(0:atoms%lmaxd,atoms%ntype)
REAL, INTENT (INOUT) :: du21n(0:atoms%lmaxd,atoms%ntype),dd21n(0:atoms%lmaxd,atoms%ntype)
REAL uu_tmp(atoms%jri(ityp))
uu_tmp(:atoms%jri(ityp)) = f(:atoms%jri(ityp),1,l,2)*f(:atoms%jri(ityp),1,l,1)&
+ f(:atoms%jri(ityp),2,l,2)*f(:atoms%jri(ityp),2,l,1)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),uun21)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),uu21n(l,ityp))
uu_tmp(:atoms%jri(ityp)) = f(:atoms%jri(ityp),1,l,2)*g(:atoms%jri(ityp),1,l,1)&
+ f(:atoms%jri(ityp),2,l,2)*g(:atoms%jri(ityp),2,l,1)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),udn21)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),ud21n(l,ityp))
uu_tmp(:atoms%jri(ityp)) = g(:atoms%jri(ityp),1,l,2)*f(:atoms%jri(ityp),1,l,1)&
+ g(:atoms%jri(ityp),2,l,2)*f(:atoms%jri(ityp),2,l,1)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),dun21)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),du21n(l,ityp))
uu_tmp(:atoms%jri(ityp)) = g(:atoms%jri(ityp),1,l,2)*g(:atoms%jri(ityp),1,l,1)&
+ g(:atoms%jri(ityp),2,l,2)*g(:atoms%jri(ityp),2,l,1)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),ddn21)
CALL intgr3(uu_tmp,atoms%rmsh(:,ityp),atoms%dx(ityp),atoms%jri(ityp),dd21n(l,ityp))
END SUBROUTINE int_21
END SUBROUTINE int_21_arrays
END MODULE m_int21
......@@ -6,17 +6,18 @@ MODULE m_int21lo
! spins (s).
! Output is ..n21(l,itype), where .. is a combination of (u,d) and
! ulo dependent on the (f,g) combination used. Also ..n12 and
! uloulopn21 are calculated.
! uloulop21n are calculated.
!
!-----------------------------------------------------------
CONTAINS
SUBROUTINE int_21lo(f,g,atoms,n, flo,ilo, uulon21,dulon21,uulon12,dulon12,uloulopn21)
SUBROUTINE int_21lo(f,g,atoms,n, flo,ilo,denCoeffsOffdiag)
USE m_intgr, ONLY : intgr3
USE m_types
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_denCoeffsOffdiag), INTENT(INOUT) :: denCoeffsOffdiag
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ilo,n
......@@ -24,9 +25,6 @@ CONTAINS
REAL, INTENT (IN) :: f(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL, INTENT (IN) :: g(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL, INTENT (IN) :: flo(:,:,:,:)!(atoms%jmtd,2,atoms%nlod,dimension%jspd)
REAL, INTENT (OUT):: uulon21,uulon12
REAL, INTENT (OUT):: dulon21,dulon12
REAL, INTENT (OUT):: uloulopn21(atoms%nlod,atoms%nlod)
! ...local scalars
INTEGER iri,l,lp,ilop
......@@ -40,22 +38,22 @@ CONTAINS
DO iri = 1, atoms%jri(n)
uu_tmp(iri) = f(iri,1,l,2)*flo(iri,1,ilo,1)+ f(iri,2,l,2)*flo(iri,2,ilo,1)
ENDDO
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),uulon21)
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),denCoeffsOffdiag%uulo21n(ilo,n))
DO iri = 1, atoms%jri(n)
uu_tmp(iri) = f(iri,1,l,1)*flo(iri,1,ilo,2)+ f(iri,2,l,1)*flo(iri,2,ilo,2)
ENDDO
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),uulon12)
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),denCoeffsOffdiag%ulou21n(ilo,n))
!
! --> norm of product of du and ulo:
!
DO iri = 1, atoms%jri(n)
uu_tmp(iri) = g(iri,1,l,2)*flo(iri,1,ilo,1) + g(iri,2,l,2)*flo(iri,2,ilo,1)
ENDDO
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),dulon21)
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),denCoeffsOffdiag%dulo21n(ilo,n))
DO iri = 1, atoms%jri(n)
uu_tmp(iri) = g(iri,1,l,1)*flo(iri,1,ilo,2) + g(iri,2,l,1)*flo(iri,2,ilo,2)
ENDDO
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),dulon12)
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),denCoeffsOffdiag%ulod21n(ilo,n))
!
! --> norm of product of ulo and ulo':
!
......@@ -65,10 +63,10 @@ CONTAINS
DO iri = 1, atoms%jri(n)
uu_tmp(iri) = flo(iri,1,ilo,2)*flo(iri,1,ilop,1) + flo(iri,2,ilo,2)*flo(iri,2,ilop,1)
ENDDO
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),uloulopn21(ilo,ilop))
CALL intgr3(uu_tmp,atoms%rmsh(:,n),atoms%dx(n),atoms%jri(n),denCoeffsOffdiag%uloulop21n(ilo,ilop,n))
ELSE
uloulopn21(ilo,ilop) = 0.0
denCoeffsOffdiag%uloulop21n(ilo,ilop,n) = 0.0
ENDIF
ENDDO
......
......@@ -5,7 +5,7 @@ MODULE m_qal21
!***********************************************************************
!
CONTAINS
SUBROUTINE qal_21(atoms, input,noccbd,we,ccof, noco,acof,bcof,mt21,lo21,uloulopn21, qal,qmat)
SUBROUTINE qal_21(atoms,input,noccbd,we,ccof,noco,acof,bcof,denCoeffsOffdiag,qal,qmat)
USE m_rotdenmat
USE m_types
......@@ -19,13 +19,11 @@ CONTAINS
! ..
! .. Array Arguments ..
REAL, INTENT (INout) :: we(noccbd),qal(0:,:,:,:)!(0:3,atoms%ntype,DIMENSION%neigd,input%jspins)
REAL, INTENT (IN) :: uloulopn21(atoms%nlod,atoms%nlod,atoms%ntype)
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_mt21), INTENT (IN) :: mt21(0:atoms%lmaxd,atoms%ntype)
TYPE (t_lo21), INTENT (IN) :: lo21(0:atoms%lmaxd,atoms%ntype)
TYPE (t_denCoeffsOffdiag), INTENT (IN) :: denCoeffsOffdiag
! ..
! .. Local Scalars ..
......@@ -67,8 +65,8 @@ CONTAINS
sumab = sumab + bcof(i,lm,natom,1) * CONJG(acof(i,lm,natom,input%jspins))
ENDDO atoms_loop
ENDDO ms
qal21(l,n,i) = sumaa * mt21(l,n)%uun + sumbb * mt21(l,n)%ddn +&
sumba * mt21(l,n)%dun + sumab * mt21(l,n)%udn
qal21(l,n,i) = sumaa * denCoeffsOffdiag%uu21n(l,n) + sumbb * denCoeffsOffdiag%dd21n(l,n) +&
sumba * denCoeffsOffdiag%du21n(l,n) + sumab * denCoeffsOffdiag%ud21n(l,n)
ENDDO ls
nt1 = nt1 + atoms%neq(n)
ENDDO types_loop
......@@ -126,16 +124,16 @@ CONTAINS
l = atoms%llo(lo,ntyp)
DO i = 1, noccbd
qal21(l,ntyp,i)= qal21(l,ntyp,i) + &
qaclo(i,lo,ntyp)*lo21(lo,ntyp)%uulon +&
qcloa(i,lo,ntyp)*lo21(lo,ntyp)%uloun +&
qclob(i,lo,ntyp)*lo21(lo,ntyp)%ulodn +&
qbclo(i,lo,ntyp)*lo21(lo,ntyp)%dulon
qaclo(i,lo,ntyp)*denCoeffsOffdiag%uulo21n(lo,ntyp) +&
qcloa(i,lo,ntyp)*denCoeffsOffdiag%ulou21n(lo,ntyp) +&
qclob(i,lo,ntyp)*denCoeffsOffdiag%ulod21n(lo,ntyp) +&
qbclo(i,lo,ntyp)*denCoeffsOffdiag%dulo21n(lo,ntyp)
END DO
DO lop = 1,atoms%nlo(ntyp)
IF (atoms%llo(lop,ntyp).EQ.l) THEN
DO i = 1, noccbd
qal21(l,ntyp,i)= qal21(l,ntyp,i) + &
qlo(i,lop,lo,ntyp)*uloulopn21(lop,lo,ntyp)
qlo(i,lop,lo,ntyp)*denCoeffsOffdiag%uloulop21n(lop,lo,ntyp)
ENDDO
ENDIF
ENDDO
......
This diff is collapsed.
MODULE m_rhomt
CONTAINS
SUBROUTINE rhomt(atoms, we,ne,acof,bcof,uu,dd,du)
SUBROUTINE rhomt(atoms,we,ne,acof,bcof,denCoeffs,ispin)
! ***************************************************************
! perform the sum over m (for each l) and bands to set up the
! coefficient of spherical charge densities in subroutine
......@@ -10,22 +10,15 @@ CONTAINS
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne
! ..
! .. Array Arguments ..
COMPLEX, INTENT (IN) :: acof(:,0:,:)!(nobd,0:lmaxd* (lmaxd+2),natd)
COMPLEX, INTENT (IN) :: bcof(:,0:,:)
REAL, INTENT (IN) :: we(:)!(nobd)
REAL, INTENT (INOUT) :: dd(0:atoms%lmaxd,atoms%ntype)
REAL, INTENT (INOUT) :: du(0:atoms%lmaxd,atoms%ntype)
REAL, INTENT (INOUT) :: uu(0:atoms%lmaxd,atoms%ntype)
! ..
! .. Local Scalars ..
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 i,l,lm ,n,na,natom,m
! ..
natom = 0
DO n = 1,atoms%ntype
DO na = 1,atoms%neq(n)
......@@ -36,9 +29,9 @@ CONTAINS
lm = l* (l+1) + m
! -----> sum over occupied bands
DO i = 1,ne
uu(l,n) = uu(l,n) + we(i)* REAL(acof(i,lm,natom)*CONJG(acof(i,lm,natom)))
dd(l,n) = dd(l,n) + we(i)* REAL(bcof(i,lm,natom)*CONJG(bcof(i,lm,natom)))
du(l,n) = du(l,n) + 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(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)))
ENDDO
ENDDO
ENDDO
......
......@@ -7,7 +7,7 @@ MODULE m_rhomt21
! FF
! ***************************************************************
CONTAINS
SUBROUTINE rhomt21(atoms, we,ne,acof,bcof, ccof,mt21,lo21,uloulop21)
SUBROUTINE rhomt21(atoms, we,ne,acof,bcof, ccof,denCoeffsOffdiag)
USE m_types
IMPLICIT NONE
......@@ -21,9 +21,7 @@ CONTAINS
COMPLEX, INTENT (IN) :: bcof(:,0:,:,:)
COMPLEX, INTENT (IN) :: ccof(-atoms%llod:,:,:,:,:) !(-llod:llod,nobd,nlod,natd,jspd)
REAL, INTENT (IN) :: we(:)!(nobd)
TYPE (t_mt21), INTENT (INOUT) :: mt21(0:atoms%lmaxd,atoms%ntype)
TYPE (t_lo21), INTENT (INOUT) :: lo21(atoms%nlod,atoms%ntype)
COMPLEX, INTENT (INOUT) :: uloulop21(atoms%nlod,atoms%nlod,atoms%ntype)
TYPE (t_denCoeffsOffdiag), INTENT (INOUT) :: denCoeffsOffdiag
! ..
! .. Local Scalars ..
INTEGER i,l,lm ,itype,na,natom,lo,lop,m
......@@ -39,10 +37,10 @@ CONTAINS
lm = l* (l+1) + m
!---> sum over occupied bands
DO i = 1,ne
mt21(l,itype)%uu = mt21(l,itype)%uu + we(i)* CONJG(acof(i,lm,natom,2))*acof(i,lm,natom,1)
mt21(l,itype)%ud = mt21(l,itype)%ud + we(i)* CONJG(acof(i,lm,natom,2))*bcof(i,lm,natom,1)
mt21(l,itype)%du = mt21(l,itype)%du + we(i)* CONJG(bcof(i,lm,natom,2))*acof(i,lm,natom,1)
mt21(l,itype)%dd = mt21(l,itype)%dd + we(i)* CONJG(bcof(i,lm,natom,2))*bcof(i,lm,natom,1)
denCoeffsOffdiag%uu21(l,itype) = denCoeffsOffdiag%uu21(l,itype) + we(i)* CONJG(acof(i,lm,natom,2))*acof(i,lm,natom,1)
denCoeffsOffdiag%ud21(l,itype) = denCoeffsOffdiag%ud21(l,itype) + we(i)* CONJG(acof(i,lm,natom,2))*bcof(i,lm,natom,1)
denCoeffsOffdiag%du21(l,itype) = denCoeffsOffdiag%du21(l,itype) + we(i)* CONJG(bcof(i,lm,natom,2))*acof(i,lm,natom,1)
denCoeffsOffdiag%dd21(l,itype) = denCoeffsOffdiag%dd21(l,itype) + we(i)* CONJG(bcof(i,lm,natom,2))*bcof(i,lm,natom,1)
ENDDO ! i = 1,ne
ENDDO ! m = -l,l
ENDDO ! l
......@@ -55,10 +53,10 @@ CONTAINS
DO m = -l,l
lm = l* (l+1) + m
DO i = 1,ne
lo21(lo,itype)%uulo = lo21(lo,itype)%uulo + we(i)* CONJG(acof(i,lm,natom,2))*ccof(m,i,lo,natom,1)
lo21(lo,itype)%dulo = lo21(lo,itype)%dulo + we(i)* CONJG(bcof(i,lm,natom,2))*ccof(m,i,lo,natom,1)
lo21(lo,itype)%ulou = lo21(lo,itype)%ulou + we(i)* CONJG(acof(i,lm,natom,1))*ccof(m,i,lo,natom,2)
lo21(lo,itype)%ulod = lo21(lo,itype)%ulod + we(i)* CONJG(bcof(i,lm,natom,1))*ccof(m,i,lo,natom,2)
denCoeffsOffdiag%uulo21(lo,itype) = denCoeffsOffdiag%uulo21(lo,itype) + we(i)* CONJG(acof(i,lm,natom,2))*ccof(m,i,lo,natom,1)
denCoeffsOffdiag%dulo21(lo,itype) = denCoeffsOffdiag%dulo21(lo,itype) + we(i)* CONJG(bcof(i,lm,natom,2))*ccof(m,i,lo,natom,1)
denCoeffsOffdiag%ulou21(lo,itype) = denCoeffsOffdiag%ulou21(lo,itype) + we(i)* CONJG(acof(i,lm,natom,1))*ccof(m,i,lo,natom,2)
denCoeffsOffdiag%ulod21(lo,itype) = denCoeffsOffdiag%ulod21(lo,itype) + we(i)* CONJG(bcof(i,lm,natom,1))*ccof(m,i,lo,natom,2)
ENDDO
ENDDO
!---> contribution of local orbital - local orbital terms
......@@ -67,7 +65,7 @@ CONTAINS
IF (atoms%llo(lop,itype).EQ.l) THEN
DO m = -l,l
DO i = 1,ne
uloulop21(lop,lo,itype) = uloulop21(lop,lo,itype)+&
denCoeffsOffdiag%uloulop21(lop,lo,itype) = denCoeffsOffdiag%uloulop21(lop,lo,itype)+&
we(i)*CONJG(ccof(m,i,lop,natom,2))*ccof(m,i,lo, natom,1)
ENDDO ! i = 1,ne
ENDDO ! m = -l,l
......
......@@ -14,24 +14,20 @@ MODULE m_rhomtlo
!***********************************************************************
!
CONTAINS
SUBROUTINE rhomtlo(atoms, ne,we,acof,bcof,ccof, aclo,bclo,cclo)
SUBROUTINE rhomtlo(atoms, ne,we,acof,bcof,ccof,denCoeffs,ispin)
USE m_types
IMPLICIT NONE
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne
! ..
! .. Array Arguments ..
TYPE(t_atoms),INTENT(IN) :: atoms
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)
REAL, INTENT (INOUT):: aclo(atoms%nlod,atoms%ntype),bclo(atoms%nlod,atoms%ntype)
REAL, INTENT (INOUT):: cclo(atoms%nlod,atoms%nlod,atoms%ntype)
! ..
! .. Local Scalars ..
INTEGER i,l,lm,lo,lop ,natom,nn,ntyp,m
! ..
......@@ -48,9 +44,9 @@ CONTAINS
DO m = -l,l
lm = l* (l+1) + m
DO i = 1,ne
aclo(lo,ntyp) = aclo(lo,ntyp) + we(i)*2*&
denCoeffs%aclo(lo,ntyp,ispin) = denCoeffs%aclo(lo,ntyp,ispin) + we(i)*2*&
real(conjg(acof(i,lm,natom))*ccof(m,i,lo,natom))
bclo(lo,ntyp) = bclo(lo,ntyp) + we(i)*2*&
denCoeffs%bclo(lo,ntyp,ispin) = denCoeffs%bclo(lo,ntyp,ispin) + we(i)*2*&
real(conjg(bcof(i,lm,natom))*ccof(m,i,lo,natom))
END DO
END DO
......@@ -60,7 +56,7 @@ CONTAINS
IF (atoms%llo(lop,ntyp).EQ.l) THEN
DO m = -l,l
DO i = 1,ne
cclo(lop,lo,ntyp) = cclo(lop,lo,ntyp) + we(i)*&
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))
END DO
END DO
......
MODULE m_rhonmt
CONTAINS
SUBROUTINE rhonmt(atoms,sphhar, we,ne,sym, acof,bcof,&
uunmt,ddnmt,udnmt,dunmt)
SUBROUTINE rhonmt(atoms,sphhar,we,ne,sym, acof,bcof,denCoeffs,ispin)
! *************************************************************
! subroutine sets up the coefficients of non-sphereical
! muffin-tin density c.l.fu
......@@ -9,21 +8,17 @@ 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
! ..
! .. Scalar Arguments ..
INTEGER,INTENT(IN) :: ne
! ..
! .. Array Arguments ..
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_denCoeffs), INTENT(INOUT) :: denCoeffs
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)
REAL,INTENT(INOUT) :: ddnmt(0:,:,:)!(0:(lmaxd* (lmaxd+3))/2,nlhd,ntypd)
REAL,INTENT(INOUT) :: dunmt(0:,:,:)
REAL,INTENT(INOUT) :: udnmt(0:,:,:)
REAL,INTENT(INOUT) :: uunmt(0:,:,:)
! ..
! .. Local Scalars ..
COMPLEX cconst,cil,cmv,ci
......@@ -78,14 +73,14 @@ CONTAINS
DO na = 1,atoms%neq(nn)
nt = nt + 1
IF (atoms%ntypsy(nt).EQ.ns) THEN
DO nb = 1,ne
uunmt(llp,lh,nn) = uunmt(llp,lh,nn)&
DO nb = 1,ne
denCoeffs%uunmt(llp,lh,nn,ispin) = denCoeffs%uunmt(llp,lh,nn,ispin)&
+we(nb)*real(cconst*acof(nb,lm,nt)*conjg(acof(nb,lmp,nt)))
ddnmt(llp,lh,nn) = ddnmt(llp,lh,nn) +&
denCoeffs%ddnmt(llp,lh,nn,ispin) = denCoeffs%ddnmt(llp,lh,nn,ispin) +&
we(nb)*real(cconst*bcof(nb,lm,nt)*conjg(bcof(nb,lmp,nt)))
udnmt(llp,lh,nn) = udnmt(llp,lh,nn) +&
denCoeffs%udnmt(llp,lh,nn,ispin) = denCoeffs%udnmt(llp,lh,nn,ispin) +&
we(nb)*real(cconst*acof(nb,lm,nt)*conjg(bcof(nb,lmp,nt)))
dunmt(llp,lh,nn) = dunmt(llp,lh,nn) +&
denCoeffs%dunmt(llp,lh,nn,ispin) = denCoeffs%dunmt(llp,lh,nn,ispin) +&
we(nb)*real(cconst*bcof(nb,lm,nt)*conjg(acof(nb,lmp,nt)))
ENDDO
ENDIF
......
......@@ -12,13 +12,14 @@ MODULE m_rhonmt21
! *************************************************************
CONTAINS
SUBROUTINE rhonmt21(atoms,llpd,sphhar, we,ne,sym,&
acof,bcof, uunmt21,ddnmt21,udnmt21,dunmt21)
acof,bcof,denCoeffsOffdiag)
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_sym),INTENT(IN) :: sym
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_denCoeffsOffdiag),INTENT(INOUT) :: denCoeffsOffdiag
! ..
! .. Scalar Arguments ..
INTEGER,INTENT(IN) :: llpd
......@@ -28,10 +29,6 @@ CONTAINS
COMPLEX, INTENT(IN) :: acof(:,0:,:,:)!(nobd,0:lmaxd* (lmaxd+2),natd,jspd)
COMPLEX, INTENT(IN) :: bcof(:,0:,:,:)
REAL, INTENT(IN) :: we(:)!(nobd)
COMPLEX, INTENT (INOUT) :: ddnmt21((atoms%lmaxd+1)**2,sphhar%nlhd,atoms%ntype )
COMPLEX, INTENT (INOUT) :: dunmt21((atoms%lmaxd+1)**2 ,sphhar%nlhd,atoms%ntype )
COMPLEX, INTENT (INOUT) :: udnmt21((atoms%lmaxd+1)**2 ,sphhar%nlhd,atoms%ntype )
COMPLEX, INTENT (INOUT) :: uunmt21((atoms%lmaxd+1)**2 ,sphhar%nlhd,atoms%ntype )
! ..
! .. Local Scalars ..
COMPLEX coef, cconst, cil, coef1
......@@ -68,13 +65,13 @@ CONTAINS
IF (ABS(coef) >= 0 ) THEN
DO nb = 1,ne
cconst= we(nb) * coef
uunmt21(llp,lh,nn) = uunmt21(llp,lh,nn)+ &
denCoeffsOffdiag%uunmt21(llp,lh,nn) = denCoeffsOffdiag%uunmt21(llp,lh,nn)+ &
cconst * acof(nb,lm,nt,1)*CONJG(acof(nb,lmp,nt,2))
udnmt21(llp,lh,nn) = udnmt21(llp,lh,nn)+&
denCoeffsOffdiag%udnmt21(llp,lh,nn) = denCoeffsOffdiag%udnmt21(llp,lh,nn)+&
cconst * bcof(nb,lm,nt,1)*CONJG(acof(nb,lmp,nt,2))
dunmt21(llp,lh,nn) = dunmt21(llp,lh,nn)+&
denCoeffsOffdiag%dunmt21(llp,lh,nn) = denCoeffsOffdiag%dunmt21(llp,lh,nn)+&
cconst * acof(nb,lm,nt,1)*CONJG(bcof(nb,lmp,nt,2))
ddnmt21(llp,lh,nn) = ddnmt21(llp,lh,nn)+&
denCoeffsOffdiag%ddnmt21(llp,lh,nn) = denCoeffsOffdiag%ddnmt21(llp,lh,nn)+&
cconst * bcof(nb,lm,nt,1)*CONJG(bcof(nb,lmp,nt,2))
ENDDO ! nb
ENDIF ! (coef >= 0)
......
......@@ -15,24 +15,22 @@ MODULE m_rhonmtlo
!***********************************************************************
!
CONTAINS
SUBROUTINE rhonmtlo(atoms,sphhar, ne,we,acof,bcof,ccof, acnmt,bcnmt,ccnmt)
SUBROUTINE rhonmtlo(atoms,sphhar, ne,we,acof,bcof,ccof,denCoeffs,ispin)
USE m_gaunt,ONLY:gaunt1
USE m_types
IMPLICIT NONE
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne
! ..
! .. Array Arguments ..
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
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:,:,:,:)!(-llod:llod,nobd,atoms%nlod,atoms%nat)
REAL, INTENT (INOUT) :: acnmt(0:atoms%lmaxd,atoms%nlod,sphhar%nlhd,atoms%ntype)
REAL, INTENT (INOUT) :: bcnmt(0:atoms%lmaxd,atoms%nlod,sphhar%nlhd,atoms%ntype)
REAL, INTENT (INOUT) :: ccnmt(atoms%nlod,atoms%nlod,sphhar%nlhd,atoms%ntype)
! ..
! .. Local Scalars ..
COMPLEX ci,cmv,fact,cf1
......@@ -87,8 +85,8 @@ CONTAINS
na = na + 1
DO i = 1,ne
cf1 = fact * ccof(m,i,lo,na)
acnmt(lp,lo,lh,ntyp) =acnmt(lp,lo,lh,ntyp) + we(i) * REAL(cf1 * CONJG(acof(i,lmp,na)) )
bcnmt(lp,lo,lh,ntyp) =bcnmt(lp,lo,lh,ntyp) + we(i) * REAL(cf1 * CONJG(bcof(i,lmp,na)) )
denCoeffs%acnmt(lp,lo,lh,ntyp,ispin) = denCoeffs%acnmt(lp,lo,lh,ntyp,ispin) + we(i) * REAL(cf1 * CONJG(acof(i,lmp,na)) )
denCoeffs%bcnmt(lp,lo,lh,ntyp,ispin) = denCoeffs%bcnmt(lp,lo,lh,ntyp,ispin) + we(i) * REAL(cf1 * CONJG(bcof(i,lmp,na)) )
END DO
END DO
END DO
......@@ -107,8 +105,8 @@ CONTAINS
na = na + 1
DO i = 1,ne
cf1 = fact * CONJG(ccof(m,i,lo,na))
acnmt(lp,lo,lh,ntyp) = acnmt(lp,lo,lh,ntyp) + we(i) * REAL(cf1 * acof(i,lmp,na) )
bcnmt(lp,lo,lh,ntyp) = bcnmt(lp,lo,lh,ntyp) + we(i) * REAL(cf1 * bcof(i,lmp,na) )
denCoeffs%acnmt(lp,lo,lh,ntyp,ispin) = denCoeffs%acnmt(lp,lo,lh,ntyp,ispin) + we(i) * REAL(cf1 * acof(i,lmp,na) )
denCoeffs%bcnmt(lp,lo,lh,ntyp,ispin) = denCoeffs%bcnmt(lp,lo,lh,ntyp,ispin) + we(i) * REAL(cf1 * bcof(i,lmp,na) )
END DO
END DO
END DO
......@@ -125,8 +123,8 @@ CONTAINS
DO nn = 1,atoms%neq(ntyp)
na = na + 1
DO i = 1,ne
ccnmt(lop,lo,lh,ntyp) =&
ccnmt(lop,lo,lh,ntyp) + we(i) * REAL(fact * CONJG(ccof(mp,i,lop,na))*ccof(m ,i,lo ,na))
denCoeffs%ccnmt(lop,lo,lh,ntyp,ispin) =&
denCoeffs%ccnmt(lop,lo,lh,ntyp,ispin) + we(i) * REAL(fact * CONJG(ccof(mp,i,lop,na))*ccof(m ,i,lo ,na))
END DO
END DO
END IF
......
......@@ -44,7 +44,7 @@ MODULE m_radovlp
CALL radfun(l,itype,ispin,epar(l,itype,ispin),vr(:,0,itype,ispin), atoms,&
f(1,1,l,ispin),g(1,1,l,ispin),usdus, nodeu,noded,wronk)
ENDDO
CALL int_21(f,g,atoms,itype,l, uun21(l,itype),udn21(l,itype), dun21(l,itype),ddn21(l,itype))
CALL int_21_arrays(f,g,atoms,itype,l,uun21,udn21,dun21,ddn21)
ENDDO
ENDDO
......
This diff is collapsed.
......@@ -33,7 +33,72 @@ PRIVATE
PROCEDURE,PASS :: init => orb_init
END TYPE t_orb
PUBLIC t_orb
TYPE t_denCoeffs
! spherical
REAL, ALLOCATABLE :: uu(:,:,:)
REAL, ALLOCATABLE :: dd(:,:,:)
REAL, ALLOCATABLE :: du(:,:,:)
! nonspherical
REAL, ALLOCATABLE :: uunmt(:,:,:,:)
REAL, ALLOCATABLE :: ddnmt(:,:,:,:)
REAL, ALLOCATABLE :: dunmt(:,:,:,:)
REAL, ALLOCATABLE :: udnmt(:,:,:,:)
! spherical - LOs
REAL, ALLOCATABLE :: aclo(:,:,:)
REAL, ALLOCATABLE :: bclo(:,:,:)
REAL, ALLOCATABLE :: cclo(:,:,:,:)
! nonspherical - LOs
REAL, ALLOCATABLE :: acnmt(:,:,:,:,:)
REAL, ALLOCATABLE :: bcnmt(:,:,:,:,:)
REAL, ALLOCATABLE :: ccnmt(:,:,:,:,:)
CONTAINS
PROCEDURE,PASS :: init => denCoeffs_init
END TYPE t_denCoeffs
TYPE t_denCoeffsOffdiag
! spherical
COMPLEX, ALLOCATABLE :: uu21(:,:)
COMPLEX, ALLOCATABLE :: dd21(:,:)
COMPLEX, ALLOCATABLE :: du21(:,:)
COMPLEX, ALLOCATABLE :: ud21(:,:)
! nonspherical
COMPLEX, ALLOCATABLE :: uunmt21(:,:,:)
COMPLEX, ALLOCATABLE :: ddnmt21(:,:,:)
COMPLEX, ALLOCATABLE :: dunmt21(:,:,:)
COMPLEX, ALLOCATABLE :: udnmt21(:,:,:)
! spherical - LOs
COMPLEX, ALLOCATABLE :: uulo21(:,:)
COMPLEX, ALLOCATABLE :: dulo21(:,:)
COMPLEX, ALLOCATABLE :: ulou21(:,:)
COMPLEX, ALLOCATABLE :: ulod21(:,:)
COMPLEX, ALLOCATABLE :: uloulop21(:,:,:)
! norms
REAL, ALLOCATABLE :: uu21n(:,:)
REAL, ALLOCATABLE :: ud21n(:,:)
REAL, ALLOCATABLE :: du21n(:,:)
REAL, ALLOCATABLE :: dd21n(:,:)
REAL, ALLOCATABLE :: uulo21n(:,:)
REAL, ALLOCATABLE :: dulo21n(:,:)
REAL, ALLOCATABLE :: ulou21n(:,:)
REAL, ALLOCATABLE :: ulod21n(:,:)
REAL, ALLOCATABLE :: uloulop21n(:,:,:)
CONTAINS