Commit a7d05019 authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents 1301ad69 d3729d47
...@@ -180,9 +180,9 @@ CONTAINS ...@@ -180,9 +180,9 @@ CONTAINS
COMPLEX, ALLOCATABLE :: uunmt21(:,:,:),ddnmt21(:,:,:) COMPLEX, ALLOCATABLE :: uunmt21(:,:,:),ddnmt21(:,:,:)
COMPLEX, ALLOCATABLE :: dunmt21(:,:,:),udnmt21(:,:,:) COMPLEX, ALLOCATABLE :: dunmt21(:,:,:),udnmt21(:,:,:)
COMPLEX, ALLOCATABLE :: qstars(:,:,:,:),m_mcd(:,:,:,:) COMPLEX, ALLOCATABLE :: qstars(:,:,:,:),m_mcd(:,:,:,:)
TYPE (t_orb), ALLOCATABLE :: orb(:,:,:,:)
TYPE (t_orbl), ALLOCATABLE :: orbl(:,:,:,:) TYPE (t_orb) :: orb
TYPE (t_orblo),ALLOCATABLE :: orblo(:,:,:,:,:)
TYPE (t_mt21), ALLOCATABLE :: mt21(:,:) TYPE (t_mt21), ALLOCATABLE :: mt21(:,:)
TYPE (t_lo21), ALLOCATABLE :: lo21(:,:) TYPE (t_lo21), ALLOCATABLE :: lo21(:,:)
TYPE (t_usdus) :: usdus TYPE (t_usdus) :: usdus
...@@ -278,23 +278,7 @@ CONTAINS ...@@ -278,23 +278,7 @@ CONTAINS
svac(:,:) = 0.0 ; pvac(:,:) = 0.0 svac(:,:) = 0.0 ; pvac(:,:) = 0.0
sqal(:,:,:) = 0.0 ; ener(:,:,:) = 0.0 sqal(:,:,:) = 0.0 ; ener(:,:,:) = 0.0
!+soc !+soc
IF (noco%l_soc) THEN CALL orb%init(atoms,noco,jsp_start,jsp_end)
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
!+for !+for
IF (input%l_f) THEN IF (input%l_f) THEN
ALLOCATE ( f_a12(3,atoms%ntype),f_a21(3,atoms%ntype) ) ALLOCATE ( f_a12(3,atoms%ntype),f_a21(3,atoms%ntype) )
...@@ -777,9 +761,8 @@ CONTAINS ...@@ -777,9 +761,8 @@ CONTAINS
CALL timestop("cdnval: rhomt") CALL timestop("cdnval: rhomt")
!+soc !+soc
IF (noco%l_soc) THEN IF (noco%l_soc) THEN
CALL orbmom(atoms,noccbd, we,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),& CALL orbmom(atoms,noccbd, we,ispin,acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
ccof(-atoms%llod:,:,:,:,ispin), orb(0:,-atoms%lmaxd:,:,ispin),orbl(:,-atoms%llod:,:,ispin),& ccof(-atoms%llod:,:,:,:,ispin),orb)
orblo(:,:,-atoms%llod:,:,ispin) )
END IF END IF
! -soc ! -soc
!---> non-spherical m.t. density !---> non-spherical m.t. density
...@@ -898,8 +881,7 @@ CONTAINS ...@@ -898,8 +881,7 @@ CONTAINS
aclo(1,1,ispin),bclo(1,1,ispin),cclo(1,1,1,ispin),& 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),& acnmt(0,1,1,1,ispin),bcnmt(0,1,1,1,ispin),&
ccnmt(1,1,1,1,ispin),enerlo(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),& orb,mt21,lo21,uloulop21,&
orblo(1,1,-atoms%llod,1,ispin),mt21,lo21,uloulop21,&
uunmt21,ddnmt21,udnmt21,dunmt21,den,den%mmpMat(:,:,:,jspin)) uunmt21,ddnmt21,udnmt21,dunmt21,den,den%mmpMat(:,:,:,jspin))
END DO END DO
CALL timestop("cdnval: mpi_col_den") CALL timestop("cdnval: mpi_col_den")
...@@ -937,7 +919,7 @@ CONTAINS ...@@ -937,7 +919,7 @@ CONTAINS
noco,l_fmpl,jsp_start,jsp_end,& noco,l_fmpl,jsp_start,jsp_end,&
enpara%el0,enpara%ello0,vTot%mt(:,0,:,:),uu,du,dd,uunmt,udnmt,dunmt,ddnmt,& enpara%el0,enpara%ello0,vTot%mt(:,0,:,:),uu,du,dd,uunmt,udnmt,dunmt,ddnmt,&
usdus,usdus%uloulopn,aclo,bclo,cclo,acnmt,bcnmt,ccnmt,& 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,& uunmt21,ddnmt21,udnmt21,dunmt21,&
chmom,clmom,& chmom,clmom,&
qa21,den%mt) qa21,den%mt)
......
...@@ -12,7 +12,7 @@ MODULE m_cdnmt ...@@ -12,7 +12,7 @@ MODULE m_cdnmt
CONTAINS CONTAINS
SUBROUTINE cdnmt(jspd,atoms,sphhar,llpd, noco,l_fmpl,jsp_start,jsp_end, epar,& 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,& 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) ddnmt21,udnmt21,dunmt21, chmom,clmom, qa21,rho)
use m_constants,only: sfp_const use m_constants,only: sfp_const
USE m_rhosphnlo USE m_rhosphnlo
...@@ -58,9 +58,7 @@ CONTAINS ...@@ -58,9 +58,7 @@ CONTAINS
REAL, INTENT (OUT) :: chmom(atoms%ntype,jspd),clmom(3,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) REAL, INTENT (INOUT) :: rho(:,0:,:,:)!(toms%jmtd,0:sphhar%nlhd,atoms%ntype,jspd)
COMPLEX, INTENT(INOUT) :: qa21(atoms%ntype) 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_orb), INTENT (IN) :: orb
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_mt21), INTENT (IN) :: mt21(0:atoms%lmaxd,atoms%ntype) TYPE (t_mt21), INTENT (IN) :: mt21(0:atoms%lmaxd,atoms%ntype)
TYPE (t_lo21), INTENT (IN) :: lo21(atoms%nlod,atoms%ntype) TYPE (t_lo21), INTENT (IN) :: lo21(atoms%nlod,atoms%ntype)
! .. ! ..
...@@ -102,7 +100,7 @@ CONTAINS ...@@ -102,7 +100,7 @@ CONTAINS
!$OMP SHARED(usdus,rho,chmom,clmom,qa21,rho21,qmtl) & !$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(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 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) !$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 IF (noco%l_mperp) THEN
...@@ -162,13 +160,9 @@ CONTAINS ...@@ -162,13 +160,9 @@ CONTAINS
!+soc !+soc
!---> spherical angular component !---> spherical angular component
IF (noco%l_soc) THEN IF (noco%l_soc) THEN
CALL orbmom2(& CALL orbmom2(atoms,itype,ispin,usdus%ddn(0,itype,ispin),&
atoms,itype,& orb,usdus%uulon(1,itype,ispin),usdus%dulon(1,itype,ispin),&
usdus%ddn(0,itype,ispin),& uloulopn(1,1,itype,ispin),clmom(1,itype,ispin))!keep
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
ENDIF ENDIF
!-soc !-soc
!---> non-spherical components !---> non-spherical components
......
...@@ -12,7 +12,7 @@ CONTAINS ...@@ -12,7 +12,7 @@ CONTAINS
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,& SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,&
input, noco,l_fmpl,jspin,llpd,rhtxy,rht,qpw,ener,& input, noco,l_fmpl,jspin,llpd,rhtxy,rht,qpw,ener,&
sqal,results,svac,pvac,uu,dd,du,uunmt,ddnmt,udnmt,dunmt,sqlo,& 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) uunmt21,ddnmt21,udnmt21,dunmt21,den,n_mmp)
! !
#include"cpp_double.h" #include"cpp_double.h"
...@@ -61,9 +61,7 @@ CONTAINS ...@@ -61,9 +61,7 @@ CONTAINS
COMPLEX,INTENT(INOUT) :: uunmt21((atoms%lmaxd+1)**2 ) COMPLEX,INTENT(INOUT) :: uunmt21((atoms%lmaxd+1)**2 )
COMPLEX,INTENT(INOUT) :: uloulop21(atoms%nlod,atoms%nlod,atoms%ntype) 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) 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_orb), INTENT (INOUT) :: orb
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_mt21), INTENT (INOUT) :: mt21(0:atoms%lmaxd,atoms%ntype) TYPE (t_mt21), INTENT (INOUT) :: mt21(0:atoms%lmaxd,atoms%ntype)
TYPE (t_lo21), INTENT (INOUT) :: lo21(atoms%nlod,atoms%ntype) TYPE (t_lo21), INTENT (INOUT) :: lo21(atoms%nlod,atoms%ntype)
! .. ! ..
...@@ -260,84 +258,82 @@ CONTAINS ...@@ -260,84 +258,82 @@ CONTAINS
! orb ! orb
n=(atoms%lmaxd+1)*(2*atoms%lmaxd+1)*atoms%ntype n=(atoms%lmaxd+1)*(2*atoms%lmaxd+1)*atoms%ntype
ALLOCATE (r_b(n)) 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 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 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 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 ENDIF
DEALLOCATE (r_b) DEALLOCATE (r_b)
ALLOCATE (c_b(n)) 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 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 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 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 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 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 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 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 ENDIF
DEALLOCATE (c_b) DEALLOCATE (c_b)
! orbl
!
n = atoms%nlod * (2*atoms%llod+1) * atoms%ntype n = atoms%nlod * (2*atoms%llod+1) * atoms%ntype
ALLOCATE (r_b(n)) 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 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 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 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 ENDIF
DEALLOCATE (r_b) DEALLOCATE (r_b)
ALLOCATE (c_b(n)) 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 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 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 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 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 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 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 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 ENDIF
DEALLOCATE (c_b) DEALLOCATE (c_b)
! orblo
!
n = atoms%nlod * atoms%nlod * (2*atoms%llod+1) * atoms%ntype n = atoms%nlod * atoms%nlod * (2*atoms%llod+1) * atoms%ntype
ALLOCATE (r_b(n)) 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 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 ENDIF
DEALLOCATE (r_b) DEALLOCATE (r_b)
ALLOCATE (c_b(n)) 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 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 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 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 ENDIF
DEALLOCATE (c_b) DEALLOCATE (c_b)
......
...@@ -6,7 +6,7 @@ MODULE m_orbmom ...@@ -6,7 +6,7 @@ MODULE m_orbmom
! *************************************************************** ! ***************************************************************
CONTAINS 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, ONLY : t_orb,t_orbl,t_orblo
USE m_types USE m_types
...@@ -14,17 +14,15 @@ CONTAINS ...@@ -14,17 +14,15 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne INTEGER, INTENT (IN) :: ne, ispin
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
COMPLEX, INTENT (IN) :: acof(:,0:,:) !(nobd,0:dimension%lmd,atoms%nat) 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) :: bcof(:,0:,:) !(nobd,0:dimension%lmd,atoms%nat)
COMPLEX, INTENT (IN) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:llod,nobd,atoms%nlod,atoms%nat) COMPLEX, INTENT (IN) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:llod,nobd,atoms%nlod,atoms%nat)
REAL, INTENT (IN) :: we(:)!(nobd) REAL, INTENT (IN) :: we(:)!(nobd)
TYPE (t_orb), INTENT (INOUT) :: orb(0:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,atoms%ntype) TYPE (t_orb), INTENT (INOUT) :: orb
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)
! ..
! .. Local Scalars .. ! .. Local Scalars ..
INTEGER i,l,lm ,n,na,natom,ilo,ilop,m INTEGER i,l,lm ,n,na,natom,ilo,ilop,m
COMPLEX,PARAMETER:: czero= CMPLX(0.0,0.0) COMPLEX,PARAMETER:: czero= CMPLX(0.0,0.0)
...@@ -41,23 +39,23 @@ CONTAINS ...@@ -41,23 +39,23 @@ CONTAINS
! -----> sum over occupied bands ! -----> sum over occupied bands
DO i = 1,ne DO i = 1,ne
! coeff. for lz -> ! 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%uu(l,m,n,ispin) = orb%uu(l,m,n,ispin) + 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%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 -> ! coeff. for l+ <M'|l+|M> with respect to M ->
IF (m.NE.l) THEN 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%uup(l,m,n,ispin) = orb%uup(l,m,n,ispin) + 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%ddp(l,m,n,ispin) = orb%ddp(l,m,n,ispin) + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm+1,natom))
ELSE ELSE
orb(l,m,n)%uup = czero orb%uup(l,m,n,ispin) = czero
orb(l,m,n)%ddp = czero orb%ddp(l,m,n,ispin) = czero
ENDIF ENDIF
! coeff. for l- <M'|l-|M> with respect to M -> ! coeff. for l- <M'|l-|M> with respect to M ->
IF (m.NE.-l) THEN 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%uum(l,m,n,ispin) = orb%uum(l,m,n,ispin) + 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%ddm(l,m,n,ispin) = orb%ddm(l,m,n,ispin) + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm-1,natom))
ELSE ELSE
orb(l,m,n)%uum = czero orb%uum(l,m,n,ispin) = czero
orb(l,m,n)%ddm = czero orb%ddm(l,m,n,ispin) = czero
ENDIF ENDIF
ENDDO ENDDO
ENDDO ENDDO
...@@ -70,33 +68,33 @@ CONTAINS ...@@ -70,33 +68,33 @@ CONTAINS
DO m = -l, l DO m = -l, l
lm = l* (l+1) + m lm = l* (l+1) + m
DO i = 1,ne 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)) +& acof(i,lm,natom)* CONJG(ccof(m,i,ilo,natom)) +&
ccof(m,i,ilo,natom)* CONJG(acof(i,lm,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)) +& bcof(i,lm,natom)* CONJG(ccof(m,i,ilo,natom)) +&
ccof(m,i,ilo,natom)* CONJG(bcof(i,lm,natom)) ) ccof(m,i,ilo,natom)* CONJG(bcof(i,lm,natom)) )
IF (m.NE.l) THEN 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))+& acof(i,lm,natom)* CONJG(ccof(m+1,i,ilo,natom))+&
ccof(m,i,ilo,natom)* CONJG(acof(i,lm+1,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))+& bcof(i,lm,natom)* CONJG(ccof(m+1,i,ilo,natom))+&
ccof(m,i,ilo,natom)* CONJG(bcof(i,lm+1,natom))) ccof(m,i,ilo,natom)* CONJG(bcof(i,lm+1,natom)))
ELSE ELSE
orbl(ilo,m,n)%uulop = czero orb%uulop(ilo,m,n,ispin) = czero
orbl(ilo,m,n)%dulop = czero orb%dulop(ilo,m,n,ispin) = czero
ENDIF ENDIF
IF (m.NE.-l) THEN 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))+& acof(i,lm,natom)* CONJG(ccof(m-1,i,ilo,natom))+&
ccof(m,i,ilo,natom)* CONJG(acof(i,lm-1,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))+& bcof(i,lm,natom)* CONJG(ccof(m-1,i,ilo,natom))+&
ccof(m,i,ilo,natom)* CONJG(bcof(i,lm-1,natom))) ccof(m,i,ilo,natom)* CONJG(bcof(i,lm-1,natom)))
ELSE ELSE
orbl(ilo,m,n)%uulom = czero orb%uulom(ilo,m,n,ispin) = czero
orbl(ilo,m,n)%dulom = czero orb%dulom(ilo,m,n,ispin) = czero
ENDIF ENDIF
ENDDO ! sum over eigenstates (i) ENDDO ! sum over eigenstates (i)
ENDDO ! loop over m ENDDO ! loop over m
...@@ -107,19 +105,19 @@ CONTAINS ...@@ -107,19 +105,19 @@ CONTAINS
IF (atoms%llo(ilop,n).EQ.l) THEN IF (atoms%llo(ilop,n).EQ.l) THEN
DO m = -l, l DO m = -l, l
DO i = 1,ne 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) ) we(i) * ccof(m,i,ilo, natom) * CONJG( ccof(m,i,ilop,natom) )
IF (m.NE.l) THEN 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) ) we(i) * ccof(m, i,ilo, natom) * CONJG( ccof(m+1,i,ilop,natom) )
ELSE ELSE
orblo(ilo,ilop,m,n)%p = czero orb%p(ilo,ilop,m,n,ispin) = czero
ENDIF ENDIF
IF (m.NE.-l) THEN 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) ) we(i) * ccof(m, i,ilo, natom) * CONJG( ccof(m-1,i,ilop,natom) )
ELSE ELSE
orblo(ilo,ilop,m,n)%m = czero orb%m(ilo,ilop,m,n,ispin) = czero
ENDIF ENDIF
ENDDO ! sum over eigenstates (i) ENDDO ! sum over eigenstates (i)
ENDDO ! loop over m ENDDO ! loop over m
......
...@@ -5,8 +5,7 @@ MODULE m_orbmom2 ...@@ -5,8 +5,7 @@ MODULE m_orbmom2
! *************************************************************** ! ***************************************************************
! !
CONTAINS CONTAINS
SUBROUTINE orbmom2(atoms,itype,ddn,orb, & SUBROUTINE orbmom2(atoms,itype,ispin,ddn,orb,uulon,dulon,uloulopn,clmom)
uulon,dulon,uloulopn,orbl,orblo, clmom)
! USE m_types, ONLY : t_orb,t_orbl,t_orblo ! USE m_types, ONLY : t_orb,t_orbl,t_orblo
USE m_types USE m_types
...@@ -15,14 +14,12 @@ CONTAINS ...@@ -15,14 +14,12 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
! ..