Commit d3272780 authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' into 'vgen-refactor'

# Conflicts:
#   init/initParallelProcesses.F90
#   init/old_inp/fleur_init_old.F90
#   main/fleur_init.F90
#   vgen/mpmom.F90
parents 84dff9d2 656013e7
This diff is collapsed.
......@@ -24,13 +24,15 @@ MODULE m_eparas
!
CONTAINS
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,regCharges,mcd,l_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_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
TYPE(t_usdus), INTENT(IN) :: usdus
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
TYPE(t_mcd), INTENT(INOUT) :: mcd
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: noccbd,jsp
......@@ -38,14 +40,8 @@ CONTAINS
LOGICAL, INTENT (IN) :: l_mcd,l_evp
! ..
! .. Array Arguments ..
INTEGER, INTENT (IN) :: ncore(atoms%ntype)
REAL, INTENT (IN) :: eig(:)!(dimension%neigd),
REAL, INTENT (IN) :: we(noccbd)
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)
REAL, INTENT (INOUT) :: qal(0:,:,:)!(0:3,atoms%ntype,dimension%neigd)
REAL, INTENT (INOUT) :: mcd(:,:,:)!(3*atoms%ntype,dimension%nstd,dimension%neigd)
! ..
! .. Local Scalars ..
......@@ -64,13 +60,13 @@ CONTAINS
IF ((ikpt.LE.mpi%isize).AND..NOT.l_evp) THEN
IF (l_mcd) THEN
mcd(:,:,:) = 0.0
mcd%mcd(:,:,:) = 0.0
ENDIF
ener(:,:) = 0.0
sqal(:,:) = 0.0
qal(:,:,:) = 0.0
enerlo(:,:) = 0.0
sqlo(:,:) = 0.0
regCharges%ener(:,:,jsp) = 0.0
regCharges%sqal(:,:,jsp) = 0.0
regCharges%qal(:,:,:,jsp) = 0.0
regCharges%enerlo(:,:,jsp) = 0.0
regCharges%sqlo(:,:,jsp) = 0.0
END IF
!
!---> l-decomposed density for each occupied state
......@@ -101,19 +97,19 @@ CONTAINS
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 icore = 1, mcd%ncore(n)
DO ipol = 1, 3
index = 3*(n-1) + ipol
mcd(index,icore,i)=mcd(index,icore,i) + fac*(&
suma * CONJG(m_mcd(icore,lm+1,index,1))*m_mcd(icore,lm+1,index,1) +&
sumb * CONJG(m_mcd(icore,lm+1,index,2))*m_mcd(icore,lm+1,index,2) +&
sumab* CONJG(m_mcd(icore,lm+1,index,2))*m_mcd(icore,lm+1,index,1) +&
sumba* CONJG(m_mcd(icore,lm+1,index,1))*m_mcd(icore,lm+1,index,2) )
mcd%mcd(index,icore,i)=mcd%mcd(index,icore,i) + fac*(&
suma * CONJG(mcd%m_mcd(icore,lm+1,index,1))*mcd%m_mcd(icore,lm+1,index,1) +&
sumb * CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,2) +&
sumab* CONJG(mcd%m_mcd(icore,lm+1,index,2))*mcd%m_mcd(icore,lm+1,index,1) +&
sumba* CONJG(mcd%m_mcd(icore,lm+1,index,1))*mcd%m_mcd(icore,lm+1,index,2) )
ENDDO
ENDDO
ENDIF ! end MCD
ENDDO
qal(l,n,i) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
regCharges%qal(l,n,i,jsp) = (suma+sumb*usdus%ddn(l,n,jsp))/atoms%neq(n)
ENDDO
nt1 = nt1 + atoms%neq(n)
ENDDO
......@@ -126,8 +122,8 @@ CONTAINS
DO l = 0,3
DO n = 1,atoms%ntype
DO i = (skip_t+1),noccbd
ener(l,n) = ener(l,n) + qal(l,n,i)*we(i)*eig(i)
sqal(l,n) = sqal(l,n) + qal(l,n,i)*we(i)
regCharges%ener(l,n,jsp) = regCharges%ener(l,n,jsp) + regCharges%qal(l,n,i,jsp)*we(i)*eig(i)
regCharges%sqal(l,n,jsp) = regCharges%sqal(l,n,jsp) + regCharges%qal(l,n,i,jsp)*we(i)
ENDDO
ENDDO
ENDDO
......@@ -180,15 +176,15 @@ CONTAINS
! llo > 3 used for unoccupied states only
IF( l .GT. 3 ) CYCLE
DO i = 1,ne
qal(l,ntyp,i)= qal(l,ntyp,i) + ( 1.0/atoms%neq(ntyp) )* (&
regCharges%qal(l,ntyp,i,jsp)= regCharges%qal(l,ntyp,i,jsp) + ( 1.0/atoms%neq(ntyp) )* (&
qaclo(i,lo,ntyp)*usdus%uulon(lo,ntyp,jsp)+qbclo(i,lo,ntyp)*usdus%dulon(lo,ntyp,jsp) )
END DO
DO lop = 1,atoms%nlo(ntyp)
IF (atoms%llo(lop,ntyp).EQ.l) THEN
DO i = 1,ne
enerlo(lo,ntyp) = enerlo(lo,ntyp) +qlo(i,lop,lo,ntyp)*we(i)*eig(i)
sqlo(lo,ntyp) = sqlo(lo,ntyp) + qlo(i,lop,lo,ntyp)*we(i)
qal(l,ntyp,i)= qal(l,ntyp,i) + ( 1.0/atoms%neq(ntyp) ) *&
regCharges%enerlo(lo,ntyp,jsp) = regCharges%enerlo(lo,ntyp,jsp) +qlo(i,lop,lo,ntyp)*we(i)*eig(i)
regCharges%sqlo(lo,ntyp,jsp) = regCharges%sqlo(lo,ntyp,jsp) + qlo(i,lop,lo,ntyp)*we(i)
regCharges%qal(l,ntyp,i,jsp)= regCharges%qal(l,ntyp,i,jsp) + ( 1.0/atoms%neq(ntyp) ) *&
qlo(i,lop,lo,ntyp)*usdus%uloulopn(lop,lo,ntyp,jsp)
ENDDO
ENDIF
......
......@@ -5,25 +5,22 @@ MODULE m_qal21
!***********************************************************************
!
CONTAINS
SUBROUTINE qal_21(atoms,input,noccbd,we,noco,eigVecCoeffs,denCoeffsOffdiag,qal,qmat)
SUBROUTINE qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,regCharges)
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_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
! ..
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_input), INTENT(IN) :: input
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_denCoeffsOffdiag), INTENT(IN) :: denCoeffsOffdiag
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: noccbd
! ..
! .. Array Arguments ..
REAL, INTENT (INout) :: we(noccbd),qal(0:,:,:,:)!(0:3,atoms%ntype,DIMENSION%neigd,input%jspins)
REAL, INTENT (OUT) :: qmat(0:,:,:,:)!(0:3,atoms%ntype,DIMENSION%neigd,4)
TYPE (t_denCoeffsOffdiag), INTENT (IN) :: denCoeffsOffdiag
INTEGER, INTENT (IN) :: noccbd
! ..
! .. Local Scalars ..
INTEGER i,l,lo,lop ,natom,nn,ntyp
INTEGER nt1,nt2,lm,n,ll1,ipol,icore,index,m
......@@ -31,19 +28,18 @@ CONTAINS
COMPLEX sumaa,sumbb,sumab,sumba
COMPLEX, PARAMETER :: ci = (0.0,1.0)
! ..
! .. Local Arrays ..
COMPLEX qlo(noccbd,atoms%nlod,atoms%nlod,atoms%ntype)
COMPLEX qaclo(noccbd,atoms%nlod,atoms%ntype),qbclo(noccbd,atoms%nlod,atoms%ntype)
COMPLEX qcloa(noccbd,atoms%nlod,atoms%ntype),qclob(noccbd,atoms%nlod,atoms%ntype)
COMPLEX qal21(0:3,atoms%ntype,size(qmat,3))
COMPLEX qal21(0:3,atoms%ntype,dimension%neigd)
COMPLEX q_loc(2,2),q_hlp(2,2),chi(2,2)
! ..
REAL qmat(0:3,atoms%ntype,dimension%neigd,4)
! .. Intrinsic Functions ..
INTRINSIC conjg
!
!---> l-decomposed density for each occupied state
!
states : DO i = 1, noccbd
nt1 = 1
types_loop : DO n = 1 ,atoms%ntype
......@@ -153,11 +149,11 @@ CONTAINS
state : DO i = 1, noccbd
lls : DO l = 0,3
CALL rot_den_mat(noco%alph(n),noco%beta(n),&
qal(l,n,i,1),qal(l,n,i,2),qal21(l,n,i))
regCharges%qal(l,n,i,1),regCharges%qal(l,n,i,2),qal21(l,n,i))
IF (.FALSE.) THEN
IF (n==1) WRITE(*,'(3i3,4f10.5)') l,n,i,qal21(l,n,i),&
qal(l,n,i,:)
q_loc(1,1) = qal(l,n,i,1); q_loc(2,2) = qal(l,n,i,2)
regCharges%qal(l,n,i,:)
q_loc(1,1) = regCharges%qal(l,n,i,1); q_loc(2,2) = regCharges%qal(l,n,i,2)
q_loc(1,2) = qal21(l,n,i); q_loc(2,1) = CONJG(q_loc(1,2))
q_hlp = MATMUL( TRANSPOSE( CONJG(chi) ) ,q_loc)
q_loc = MATMUL(q_hlp,chi)
......
......@@ -9,7 +9,7 @@ CONTAINS
vacuum,DIMENSION,stars,oneD,&
kpts,input,cell,atoms,noco,banddos,&
gvac1,gvac2,&
we,ikpt,jspin,vz,vz0,&
we,ikpt,jspin,vz,&
ne,lapw,&
evac,eig,den,qvac,qvlay,&
stcoeff,zMat)
......@@ -73,10 +73,11 @@ CONTAINS
INTEGER,PARAMETER :: n2max=13
REAL,PARAMETER :: emax=2.0/hartree_to_ev_const
! .. Array Arguments ..
REAL, INTENT (IN) :: evac(2,DIMENSION%jspd)
REAL, INTENT (OUT) :: qvlay(DIMENSION%neigd,vacuum%layerd,2,kpts%nkpt,DIMENSION%jspd)
REAL qvac(DIMENSION%neigd,2,kpts%nkpt,DIMENSION%jspd),we(DIMENSION%neigd),vz(vacuum%nmzd,2),vz0(2)
!
REAL, INTENT(IN) :: evac(2,DIMENSION%jspd)
REAL, INTENT(OUT) :: qvlay(DIMENSION%neigd,vacuum%layerd,2,kpts%nkpt,DIMENSION%jspd)
REAL, INTENT(INOUT) :: qvac(DIMENSION%neigd,2,kpts%nkpt,DIMENSION%jspd)
REAL, INTENT(IN) :: we(DIMENSION%neigd)
REAL :: vz(vacuum%nmzd,2) ! Note this breaks the INTENT(IN) from cdnval. It may be read from a file in this subroutine.
! STM-Arguments
REAL, INTENT (IN) :: eig(DIMENSION%neigd)
INTEGER, INTENT (IN) :: gvac1(DIMENSION%nv2d),gvac2(DIMENSION%nv2d)
......@@ -101,7 +102,7 @@ CONTAINS
& ind1,ind1p,irec2,irec3,m
!
! .. Local Arrays ..
REAL qssbti(3,2),qssbtii
REAL qssbti(3,2),qssbtii,vz0(2)
REAL bess(-oneD%odi%mb:oneD%odi%mb),dbss(-oneD%odi%mb:oneD%odi%mb)
COMPLEX, ALLOCATABLE :: ac(:,:,:),bc(:,:,:)
REAL, ALLOCATABLE :: dt(:),dte(:),du(:),ddu(:,:),due(:)
......@@ -165,6 +166,7 @@ CONTAINS
END IF ! oneD%odi%d1
!
vz0(:) = vz(vacuum%nmz,:)
eps=0.01
ic = CMPLX(0.,1.)
! ------------------
......
......@@ -21,7 +21,7 @@ MODULE m_abclocdn
!*********************************************************************
CONTAINS
SUBROUTINE abclocdn(atoms,sym,noco,lapw,cell,ccchi,iintsp,phase,ylm,&
ntyp,na,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,fgp,force)
ntyp,na,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,l_force,fgp,force)
USE m_types
USE m_constants
......@@ -40,6 +40,7 @@ CONTAINS
INTEGER, INTENT (IN) :: iintsp
INTEGER, INTENT (IN) :: k,na,ne,ntyp,nkvec,lo
COMPLEX, INTENT (IN) :: phase
LOGICAL, INTENT (IN) :: l_force
! .. Array Arguments ..
REAL, INTENT (IN) :: alo1(:),blo1(:),clo1(:)
......@@ -83,7 +84,7 @@ CONTAINS
acof(i,lm,na) = acof(i,lm,na) + ctmp*alo1(lo)
bcof(i,lm,na) = bcof(i,lm,na) + ctmp*blo1(lo)
ccof(m,i,lo,na) = ccof(m,i,lo,na) + ctmp*clo1(lo)
IF (PRESENT(force)) THEN
IF (l_force) THEN
force%acoflo(m,i,lo,na) = force%acoflo(m,i,lo,na) + ctmp*alo1(lo)
force%bcoflo(m,i,lo,na) = force%bcoflo(m,i,lo,na) + ctmp*blo1(lo)
DO j = 1,3
......
MODULE m_abcof
CONTAINS
SUBROUTINE abcof(input,atoms,sym, cell,lapw,ne,usdus,&
noco,jspin,oneD, acof,bcof,ccof,zMat,&
eig,force)
noco,jspin,oneD, acof,bcof,ccof,zMat,eig,force)
! ************************************************************
! subroutine constructs the a,b coefficients of the linearized
! m.t. wavefunctions for each band and atom. c.l. fu
......@@ -36,7 +35,7 @@ CONTAINS
COMPLEX, INTENT (OUT) :: acof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (OUT) :: bcof(:,0:,:)!(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (OUT) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,atoms%nat)
REAL, OPTIONAL, INTENT (IN) :: eig(:)!(dimension%neigd)
REAL, OPTIONAL, INTENT (IN) :: eig(:)!(dimension%neigd)
! ..
! .. Local Scalars ..
COMPLEX cexp,phase,c_0,c_1,c_2,ci
......@@ -44,6 +43,7 @@ CONTAINS
REAL s2h, s2h_e(ne)
INTEGER i,j,k,l,ll1,lm ,n,nap,natom,nn,iatom,jatom,lmp,m,nkvec
INTEGER inv_f,ie,ilo,kspin,iintsp,nintsp,nvmax,lo,inap
LOGICAL l_force
! ..
! .. Local Arrays ..
INTEGER nbasf0(atoms%nlod,atoms%nat)
......@@ -55,20 +55,22 @@ CONTAINS
REAL, ALLOCATABLE :: work_r(:)
COMPLEX, ALLOCATABLE :: work_c(:)
IF (zmat%l_real) THEN
IF (noco%l_soc.AND.sym%invs) CALL judft_error("BUG in abcof, SOC&INVS but real?")
IF (noco%l_noco) CALL judft_error("BUG in abcof, l_noco but real?")
ENDIF
! ..
ci = CMPLX(0.0,1.0)
const = 2 * tpi_const/SQRT(cell%omtil)
!
acof(:,:,:) = CMPLX(0.0,0.0)
bcof(:,:,:) = CMPLX(0.0,0.0)
ccof(:,:,:,:) = CMPLX(0.0,0.0)
IF(PRESENT(eig)) THEN
l_force = .FALSE.
IF(PRESENT(eig).AND.input%l_f) THEN
l_force = .TRUE.
END IF
IF(l_force) THEN
force%acoflo = CMPLX(0.0,0.0)
force%bcoflo = CMPLX(0.0,0.0)
force%e1cof = CMPLX(0.0,0.0)
......@@ -77,7 +79,7 @@ CONTAINS
force%bveccof = CMPLX(0.0,0.0)
force%cveccof = CMPLX(0.0,0.0)
END IF
! ..
!+APW_LO
DO n = 1, atoms%ntype
DO l = 0,atoms%lmax(n)
......@@ -111,11 +113,8 @@ CONTAINS
!$OMP& DEFAULT(none)&
!$OMP& PRIVATE(n,nn,natom,k,i,work_r,work_c,ccchi,kspin,fg,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,lo,nkvec,&
!$OMP& alo1,blo1,clo1,inap,nap,j,fgr,fgp,s2h,s2h_e,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,jatom,lmp,inv_f,lm)&
!$OMP& SHARED(noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,eig,&
!$OMP& jspin,qss,&
!$OMP& apw,const,&
!$OMP& nbasf0,enough,&
!$OMP& acof,bcof,ccof,force)
!$OMP& SHARED(noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,eig,l_force,&
!$OMP& jspin,qss,apw,const,nbasf0,enough,acof,bcof,ccof,force)
DO n = 1,atoms%ntype
CALL setabc1lo(atoms,n,usdus,jspin,alo1,blo1,clo1)
......@@ -173,7 +172,7 @@ CONTAINS
ENDIF ! (noco%l_ss)
fk = lapw%bkpt + fg
s = DOT_PRODUCT(fk,MATMUL(cell%bbmat,fk))
IF(PRESENT(eig)) THEN
IF(l_force) THEN
s2h = 0.5*s
s2h_e(:ne) = s2h-eig(:ne)
END IF
......@@ -238,7 +237,7 @@ CONTAINS
bcof(:ne,lm,natom) = bcof(:ne,lm,natom) + c_2 * work_c(:ne)
END IF
IF ((atoms%l_geo(n)).AND.(PRESENT(eig))) THEN
IF (atoms%l_geo(n).AND.l_force) THEN
IF (zmat%l_real) THEN
force%e1cof(:ne,lm,natom) = force%e1cof(:ne,lm,natom) + c_1 * work_r(:ne) * s2h_e(:ne)
force%e2cof(:ne,lm,natom) = force%e2cof(:ne,lm,natom) + c_2 * work_r(:ne) * s2h_e(:ne)
......@@ -265,7 +264,7 @@ CONTAINS
c_2 = CONJG(c_2) * inv_f
CALL CPP_BLAS_caxpy(ne,c_1,work_c,1, acof(1,lmp,jatom),1)
CALL CPP_BLAS_caxpy(ne,c_2,work_c,1, bcof(1,lmp,jatom),1)
IF ((atoms%l_geo(n)).AND.(PRESENT(eig))) THEN
IF (atoms%l_geo(n).AND.l_force) THEN
CALL CPP_BLAS_caxpy(ne,c_1,work_c*s2h_e,1, force%e1cof(1,lmp,jatom),1)
CALL CPP_BLAS_caxpy(ne,c_2,work_c*s2h_e,1, force%e2cof(1,lmp,jatom),1)
DO i = 1,3
......@@ -281,7 +280,7 @@ CONTAINS
DO nkvec=1,lapw%nkvec(lo,natom)
IF (k==lapw%kvec(nkvec,lo,natom)) THEN !check if this k-vector has LO attached
CALL abclocdn(atoms,sym,noco,lapw,cell,ccchi(:,jspin),iintsp,phase,ylm,&
n,natom,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,fgp,force)
n,natom,k,nkvec,lo,ne,alo1,blo1,clo1,acof,bcof,ccof,zMat,l_force,fgp,force)
ENDIF
ENDDO
END DO
......@@ -326,7 +325,7 @@ CONTAINS
inv_f = (-1.0)**(m+l)
DO ie = 1,ne
ccof(m,ie,ilo,jatom) = inv_f * cexp * CONJG( ccof(-m,ie,ilo,iatom))
IF(PRESENT(eig)) THEN
IF(l_force) THEN
force%acoflo(m,ie,ilo,jatom) = inv_f * cexp * CONJG(force%acoflo(-m,ie,ilo,iatom))
force%bcoflo(m,ie,ilo,jatom) = inv_f * cexp * CONJG(force%bcoflo(-m,ie,ilo,iatom))
DO i = 1,3
......@@ -346,7 +345,7 @@ CONTAINS
acof(ie,lm,jatom) = inv_f * cexp * CONJG(acof(ie,lmp,iatom))
bcof(ie,lm,jatom) = inv_f * cexp * CONJG(bcof(ie,lmp,iatom))
END DO
IF ((atoms%l_geo(n)).AND.(PRESENT(eig))) THEN
IF (atoms%l_geo(n).AND.l_force) THEN
DO ie = 1,ne
force%e1cof(ie,lm,jatom) = inv_f * cexp * CONJG(force%e1cof(ie,lmp,iatom))
force%e2cof(ie,lm,jatom) = inv_f * cexp * CONJG(force%e2cof(ie,lmp,iatom))
......
......@@ -9,7 +9,7 @@ MODULE m_cdncore
CONTAINS
SUBROUTINE cdncore(results,mpi,dimension,oneD,sliceplot,input,vacuum,noco,sym,&
stars,cell,sphhar,atoms,vTot,outDen,stdn,svdn)
stars,cell,sphhar,atoms,vTot,outDen,moments)
USE m_constants
USE m_cdn_io
......@@ -41,8 +41,7 @@ SUBROUTINE cdncore(results,mpi,dimension,oneD,sliceplot,input,vacuum,noco,sym,&
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: vTot
TYPE(t_potden),INTENT(INOUT) :: outDen
REAL, INTENT(INOUT) :: stdn(atoms%ntype,dimension%jspd)
REAL, INTENT(INOUT) :: svdn(atoms%ntype,dimension%jspd)
TYPE(t_moments),INTENT(INOUT) :: moments
INTEGER :: jspin, n, iType
REAL :: seig, rhoint, momint
......@@ -57,7 +56,7 @@ SUBROUTINE cdncore(results,mpi,dimension,oneD,sliceplot,input,vacuum,noco,sym,&
IF (mpi%irank.EQ.0) THEN
DO jspin = 1,input%jspins
DO n = 1,atoms%ntype
svdn(n,jspin) = outDen%mt(1,0,n,jspin) / (sfp_const*atoms%rmsh(1,n)*atoms%rmsh(1,n))
moments%svdn(n,jspin) = outDen%mt(1,0,n,jspin) / (sfp_const*atoms%rmsh(1,n)*atoms%rmsh(1,n))
END DO
END DO
END IF
......@@ -99,7 +98,7 @@ SUBROUTINE cdncore(results,mpi,dimension,oneD,sliceplot,input,vacuum,noco,sym,&
DO jspin = 1,input%jspins
IF (mpi%irank.EQ.0) THEN
DO n = 1,atoms%ntype
stdn(n,jspin) = outDen%mt(1,0,n,jspin) / (sfp_const*atoms%rmsh(1,n)*atoms%rmsh(1,n))
moments%stdn(n,jspin) = outDen%mt(1,0,n,jspin) / (sfp_const*atoms%rmsh(1,n)*atoms%rmsh(1,n))
END DO
END IF
IF ((noco%l_noco).AND.(mpi%irank.EQ.0)) THEN
......
......@@ -11,9 +11,7 @@ MODULE m_cdnmt
!***********************************************************************
CONTAINS
SUBROUTINE cdnmt(jspd,atoms,sphhar,llpd, noco,l_fmpl,jsp_start,jsp_end, epar,&
ello,vr,denCoeffs,usdus,&
orb,denCoeffsOffdiag,&
chmom,clmom, qa21,rho)
ello,vr,denCoeffs,usdus,orb,denCoeffsOffdiag,moments,rho)
use m_constants,only: sfp_const
USE m_rhosphnlo
USE m_radfun
......@@ -21,10 +19,11 @@ CONTAINS
USE m_types
USE m_xmlOutput
IMPLICIT NONE
TYPE(t_usdus),INTENT(INOUT):: usdus !in fact only the lo part is intent(in)
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus), INTENT(INOUT) :: usdus !in fact only the lo part is intent(in)
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_moments), INTENT(INOUT) :: moments
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: llpd
......@@ -35,9 +34,7 @@ CONTAINS
REAL, INTENT (IN) :: epar(0:atoms%lmaxd,atoms%ntype,jspd)
REAL, INTENT (IN) :: vr(atoms%jmtd,atoms%ntype,jspd)
REAL, INTENT (IN) :: ello(atoms%nlod,atoms%ntype,jspd)
REAL, INTENT (OUT) :: chmom(atoms%ntype,jspd),clmom(3,atoms%ntype,jspd)
REAL, INTENT (INOUT) :: rho(:,0:,:,:)!(toms%jmtd,0:sphhar%nlhd,atoms%ntype,jspd)
COMPLEX, INTENT(INOUT) :: qa21(atoms%ntype)
TYPE (t_orb), INTENT(IN) :: orb
TYPE (t_denCoeffs), INTENT(IN) :: denCoeffs
TYPE (t_denCoeffsOffdiag), INTENT(IN) :: denCoeffsOffdiag
......@@ -69,7 +66,7 @@ CONTAINS
!$OMP PARALLEL DEFAULT(none) &
!$OMP SHARED(usdus,rho,chmom,clmom,qa21,rho21,qmtl) &
!$OMP SHARED(usdus,rho,moments,rho21,qmtl) &
!$OMP SHARED(atoms,jsp_start,jsp_end,epar,vr,denCoeffs,sphhar,ello)&
!$OMP SHARED(orb,noco,l_fmpl,denCoeffsOffdiag,jspd)&
!$OMP PRIVATE(itype,na,ispin,l,f,g,nodeu,noded,wronk,i,j,s,qmtllo,qmtt,nd,lh,lp,llp,cs)
......@@ -125,14 +122,14 @@ CONTAINS
& *usdus%ddn(l,itype,ispin) )/atoms%neq(itype) + qmtllo(l)
qmtt = qmtt + qmtl(l,ispin,itype)
END DO
chmom(itype,ispin) = qmtt
moments%chmom(itype,ispin) = qmtt
!+soc
!---> spherical angular component
IF (noco%l_soc) THEN
CALL orbmom2(atoms,itype,ispin,usdus%ddn(0,itype,ispin),&
orb,usdus%uulon(1,itype,ispin),usdus%dulon(1,itype,ispin),&
usdus%uloulopn(1,1,itype,ispin),clmom(1,itype,ispin))!keep
usdus%uloulopn(1,1,itype,ispin),moments%clmom(1,itype,ispin))!keep
ENDIF
!-soc
!---> non-spherical components
......@@ -161,21 +158,21 @@ CONTAINS
!---> calculate off-diagonal integrated density
DO l = 0,atoms%lmax(itype)
qa21(itype) = qa21(itype) + conjg(&
moments%qa21(itype) = moments%qa21(itype) + conjg(&
denCoeffsOffdiag%uu21(l,itype) * denCoeffsOffdiag%uu21n(l,itype) +&
denCoeffsOffdiag%ud21(l,itype) * denCoeffsOffdiag%ud21n(l,itype) +&
denCoeffsOffdiag%du21(l,itype) * denCoeffsOffdiag%du21n(l,itype) +&
denCoeffsOffdiag%dd21(l,itype) * denCoeffsOffdiag%dd21n(l,itype) )/atoms%neq(itype)
ENDDO
DO ilo = 1, atoms%nlo(itype)
qa21(itype) = qa21(itype) + conjg(&
moments%qa21(itype) = moments%qa21(itype) + conjg(&
denCoeffsOffdiag%ulou21(ilo,itype) * denCoeffsOffdiag%ulou21n(ilo,itype) +&
denCoeffsOffdiag%ulod21(ilo,itype) * denCoeffsOffdiag%ulod21n(ilo,itype) +&
denCoeffsOffdiag%uulo21(ilo,itype) * denCoeffsOffdiag%uulo21n(ilo,itype) +&
denCoeffsOffdiag%dulo21(ilo,itype) * denCoeffsOffdiag%dulo21n(ilo,itype) )/&
atoms%neq(itype)
DO ilop = 1, atoms%nlo(itype)
qa21(itype) = qa21(itype) + conjg(&
moments%qa21(itype) = moments%qa21(itype) + conjg(&
denCoeffsOffdiag%uloulop21(ilo,ilop,itype) *&
denCoeffsOffdiag%uloulop21n(ilo,ilop,itype) )/atoms%neq(itype)
ENDDO
......@@ -230,12 +227,12 @@ CONTAINS
DO itype = 1,atoms%ntype
DO ispin = jsp_start,jsp_end
WRITE ( 6,FMT=8100) itype, (qmtl(l,ispin,itype),l=0,3),chmom(itype,ispin)
WRITE (16,FMT=8100) itype, (qmtl(l,ispin,itype),l=0,3),chmom(itype,ispin)
WRITE ( 6,FMT=8100) itype, (qmtl(l,ispin,itype),l=0,3),moments%chmom(itype,ispin)
WRITE (16,FMT=8100) itype, (qmtl(l,ispin,itype),l=0,3),moments%chmom(itype,ispin)
8100 FORMAT (' -->',i3,2x,4f9.5,2x,f9.5)
attributes = ''
WRITE(attributes(1),'(i0)') itype
WRITE(attributes(2),'(f12.7)') chmom(itype,ispin)
WRITE(attributes(2),'(f12.7)') moments%chmom(itype,ispin)
WRITE(attributes(3),'(f12.7)') qmtl(0,ispin,itype)
WRITE(attributes(4),'(f12.7)') qmtl(1,ispin,itype)
WRITE(attributes(5),'(f12.7)') qmtl(2,ispin,itype)
......
......@@ -8,7 +8,7 @@ MODULE m_magMoms
CONTAINS
SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,stdn,svdn,chmom,qa21)
SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,moments)
USE m_types
USE m_xmlOutput
......@@ -21,11 +21,7 @@ SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,stdn,svdn,chmom,qa21)
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_noco), INTENT(INOUT) :: noco
TYPE(t_potden),INTENT(IN) :: vTot
REAL, INTENT(INOUT) :: chmom(atoms%ntype,dimension%jspd)
COMPLEX, INTENT(IN) :: qa21(atoms%ntype)
REAL, INTENT(IN) :: stdn(atoms%ntype,dimension%jspd)
REAL, INTENT(IN) :: svdn(atoms%ntype,dimension%jspd)
TYPE(t_moments),INTENT(IN) :: moments
INTEGER :: iType, j, iRepAtom
REAL :: sval,stot,scor,smom
......@@ -34,11 +30,11 @@ SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,stdn,svdn,chmom,qa21)
WRITE (6,FMT=8000)
WRITE (16,FMT=8000)
DO iType = 1,atoms%ntype
sval = svdn(iType,1) - svdn(iType,input%jspins)
stot = stdn(iType,1) - stdn(iType,input%jspins)
sval = moments%svdn(iType,1) - moments%svdn(iType,input%jspins)
stot = moments%stdn(iType,1) - moments%stdn(iType,input%jspins)
scor = stot - sval
WRITE (6,FMT=8010) iType,stot,sval,scor,svdn(iType,1),stdn(iType,1)
WRITE (16,FMT=8010) iType,stot,sval,scor,svdn(iType,1),stdn(iType,1)
WRITE (6,FMT=8010) iType,stot,sval,scor,moments%svdn(iType,1),moments%stdn(iType,1)
WRITE (16,FMT=8010) iType,stot,sval,scor,moments%svdn(iType,1),moments%stdn(iType,1)
END DO
8000 FORMAT (/,/,10x,'spin density at the nucleus:',/,10x,'type',t25,&
......@@ -52,14 +48,14 @@ SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,stdn,svdn,chmom,qa21)