Commit d3729d47 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce new t_orb type in cdn/cdnval.F90

parent 56f2806b
......@@ -180,9 +180,9 @@ CONTAINS
COMPLEX, ALLOCATABLE :: uunmt21(:,:,:),ddnmt21(:,:,:)
COMPLEX, ALLOCATABLE :: dunmt21(:,:,:),udnmt21(:,:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:),m_mcd(:,:,:,:)
TYPE (t_orb), ALLOCATABLE :: orb(:,:,:,:)
TYPE (t_orbl), ALLOCATABLE :: orbl(:,:,:,:)
TYPE (t_orblo),ALLOCATABLE :: orblo(:,:,:,:,:)
TYPE (t_orb) :: orb
TYPE (t_mt21), ALLOCATABLE :: mt21(:,:)
TYPE (t_lo21), ALLOCATABLE :: lo21(:,:)
TYPE (t_usdus) :: usdus
......@@ -278,23 +278,7 @@ CONTAINS
svac(:,:) = 0.0 ; pvac(:,:) = 0.0
sqal(:,:,:) = 0.0 ; ener(:,:,:) = 0.0
!+soc
IF (noco%l_soc) THEN
ALLOCATE ( orb(0:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end) )
ALLOCATE ( orbl(atoms%nlod,-atoms%llod:atoms%llod,atoms%ntype,jsp_start:jsp_end) )
ALLOCATE ( orblo(atoms%nlod,atoms%nlod,-atoms%llod:atoms%llod,atoms%ntype,jsp_start:jsp_end))
orb(:,:,:,:)%uu = 0.0 ; orb(:,:,:,:)%dd = 0.0
orb(:,:,:,:)%uum = czero ; orb(:,:,:,:)%uup = czero
orb(:,:,:,:)%ddm = czero ; orb(:,:,:,:)%ddp = czero
orbl(:,:,:,:)%uulo = 0.0 ; orbl(:,:,:,:)%dulo = 0.0
orbl(:,:,:,:)%uulom = czero ; orbl(:,:,:,:)%uulop = czero
orbl(:,:,:,:)%dulom = czero ; orbl(:,:,:,:)%dulop = czero
orblo(:,:,:,:,:)%z = 0.0
orblo(:,:,:,:,:)%p = czero ; orblo(:,:,:,:,:)%m = czero
ELSE
ALLOCATE ( orb(0:0,-atoms%lmaxd:-atoms%lmaxd,1,jsp_start:jsp_end) )
ALLOCATE ( orbl(1,-atoms%llod:-atoms%llod,1,jsp_start:jsp_end) )
ALLOCATE ( orblo(1,1,-atoms%llod:-atoms%llod,1,jsp_start:jsp_end) )
ENDIF
CALL orb%init(atoms,noco,jsp_start,jsp_end)
!+for
IF (input%l_f) THEN
ALLOCATE ( f_a12(3,atoms%ntype),f_a21(3,atoms%ntype) )
......@@ -777,9 +761,8 @@ CONTAINS
CALL timestop("cdnval: rhomt")
!+soc
IF (noco%l_soc) THEN
CALL orbmom(atoms,noccbd, we,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
ccof(-atoms%llod:,:,:,:,ispin), orb(0:,-atoms%lmaxd:,:,ispin),orbl(:,-atoms%llod:,:,ispin),&
orblo(:,:,-atoms%llod:,:,ispin) )
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
......@@ -898,8 +881,7 @@ CONTAINS
aclo(1,1,ispin),bclo(1,1,ispin),cclo(1,1,1,ispin),&
acnmt(0,1,1,1,ispin),bcnmt(0,1,1,1,ispin),&
ccnmt(1,1,1,1,ispin),enerlo(1,1,ispin),&
orb(0,-atoms%lmaxd,1,ispin),orbl(1,-atoms%llod,1,ispin),&
orblo(1,1,-atoms%llod,1,ispin),mt21,lo21,uloulop21,&
orb,mt21,lo21,uloulop21,&
uunmt21,ddnmt21,udnmt21,dunmt21,den,den%mmpMat(:,:,:,jspin))
END DO
CALL timestop("cdnval: mpi_col_den")
......@@ -937,7 +919,7 @@ CONTAINS
noco,l_fmpl,jsp_start,jsp_end,&
enpara%el0,enpara%ello0,vTot%mt(:,0,:,:),uu,du,dd,uunmt,udnmt,dunmt,ddnmt,&
usdus,usdus%uloulopn,aclo,bclo,cclo,acnmt,bcnmt,ccnmt,&
orb,orbl,orblo,mt21,lo21,uloulopn21,uloulop21,&
orb,mt21,lo21,uloulopn21,uloulop21,&
uunmt21,ddnmt21,udnmt21,dunmt21,&
chmom,clmom,&
qa21,den%mt)
......
......@@ -12,7 +12,7 @@ MODULE m_cdnmt
CONTAINS
SUBROUTINE cdnmt(jspd,atoms,sphhar,llpd, noco,l_fmpl,jsp_start,jsp_end, epar,&
ello,vr,uu,du,dd,uunmt,udnmt,dunmt,ddnmt, usdus,uloulopn,aclo,bclo,cclo,&
acnmt,bcnmt,ccnmt, orb,orbl,orblo,mt21,lo21,uloulopn21,uloulop21, uunmt21,&
acnmt,bcnmt,ccnmt,orb,mt21,lo21,uloulopn21,uloulop21, uunmt21,&
ddnmt21,udnmt21,dunmt21, chmom,clmom, qa21,rho)
use m_constants,only: sfp_const
USE m_rhosphnlo
......@@ -58,9 +58,7 @@ CONTAINS
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(0:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,atoms%ntype,jsp_start:jsp_end)
TYPE (t_orbl), INTENT (IN) :: orbl(atoms%nlod,-atoms%llod:atoms%llod,atoms%ntype,jsp_start:jsp_end)
TYPE (t_orblo),INTENT (IN) :: orblo(atoms%nlod,atoms%nlod,-atoms%llod:atoms%llod,atoms%ntype,jsp_start:jsp_end)
TYPE (t_orb), INTENT (IN) :: orb
TYPE (t_mt21), INTENT (IN) :: mt21(0:atoms%lmaxd,atoms%ntype)
TYPE (t_lo21), INTENT (IN) :: lo21(atoms%nlod,atoms%ntype)
! ..
......@@ -102,7 +100,7 @@ CONTAINS
!$OMP SHARED(usdus,rho,chmom,clmom,qa21,rho21,qmtl) &
!$OMP SHARED(atoms,jsp_start,jsp_end,epar,vr,uu,dd,du,sphhar,uloulopn,ello,aclo,bclo,cclo) &
!$OMP SHARED(acnmt,bcnmt,ccnmt,orb,orbl,orblo,ddnmt,udnmt,dunmt,uunmt,mt21,lo21,uloulop21)&
!$OMP SHARED(acnmt,bcnmt,ccnmt,orb,ddnmt,udnmt,dunmt,uunmt,mt21,lo21,uloulop21)&
!$OMP SHARED(uloulopn21,noco,l_fmpl,uunmt21,ddnmt21,dunmt21,udnmt21,jspd)&
!$OMP PRIVATE(itype,na,ispin,l,f,g,nodeu,noded,wronk,i,j,s,qmtllo,qmtt,nd,lh,lp,llp,cs)
IF (noco%l_mperp) THEN
......@@ -162,13 +160,9 @@ CONTAINS
!+soc
!---> spherical angular component
IF (noco%l_soc) THEN
CALL orbmom2(&
atoms,itype,&
usdus%ddn(0,itype,ispin),&
orb(0,-atoms%lmaxd,itype,ispin),usdus%uulon(1,itype,ispin),&
usdus%dulon(1,itype,ispin),uloulopn(1,1,itype,ispin),&
orbl(1,-atoms%llod,itype,ispin),orblo(1,1,-atoms%llod,itype,ispin),&
clmom(1,itype,ispin))!keep
CALL orbmom2(atoms,itype,ispin,usdus%ddn(0,itype,ispin),&
orb,usdus%uulon(1,itype,ispin),usdus%dulon(1,itype,ispin),&
uloulopn(1,1,itype,ispin),clmom(1,itype,ispin))!keep
ENDIF
!-soc
!---> non-spherical components
......
......@@ -12,7 +12,7 @@ CONTAINS
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,&
input, noco,l_fmpl,jspin,llpd,rhtxy,rht,qpw,ener,&
sqal,results,svac,pvac,uu,dd,du,uunmt,ddnmt,udnmt,dunmt,sqlo,&
aclo,bclo,cclo,acnmt,bcnmt,ccnmt,enerlo,orb,orbl,orblo,mt21,lo21,uloulop21,&
aclo,bclo,cclo,acnmt,bcnmt,ccnmt,enerlo,orb,mt21,lo21,uloulop21,&
uunmt21,ddnmt21,udnmt21,dunmt21,den,n_mmp)
!
#include"cpp_double.h"
......@@ -61,9 +61,7 @@ CONTAINS
COMPLEX,INTENT(INOUT) :: uunmt21((atoms%lmaxd+1)**2 )
COMPLEX,INTENT(INOUT) :: uloulop21(atoms%nlod,atoms%nlod,atoms%ntype)
COMPLEX,INTENT(INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
TYPE (t_orb), INTENT (INOUT) :: orb(0:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,atoms%ntype)
TYPE (t_orbl), INTENT (INOUT) :: orbl(atoms%nlod,-atoms%llod:atoms%llod,atoms%ntype)
TYPE (t_orblo),INTENT (INOUT) :: orblo(atoms%nlod,atoms%nlod,-atoms%llod:atoms%llod,atoms%ntype)
TYPE (t_orb), INTENT (INOUT) :: orb
TYPE (t_mt21), INTENT (INOUT) :: mt21(0:atoms%lmaxd,atoms%ntype)
TYPE (t_lo21), INTENT (INOUT) :: lo21(atoms%nlod,atoms%ntype)
! ..
......@@ -260,84 +258,82 @@ CONTAINS
! orb
n=(atoms%lmaxd+1)*(2*atoms%lmaxd+1)*atoms%ntype
ALLOCATE (r_b(n))
CALL MPI_REDUCE(orb(:,:,:)%uu,r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%uu(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, orb(:,:,:)%uu, 1)
CALL CPP_BLAS_scopy(n, r_b, 1, orb%uu(:,:,:,jspin), 1)
ENDIF
CALL MPI_REDUCE(orb(:,:,:)%dd,r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%dd(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, orb(:,:,:)%dd, 1)
CALL CPP_BLAS_scopy(n, r_b, 1, orb%dd(:,:,:,jspin), 1)
ENDIF
DEALLOCATE (r_b)
ALLOCATE (c_b(n))
CALL MPI_REDUCE(orb(:,:,:)%uup,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%uup(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, orb(:,:,:)%uup, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, orb%uup(:,:,:,jspin), 1)
ENDIF
CALL MPI_REDUCE(orb(:,:,:)%ddp,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%ddp(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, orb(:,:,:)%ddp, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, orb%ddp(:,:,:,jspin), 1)
ENDIF
CALL MPI_REDUCE(orb(:,:,:)%uum,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%uum(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, orb(:,:,:)%uum, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, orb%uum(:,:,:,jspin), 1)
ENDIF
CALL MPI_REDUCE(orb(:,:,:)%ddm,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%ddm(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, orb(:,:,:)%ddm, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, orb%ddm(:,:,:,jspin), 1)
ENDIF
DEALLOCATE (c_b)
! orbl
!
n = atoms%nlod * (2*atoms%llod+1) * atoms%ntype
ALLOCATE (r_b(n))
CALL MPI_REDUCE(orbl(:,:,:)%uulo,r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%uulo(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, orbl(:,:,:)%uulo, 1)
CALL CPP_BLAS_scopy(n, r_b, 1, orb%uulo(:,:,:,jspin), 1)
ENDIF
CALL MPI_REDUCE(orbl(:,:,:)%dulo,r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%dulo(:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, orbl(:,:,:)%dulo, 1)
CALL CPP_BLAS_scopy(n, r_b, 1, orb%dulo(:,:,:,jspin), 1)
ENDIF
DEALLOCATE (r_b)
ALLOCATE (c_b(n))
CALL MPI_REDUCE(orbl(:,:,:)%uulop,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%uulop(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, orbl(:,:,:)%uulop, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, orb%uulop(:,:,:,jspin), 1)
ENDIF
CALL MPI_REDUCE(orbl(:,:,:)%dulop,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%dulop(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, orbl(:,:,:)%dulop, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, orb%dulop(:,:,:,jspin), 1)
ENDIF
CALL MPI_REDUCE(orbl(:,:,:)%uulom,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%uulom(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, orbl(:,:,:)%uulom, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, orb%uulom(:,:,:,jspin), 1)
ENDIF
CALL MPI_REDUCE(orbl(:,:,:)%dulom,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%dulom(:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, orbl(:,:,:)%dulom, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, orb%dulom(:,:,:,jspin), 1)
ENDIF
DEALLOCATE (c_b)
! orblo
!
n = atoms%nlod * atoms%nlod * (2*atoms%llod+1) * atoms%ntype
ALLOCATE (r_b(n))
CALL MPI_REDUCE(orblo(:,:,:,:)%z,r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%z(:,:,:,:,jspin),r_b,n,CPP_MPI_REAL, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, orblo(:,:,:,:)%z, 1)
CALL CPP_BLAS_scopy(n, r_b, 1, orb%z(:,:,:,:,jspin), 1)
ENDIF
DEALLOCATE (r_b)
ALLOCATE (c_b(n))
CALL MPI_REDUCE(orblo(:,:,:,:)%p,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%p(:,:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, orblo(:,:,:,:)%p, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, orb%p(:,:,:,:,jspin), 1)
ENDIF
CALL MPI_REDUCE(orblo(:,:,:,:)%m,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(orb%m(:,:,:,:,jspin),c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, orblo(:,:,:,:)%m, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, orb%m(:,:,:,:,jspin), 1)
ENDIF
DEALLOCATE (c_b)
......
......@@ -6,7 +6,7 @@ MODULE m_orbmom
! ***************************************************************
CONTAINS
SUBROUTINE orbmom(atoms,ne,we,acof,bcof, ccof, orb,orbl,orblo)
SUBROUTINE orbmom(atoms,ne,we,ispin,acof,bcof, ccof, orb)
!USE m_types, ONLY : t_orb,t_orbl,t_orblo
USE m_types
......@@ -14,17 +14,15 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne
INTEGER, INTENT (IN) :: ne, ispin
! ..
! .. Array Arguments ..
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 (IN) :: we(:)!(nobd)
TYPE (t_orb), INTENT (INOUT) :: orb(0:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,atoms%ntype)
TYPE (t_orbl), INTENT (INOUT) :: orbl(atoms%nlod,-atoms%llod:atoms%llod,atoms%ntype)
TYPE (t_orblo),INTENT (INOUT) :: orblo(atoms%nlod,atoms%nlod,-atoms%llod:atoms%llod,atoms%ntype)
! ..
TYPE (t_orb), INTENT (INOUT) :: orb
! .. Local Scalars ..
INTEGER i,l,lm ,n,na,natom,ilo,ilop,m
COMPLEX,PARAMETER:: czero= CMPLX(0.0,0.0)
......@@ -41,23 +39,23 @@ CONTAINS
! -----> sum over occupied bands
DO i = 1,ne
! coeff. for lz ->
orb(l,m,n)%uu = orb(l,m,n)%uu + we(i)*acof(i,lm,natom)* CONJG(acof(i,lm,natom))
orb(l,m,n)%dd = orb(l,m,n)%dd + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm,natom))
orb%uu(l,m,n,ispin) = orb%uu(l,m,n,ispin) + we(i)*acof(i,lm,natom)* CONJG(acof(i,lm,natom))
orb%dd(l,m,n,ispin) = orb%dd(l,m,n,ispin) + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm,natom))
! coeff. for l+ <M'|l+|M> with respect to M ->
IF (m.NE.l) THEN
orb(l,m,n)%uup = orb(l,m,n)%uup + we(i)*acof(i,lm,natom)* CONJG(acof(i,lm+1,natom))
orb(l,m,n)%ddp = orb(l,m,n)%ddp + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm+1,natom))
orb%uup(l,m,n,ispin) = orb%uup(l,m,n,ispin) + we(i)*acof(i,lm,natom)* CONJG(acof(i,lm+1,natom))
orb%ddp(l,m,n,ispin) = orb%ddp(l,m,n,ispin) + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm+1,natom))
ELSE
orb(l,m,n)%uup = czero
orb(l,m,n)%ddp = czero
orb%uup(l,m,n,ispin) = czero
orb%ddp(l,m,n,ispin) = czero
ENDIF
! coeff. for l- <M'|l-|M> with respect to M ->
IF (m.NE.-l) THEN
orb(l,m,n)%uum = orb(l,m,n)%uum + we(i)*acof(i,lm,natom)* CONJG(acof(i,lm-1,natom))
orb(l,m,n)%ddm = orb(l,m,n)%ddm + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm-1,natom))
orb%uum(l,m,n,ispin) = orb%uum(l,m,n,ispin) + we(i)*acof(i,lm,natom)* CONJG(acof(i,lm-1,natom))
orb%ddm(l,m,n,ispin) = orb%ddm(l,m,n,ispin) + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm-1,natom))
ELSE
orb(l,m,n)%uum = czero
orb(l,m,n)%ddm = czero
orb%uum(l,m,n,ispin) = czero
orb%ddm(l,m,n,ispin) = czero
ENDIF
ENDDO
ENDDO
......@@ -70,33 +68,33 @@ CONTAINS
DO m = -l, l
lm = l* (l+1) + m
DO i = 1,ne
orbl(ilo,m,n)%uulo = orbl(ilo,m,n)%uulo + we(i) * (&
orb%uulo(ilo,m,n,ispin) = orb%uulo(ilo,m,n,ispin) + we(i) * (&
acof(i,lm,natom)* CONJG(ccof(m,i,ilo,natom)) +&
ccof(m,i,ilo,natom)* CONJG(acof(i,lm,natom)) )
orbl(ilo,m,n)%dulo = orbl(ilo,m,n)%dulo + we(i) * (&
orb%dulo(ilo,m,n,ispin) = orb%dulo(ilo,m,n,ispin) + we(i) * (&
bcof(i,lm,natom)* CONJG(ccof(m,i,ilo,natom)) +&
ccof(m,i,ilo,natom)* CONJG(bcof(i,lm,natom)) )
IF (m.NE.l) THEN
orbl(ilo,m,n)%uulop = orbl(ilo,m,n)%uulop + we(i) *(&
orb%uulop(ilo,m,n,ispin) = orb%uulop(ilo,m,n,ispin) + we(i) *(&
acof(i,lm,natom)* CONJG(ccof(m+1,i,ilo,natom))+&
ccof(m,i,ilo,natom)* CONJG(acof(i,lm+1,natom)))
orbl(ilo,m,n)%dulop = orbl(ilo,m,n)%dulop + we(i) *(&
orb%dulop(ilo,m,n,ispin) = orb%dulop(ilo,m,n,ispin) + we(i) *(&
bcof(i,lm,natom)* CONJG(ccof(m+1,i,ilo,natom))+&
ccof(m,i,ilo,natom)* CONJG(bcof(i,lm+1,natom)))
ELSE
orbl(ilo,m,n)%uulop = czero
orbl(ilo,m,n)%dulop = czero
orb%uulop(ilo,m,n,ispin) = czero
orb%dulop(ilo,m,n,ispin) = czero
ENDIF
IF (m.NE.-l) THEN
orbl(ilo,m,n)%uulom = orbl(ilo,m,n)%uulom + we(i) *(&
orb%uulom(ilo,m,n,ispin) = orb%uulom(ilo,m,n,ispin) + we(i) *(&
acof(i,lm,natom)* CONJG(ccof(m-1,i,ilo,natom))+&
ccof(m,i,ilo,natom)* CONJG(acof(i,lm-1,natom)))
orbl(ilo,m,n)%dulom = orbl(ilo,m,n)%dulom + we(i) *(&
orb%dulom(ilo,m,n,ispin) = orb%dulom(ilo,m,n,ispin) + we(i) *(&
bcof(i,lm,natom)* CONJG(ccof(m-1,i,ilo,natom))+&
ccof(m,i,ilo,natom)* CONJG(bcof(i,lm-1,natom)))
ELSE
orbl(ilo,m,n)%uulom = czero
orbl(ilo,m,n)%dulom = czero
orb%uulom(ilo,m,n,ispin) = czero
orb%dulom(ilo,m,n,ispin) = czero
ENDIF
ENDDO ! sum over eigenstates (i)
ENDDO ! loop over m
......@@ -107,19 +105,19 @@ CONTAINS
IF (atoms%llo(ilop,n).EQ.l) THEN
DO m = -l, l
DO i = 1,ne
orblo(ilo,ilop,m,n)%z = orblo(ilo,ilop,m,n)%z +&
orb%z(ilo,ilop,m,n,ispin) = orb%z(ilo,ilop,m,n,ispin) +&
we(i) * ccof(m,i,ilo, natom) * CONJG( ccof(m,i,ilop,natom) )
IF (m.NE.l) THEN
orblo(ilo,ilop,m,n)%p = orblo(ilo,ilop,m,n)%p +&
orb%p(ilo,ilop,m,n,ispin) = orb%p(ilo,ilop,m,n,ispin) +&
we(i) * ccof(m, i,ilo, natom) * CONJG( ccof(m+1,i,ilop,natom) )
ELSE
orblo(ilo,ilop,m,n)%p = czero
orb%p(ilo,ilop,m,n,ispin) = czero
ENDIF
IF (m.NE.-l) THEN
orblo(ilo,ilop,m,n)%m = orblo(ilo,ilop,m,n)%m +&
orb%m(ilo,ilop,m,n,ispin) = orb%m(ilo,ilop,m,n,ispin) +&
we(i) * ccof(m, i,ilo, natom) * CONJG( ccof(m-1,i,ilop,natom) )
ELSE
orblo(ilo,ilop,m,n)%m = czero
orb%m(ilo,ilop,m,n,ispin) = czero
ENDIF
ENDDO ! sum over eigenstates (i)
ENDDO ! loop over m
......
......@@ -5,8 +5,7 @@ MODULE m_orbmom2
! ***************************************************************
!
CONTAINS
SUBROUTINE orbmom2(atoms,itype,ddn,orb, &
uulon,dulon,uloulopn,orbl,orblo, clmom)
SUBROUTINE orbmom2(atoms,itype,ispin,ddn,orb,uulon,dulon,uloulopn,clmom)
! USE m_types, ONLY : t_orb,t_orbl,t_orblo
USE m_types
......@@ -15,14 +14,12 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: itype
INTEGER, INTENT (IN) :: itype, ispin
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: ddn(0:atoms%lmaxd),uulon(atoms%nlod),dulon(atoms%nlod)
REAL, INTENT (IN) :: uloulopn(atoms%nlod,atoms%nlod)
TYPE (t_orb), INTENT (IN) :: orb(0:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd)
TYPE (t_orbl), INTENT (IN) :: orbl(atoms%nlod,-atoms%llod:atoms%llod)
TYPE (t_orblo),INTENT (IN) :: orblo(atoms%nlod,atoms%nlod,-atoms%llod:atoms%llod)
TYPE (t_orb), INTENT (IN) :: orb
REAL, INTENT (OUT) :: clmom(3)
! ..
! .. Local Scalars ..
......@@ -43,11 +40,11 @@ CONTAINS
qmtly(l) = 0.
DO m = -l,l
! lz
sumlm = m * (orb(l,m)%uu + orb(l,m)%dd * ddn(l) )
sumlm = m * (orb%uu(l,m,itype,ispin) + orb%dd(l,m,itype,ispin) * ddn(l) )
! lx,ly
orbp = SQRT(REAL((l-m)*(l+m+1))) * ( orb(l,m)%uup + orb(l,m)%ddp * ddn(l) )
orbp = SQRT(REAL((l-m)*(l+m+1))) * ( orb%uup(l,m,itype,ispin) + orb%ddp(l,m,itype,ispin) * ddn(l) )
orbm = SQRT(REAL((l+m)*(l-m+1))) * ( orb(l,m)%uum + orb(l,m)%ddm * ddn(l) )
orbm = SQRT(REAL((l+m)*(l-m+1))) * ( orb%uum(l,m,itype,ispin) + orb%ddm(l,m,itype,ispin) * ddn(l) )
!+gu
IF (m.EQ.l) orbp = CMPLX(0.0,0.0)
IF (m.EQ.-l) orbm = CMPLX(0.0,0.0)
......@@ -63,13 +60,13 @@ CONTAINS
DO ilo = 1, atoms%nlo(itype)
l = atoms%llo(ilo,itype)
DO m = -l,l
sumlm = m * (orbl(ilo,m)%uulo * uulon(ilo) + orbl(ilo,m)%dulo * dulon(ilo) )
sumlm = m * (orb%uulo(ilo,m,itype,ispin) * uulon(ilo) + orb%dulo(ilo,m,itype,ispin) * dulon(ilo) )
orbp = SQRT(REAL((l-m)*(l+m+1))) * ( orbl(ilo,m)%uulop * uulon(ilo) +&
orbl(ilo,m)%dulop * dulon(ilo) )
orbp = SQRT(REAL((l-m)*(l+m+1))) * ( orb%uulop(ilo,m,itype,ispin) * uulon(ilo) +&
orb%dulop(ilo,m,itype,ispin) * dulon(ilo) )
orbm = SQRT(REAL((l+m)*(l-m+1))) * ( orbl(ilo,m)%uulom * uulon(ilo) +&
orbl(ilo,m)%dulom * dulon(ilo) )
orbm = SQRT(REAL((l+m)*(l-m+1))) * ( orb%uulom(ilo,m,itype,ispin) * uulon(ilo) +&
orb%dulom(ilo,m,itype,ispin) * dulon(ilo) )
IF (m.EQ.l) orbp = CMPLX(0.0,0.0)
IF (m.EQ.-l) orbm = CMPLX(0.0,0.0)
......@@ -81,9 +78,9 @@ CONTAINS
DO ilop = 1, atoms%nlo(itype)
IF (atoms%llo(ilop,itype).EQ.l) THEN
DO m = -l,l
sumlm = m * orblo(ilo,ilop,m)%z * uloulopn(ilo,ilop)
orbp = SQRT(REAL((l-m)*(l+m+1))) * orblo(ilo,ilop,m)%p * uloulopn(ilo,ilop)
orbm = SQRT(REAL((l+m)*(l-m+1))) * orblo(ilo,ilop,m)%m * uloulopn(ilo,ilop)
sumlm = m * orb%z(ilo,ilop,m,itype,ispin) * uloulopn(ilo,ilop)
orbp = SQRT(REAL((l-m)*(l+m+1))) * orb%p(ilo,ilop,m,itype,ispin) * uloulopn(ilo,ilop)
orbm = SQRT(REAL((l+m)*(l-m+1))) * orb%m(ilo,ilop,m,itype,ispin) * uloulopn(ilo,ilop)
IF (m.EQ.l) orbp = CMPLX(0.0,0.0)
IF (m.EQ.-l) orbm = CMPLX(0.0,0.0)
......
......@@ -15,6 +15,7 @@ types/types_kpts.f90
types/types_enpara.F90
types/types_setup.F90
types/types_usdus.F90
types/types_cdnval.f90
)
set(inpgen_F90 ${inpgen_F90}
......@@ -32,4 +33,5 @@ types/types_kpts.f90
types/types_enpara.F90
types/types_setup.F90
types/types_usdus.F90
types/types_cdnval.f90
)
......@@ -20,4 +20,5 @@ MODULE m_types
USE m_types_potden
USE m_types_forcetheo
USE m_types_forcetheo_extended !this is found in directory forcetheorem
USE m_types_cdnval
END MODULE m_types
!--------------------------------------------------------------------------------
! Copyright (c) 2018 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_types_cdnval
IMPLICIT NONE
PRIVATE
TYPE t_orb
REAL, ALLOCATABLE :: uu(:,:,:,:)
REAL, ALLOCATABLE :: dd(:,:,:,:)
COMPLEX, ALLOCATABLE :: uup(:,:,:,:)
COMPLEX, ALLOCATABLE :: uum(:,:,:,:)
COMPLEX, ALLOCATABLE :: ddp(:,:,:,:)
COMPLEX, ALLOCATABLE :: ddm(:,:,:,:)
REAL, ALLOCATABLE :: uulo(:,:,:,:)
REAL, ALLOCATABLE :: dulo(:,:,:,:)
COMPLEX, ALLOCATABLE :: uulop(:,:,:,:)
COMPLEX, ALLOCATABLE :: uulom(:,:,:,:)
COMPLEX, ALLOCATABLE :: dulop(:,:,:,:)
COMPLEX, ALLOCATABLE :: dulom(:,:,:,:)
REAL, ALLOCATABLE :: z(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: p(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: m(:,:,:,:,:)
CONTAINS
PROCEDURE,PASS :: init => orb_init
END TYPE t_orb
PUBLIC t_orb
CONTAINS
SUBROUTINE orb_init(thisOrb, atoms, noco, jsp_start, jsp_end)
USE m_types_setup
IMPLICIT NONE
CLASS(t_orb), INTENT(INOUT) :: thisOrb
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_noco), INTENT(IN) :: noco
INTEGER, INTENT(IN) :: jsp_start
INTEGER, INTENT(IN) :: jsp_end
INTEGER :: dim1, dim2, dim3
IF(ALLOCATED(thisOrb%uu)) DEALLOCATE(thisOrb%uu)
IF(ALLOCATED(thisOrb%dd)) DEALLOCATE(thisOrb%dd)
IF(ALLOCATED(thisOrb%uup)) DEALLOCATE(thisOrb%uup)
IF(ALLOCATED(thisOrb%uum)) DEALLOCATE(thisOrb%uum)
IF(ALLOCATED(thisOrb%ddp)) DEALLOCATE(thisOrb%ddp)
IF(ALLOCATED(thisOrb%ddm)) DEALLOCATE(thisOrb%ddm)
IF(ALLOCATED(thisOrb%uulo)) DEALLOCATE(thisOrb%uulo)
IF(ALLOCATED(thisOrb%dulo)) DEALLOCATE(thisOrb%dulo)
IF(ALLOCATED(thisOrb%uulop)) DEALLOCATE(thisOrb%uulop)
IF(ALLOCATED(thisOrb%uulom)) DEALLOCATE(thisOrb%uulom)
IF(ALLOCATED(thisOrb%dulop)) DEALLOCATE(thisOrb%dulop)
IF(ALLOCATED(thisOrb%dulom)) DEALLOCATE(thisOrb%dulom)
IF(ALLOCATED(thisOrb%z)) DEALLOCATE(thisOrb%z)
IF(ALLOCATED(thisOrb%p)) DEALLOCATE(thisOrb%p)
IF(ALLOCATED(thisOrb%m)) DEALLOCATE(thisOrb%m)
dim1 = 0
dim2 = 1
dim3 = 1
IF (noco%l_soc) THEN
dim1 = atoms%lmaxd
dim2 = atoms%ntype
dim3 = atoms%nlod
END IF
ALLOCATE(thisOrb%uu(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%dd(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%uup(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%uum(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%ddp(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%ddm(0:dim1,-atoms%lmaxd:atoms%lmaxd,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%uulo(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%dulo(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%uulop(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%uulom(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%dulop(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%dulom(dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%z(dim3,dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%p(dim3,dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
ALLOCATE(thisOrb%m(dim3,dim3,-atoms%llod:atoms%llod,dim2,jsp_start:jsp_end))
thisOrb%uu = 0.0
thisOrb%dd = 0.0
thisOrb%uup = CMPLX(0.0,0.0)
thisOrb%uum = CMPLX(0.0,0.0)
thisOrb%ddp = CMPLX(0.0,0.0)
thisOrb%ddm = CMPLX(0.0,0.0)
thisOrb%uulo = 0.0
thisOrb%dulo = 0.0
thisOrb%uulop = CMPLX(0.0,0.0)
thisOrb%uulom = CMPLX(0.0,0.0)
thisOrb%dulop = CMPLX(0.0,0.0)
thisOrb%dulom = CMPLX(0.0,0.0)
thisOrb%z = 0.0
thisOrb%p = CMPLX(0.0,0.0)
thisOrb%m = CMPLX(0.0,0.0)
END SUBROUTINE orb_init
END MODULE m_types_cdnval
......@@ -26,24 +26,6 @@ MODULE m_types_misc
COMPLEX :: uulo,dulo,ulou,ulod ! values
END TYPE t_lo21
TYPE t_orb ! 'normal' contributions