Commit e82adc28 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce t_moments type to main/cdngen.F90

parent c8f4d88f
......@@ -3,7 +3,7 @@ MODULE m_cdnval
CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atoms,enpara,stars,&
vacuum,dimension,sphhar,sym,obsolete,vTot,oneD,coreSpecInput,den,regCharges,results,&
qa21,chmom,clmom)
moments)
!
! ***********************************************************
! this subroutin is a modified version of cdnval.F.
......@@ -86,36 +86,32 @@ CONTAINS
USE m_types
USE m_xmlOutput
IMPLICIT NONE
TYPE(t_results),INTENT(INOUT) :: results
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_enpara),INTENT(INOUT) :: enpara
TYPE(t_obsolete),INTENT(IN) :: obsolete
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_sliceplot),INTENT(IN) :: sliceplot
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_coreSpecInput),INTENT(IN) :: coreSpecInput
TYPE(t_potden),INTENT(IN) :: vTot
TYPE(t_potden),INTENT(INOUT) :: den
TYPE(t_regionCharges),INTENT(INOUT) :: regCharges
TYPE(t_results), INTENT(INOUT) :: results
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_enpara), INTENT(INOUT) :: enpara
TYPE(t_obsolete), INTENT(IN) :: obsolete
TYPE(t_banddos), INTENT(IN) :: banddos
TYPE(t_sliceplot), INTENT(IN) :: sliceplot
TYPE(t_input), INTENT(IN) :: input
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_coreSpecInput), INTENT(IN) :: coreSpecInput
TYPE(t_potden), INTENT(IN) :: vTot
TYPE(t_potden), INTENT(INOUT) :: den
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
TYPE(t_moments), INTENT(INOUT) :: moments
! .. Scalar Arguments ..
INTEGER, INTENT(IN) :: eig_id,jspin
! .. Array Arguments ..
COMPLEX, INTENT(INOUT) :: qa21(atoms%ntype)
REAL, INTENT(OUT) :: chmom(atoms%ntype,dimension%jspd)
REAL, INTENT(OUT) :: clmom(3,atoms%ntype,dimension%jspd)
#ifdef CPP_MPI
INCLUDE 'mpif.h'
LOGICAL :: mpi_flag, mpi_status
......@@ -616,10 +612,9 @@ CONTAINS
END IF
IF (mpi%irank==0) THEN
CALL cdnmt(dimension%jspd,atoms,sphhar,llpd,&
noco,l_fmpl,jsp_start,jsp_end,&
CALL cdnmt(dimension%jspd,atoms,sphhar,llpd,noco,l_fmpl,jsp_start,jsp_end,&
enpara%el0,enpara%ello0,vTot%mt(:,0,:,:),denCoeffs,&
usdus,orb,denCoeffsOffdiag,chmom,clmom,qa21,den%mt)
usdus,orb,denCoeffsOffdiag,moments,den%mt)
DO ispin = jsp_start,jsp_end
IF (.NOT.sliceplot%slice) THEN
......
......@@ -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)
CALL openXMLElement('magneticMomentsInMTSpheres',(/'units'/),(/'muBohr'/))
iRepAtom = 1
DO iType = 1, atoms%ntype
smom = chmom(iType,1) - chmom(iType,input%jspins)
WRITE (6,FMT=8030) iType,smom, (chmom(iType,j),j=1,input%jspins)
WRITE (16,FMT=8030) iType,smom, (chmom(iType,j),j=1,input%jspins)
smom = moments%chmom(iType,1) - moments%chmom(iType,input%jspins)
WRITE (6,FMT=8030) iType,smom, (moments%chmom(iType,j),j=1,input%jspins)
WRITE (16,FMT=8030) iType,smom, (moments%chmom(iType,j),j=1,input%jspins)
attributes = ''
WRITE(attributes(1),'(i0)') iType
WRITE(attributes(2),'(f15.10)') smom
WRITE(attributes(3),'(f15.10)') chmom(iType,1)
WRITE(attributes(4),'(f15.10)') chmom(iType,2)
WRITE(attributes(3),'(f15.10)') moments%chmom(iType,1)
WRITE(attributes(4),'(f15.10)') moments%chmom(iType,2)
CALL writeXMLElementFormPoly('magneticMoment',(/'atomType ','moment ','spinUpCharge ',&
'spinDownCharge'/),&
attributes,reshape((/8,6,12,14,6,15,15,15/),(/4,2/)))
......@@ -68,7 +64,7 @@ SUBROUTINE magMoms(dimension,input,atoms,noco,vTot,stdn,svdn,chmom,qa21)
!calculate the perpendicular part of the local moment
!and relax the angle of the local moment or calculate
!the constraint B-field.
CALL m_perp(atoms,iType,iRepAtom,noco,vTot%mt(:,0,:,:),chmom,qa21)
CALL m_perp(atoms,iType,iRepAtom,noco,vTot%mt(:,0,:,:),moments%chmom,moments%qa21)
END IF
iRepAtom= iRepAtom + atoms%neq(iType)
END DO
......
......@@ -66,27 +66,19 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
INTEGER, INTENT (IN) :: eig_id, archiveType
! Local type instances
TYPE(t_noco) :: noco_new
TYPE(t_regionCharges) :: regCharges
TYPE(t_noco) :: noco_new
TYPE(t_regionCharges) :: regCharges
TYPE(t_moments) :: moments
!Local Scalars
REAL fix,qtot,dummy
INTEGER jspin,jspmax
REAL :: fix, qtot, dummy
INTEGER :: jspin, jspmax
!Local Arrays
REAL stdn(atoms%ntype,dimension%jspd),svdn(atoms%ntype,dimension%jspd)
REAL chmom(atoms%ntype,dimension%jspd),clmom(3,atoms%ntype,dimension%jspd)
COMPLEX,ALLOCATABLE :: qa21(:)
ALLOCATE (qa21(atoms%ntype))
!initialize density arrays with zero
qa21(:) = cmplx(0.0,0.0)
CALL regCharges%init(input,atoms,dimension,kpts,vacuum)
CALL moments%init(input,atoms)
IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('valenceDensity')
CALL regCharges%init(input,atoms,dimension,kpts,vacuum)
!In a non-collinear calcuation where the off-diagonal part of the
!density matrix in the muffin-tins is calculated, the a- and
!b-coef. for both spins are needed at once. Thus, cdnval is only
......@@ -95,10 +87,8 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
IF (noco%l_mperp) jspmax = 1
DO jspin = 1,jspmax
CALL timestart("cdngen: cdnval")
CALL cdnval(eig_id,&
mpi,kpts,jspin,sliceplot,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,obsolete,vTot,oneD,coreSpecInput,&
outDen,regCharges,results,qa21,chmom,clmom)
CALL cdnval(eig_id,mpi,kpts,jspin,sliceplot,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,obsolete,vTot,oneD,coreSpecInput,outDen,regCharges,results,moments)
CALL timestop("cdngen: cdnval")
END DO
......@@ -108,7 +98,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
END IF ! mpi%irank = 0
CALL 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)
IF (sliceplot%slice) THEN
IF (mpi%irank.EQ.0) THEN
......@@ -127,7 +117,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
noco_new = noco
!Calculate and write out spin densities at the nucleus and magnetic moments in the spheres
CALL magMoms(dimension,input,atoms,noco_new,vTot,stdn,svdn,chmom,qa21)
CALL magMoms(dimension,input,atoms,noco_new,vTot,moments)
!Generate and save the new nocoinp file if the directions of the local
!moments are relaxed or a constraint B-field is calculated.
......@@ -135,7 +125,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL genNewNocoInp(input,atoms,noco,noco_new)
END IF
IF (noco%l_soc) CALL orbMagMoms(dimension,atoms,noco,clmom)
IF (noco%l_soc) CALL orbMagMoms(dimension,atoms,noco,moments%clmom)
END IF
END IF ! mpi%irank.EQ.0
......@@ -143,8 +133,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,outDen)
#endif
DEALLOCATE (qa21)
END SUBROUTINE cdngen
END MODULE m_cdngen
......@@ -174,8 +174,20 @@ PRIVATE
PROCEDURE,PASS :: init => regionCharges_init
END TYPE t_regionCharges
TYPE t_moments
PUBLIC t_orb, t_denCoeffs, t_denCoeffsOffdiag, t_force, t_slab, t_eigVecCoeffs, t_mcd, t_regionCharges
REAL, ALLOCATABLE :: chmom(:,:)
REAL, ALLOCATABLE :: clmom(:,:,:)
COMPLEX, ALLOCATABLE :: qa21(:)
REAL, ALLOCATABLE :: stdn(:,:)
REAL, ALLOCATABLE :: svdn(:,:)
CONTAINS
PROCEDURE,PASS :: init => moments_init
END TYPE t_moments
PUBLIC t_orb, t_denCoeffs, t_denCoeffsOffdiag, t_force, t_slab, t_eigVecCoeffs, t_mcd, t_regionCharges, t_moments
CONTAINS
......@@ -643,4 +655,30 @@ SUBROUTINE regionCharges_init(thisRegCharges,input,atoms,dimension,kpts,vacuum)
END SUBROUTINE regionCharges_init
SUBROUTINE moments_init(thisMoments,input,atoms)
USE m_types_setup
IMPLICIT NONE
CLASS(t_moments), INTENT(INOUT) :: thisMoments
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
ALLOCATE(thisMoments%chmom(atoms%ntype,input%jspins))
ALLOCATE(thisMoments%clmom(3,atoms%ntype,input%jspins))
ALLOCATE(thisMoments%qa21(atoms%ntype))
ALLOCATE(thisMoments%stdn(atoms%ntype,input%jspins))
ALLOCATE(thisMoments%svdn(atoms%ntype,input%jspins))
thisMoments%chmom = 0.0
thisMoments%clmom = 0.0
thisMoments%qa21 = CMPLX(0.0,0.0)
thisMoments%stdn = 0.0
thisMoments%svdn = 0.0
END SUBROUTINE moments_init
END MODULE m_types_cdnval
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment