Skip to content

fleur
fleur
Commit 8ee7d48f authored by Gregor Michalicek's avatar Gregor Michalicek
Browse files
Options

Introduce t_regionCharges type to cdn/cdnval.F90

parent e89fd760
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 156 additions and 149 deletions
cdn/cdnval.F90
View file @ 8ee7d48f
This diff is collapsed.
cdn/eparas.f90
View file @ 8ee7d48f
......@@ -24,14 +24,15 @@ MODULE m_eparas
!
CONTAINS
SUBROUTINE eparas(jsp,atoms,noccbd, mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
usdus,mcd,l_mcd,enerlo,sqlo,ener,sqal,qal)
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_mcd),INTENT(INOUT) :: mcd
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
......@@ -41,9 +42,6 @@ CONTAINS
! .. Array Arguments ..
REAL, INTENT (IN) :: eig(:)!(dimension%neigd),
REAL, INTENT (IN) :: we(noccbd)
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)
! ..
! .. Local Scalars ..
......@@ -64,11 +62,11 @@ CONTAINS
IF (l_mcd) THEN
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
......@@ -111,7 +109,7 @@ CONTAINS
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
......@@ -124,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
......@@ -178,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
......
cdn/qal_21.f90
View file @ 8ee7d48f
......@@ -5,23 +5,24 @@ MODULE m_qal21
!***********************************************************************
!
CONTAINS
SUBROUTINE qal_21(atoms,input,noccbd,we,noco,eigVecCoeffs,denCoeffsOffdiag,qal,qmat)
SUBROUTINE qal_21(atoms,input,noccbd,we,noco,eigVecCoeffs,denCoeffsOffdiag,regCharges,qmat)
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_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 (INout) :: we(noccbd)
REAL, INTENT (OUT) :: qmat(0:,:,:,:)!(0:3,atoms%ntype,DIMENSION%neigd,4)
TYPE (t_denCoeffsOffdiag), INTENT (IN) :: denCoeffsOffdiag
! ..
! .. Local Scalars ..
......@@ -153,11 +154,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)
......
main/cdngen.F90
View file @ 8ee7d48f
......@@ -76,7 +76,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
!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)
REAL ,ALLOCATABLE :: qvac(:,:,:,:),qvlay(:,:,:,:,:)
REAL ,ALLOCATABLE :: qvlay(:,:,:,:,:)
COMPLEX,ALLOCATABLE :: qa21(:)
IF (mpi%irank.EQ.0) THEN
......@@ -84,12 +84,10 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
IF (l_enpara) OPEN (40,file ='enpara',form = 'formatted',status ='unknown')
ENDIF
ALLOCATE (qa21(atoms%ntype))
ALLOCATE (qvac(dimension%neigd,2,kpts%nkpt,dimension%jspd))
ALLOCATE (qvlay(dimension%neigd,vacuum%layerd,2,kpts%nkpt,dimension%jspd))
!initialize density arrays with zero
qa21(:) = cmplx(0.0,0.0)
qvac(:,:,:,:) = 0.0
qvlay(:,:,:,:,:) = 0.0
IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('valenceDensity')
......@@ -105,7 +103,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL cdnval(eig_id,&
mpi,kpts,jspin,sliceplot,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,obsolete,vTot,oneD,coreSpecInput,&
outDen,results,qvac,qvlay,qa21,chmom,clmom)
outDen,results,qvlay,qa21,chmom,clmom)
CALL timestop("cdngen: cdnval")
END DO
......@@ -151,7 +149,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,outDen)
#endif
DEALLOCATE (qvac,qvlay,qa21)
DEALLOCATE (qvlay,qa21)
END SUBROUTINE cdngen
......
mpi/mpi_col_den.F90
View file @ 8ee7d48f
......@@ -10,11 +10,9 @@ MODULE m_mpi_col_den
!
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,denCoeffs,sqlo,&
enerlo,orb,&
denCoeffsOffdiag,den,n_mmp)
!
input, noco,l_fmpl,jspin,llpd,rhtxy,rht,qpw,regCharges,&
results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp)
#include"cpp_double.h"
USE m_types
USE m_constants
......@@ -39,14 +37,12 @@ CONTAINS
! .. Array Arguments ..
COMPLEX, INTENT (INOUT) :: qpw(stars%ng3)
COMPLEX, INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2)
REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2)
REAL, INTENT (INOUT) :: ener(0:3,atoms%ntype),sqal(0:3,atoms%ntype)
REAL, INTENT (INOUT) :: svac(2),pvac(2)
REAL, INTENT (INOUT) :: sqlo(atoms%nlod,atoms%ntype),enerlo(atoms%nlod,atoms%ntype)
REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2)
COMPLEX,INTENT(INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
TYPE (t_orb), INTENT(INOUT) :: orb
TYPE (t_denCoeffs), INTENT(INOUT) :: denCoeffs
TYPE (t_denCoeffsOffdiag), INTENT(INOUT) :: denCoeffsOffdiag
TYPE (t_regionCharges), INTENT(INOUT) :: regCharges
! ..
! .. Local Scalars ..
INTEGER :: n
......@@ -138,13 +134,13 @@ CONTAINS
!
n=4*atoms%ntype
ALLOCATE(r_b(n))
CALL MPI_REDUCE(ener,r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(regCharges%ener(0:,:,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, ener, 1)
CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%ener(0:,:,jspin), 1)
ENDIF
CALL MPI_REDUCE(sqal,r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(regCharges%sqal(0:,:,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, sqal, 1)
CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%sqal(0:,:,jspin), 1)
ENDIF
DEALLOCATE (r_b)
!
......@@ -154,13 +150,13 @@ CONTAINS
n=2
ALLOCATE(r_b(n))
CALL MPI_REDUCE(svac,r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(regCharges%svac(:,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, svac, 1)
CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%svac(:,jspin), 1)
ENDIF
CALL MPI_REDUCE(pvac,r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(regCharges%pvac(:,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, pvac, 1)
CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%pvac(:,jspin), 1)
ENDIF
DEALLOCATE (r_b)
......@@ -194,13 +190,13 @@ CONTAINS
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, denCoeffs%bclo(:,:,jspin), 1)
ENDIF
CALL MPI_REDUCE(enerlo,r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(regCharges%enerlo(:,:,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, enerlo, 1)
CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%enerlo(:,:,jspin), 1)
ENDIF
CALL MPI_REDUCE(sqlo,r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(regCharges%sqlo(:,:,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, sqlo, 1)
CALL CPP_BLAS_scopy(n, r_b, 1, regCharges%sqlo(:,:,jspin), 1)
ENDIF
DEALLOCATE (r_b)
......
types/types_cdnval.f90
View file @ 8ee7d48f
......@@ -154,7 +154,27 @@ PRIVATE
PROCEDURE,PASS :: init1 => mcd_init1
END TYPE t_mcd
PUBLIC t_orb, t_denCoeffs, t_denCoeffsOffdiag, t_force, t_slab, t_eigVecCoeffs, t_mcd
TYPE t_regionCharges
REAL, ALLOCATABLE :: qis(:,:,:)
REAL, ALLOCATABLE :: qal(:,:,:,:)
REAL, ALLOCATABLE :: sqal(:,:,:)
REAL, ALLOCATABLE :: ener(:,:,:)
REAL, ALLOCATABLE :: sqlo(:,:,:)
REAL, ALLOCATABLE :: enerlo(:,:,:)
REAL, ALLOCATABLE :: qvac(:,:,:,:)
REAL, ALLOCATABLE :: svac(:,:)
REAL, ALLOCATABLE :: pvac(:,:)
CONTAINS
PROCEDURE,PASS :: init => regionCharges_init
END TYPE t_regionCharges
PUBLIC t_orb, t_denCoeffs, t_denCoeffsOffdiag, t_force, t_slab, t_eigVecCoeffs, t_mcd, t_regionCharges
CONTAINS
......@@ -578,5 +598,46 @@ SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms)
END SUBROUTINE mcd_init1
SUBROUTINE regionCharges_init(thisRegCharges,atoms,dimension,kpts,jsp_start,jsp_end)
USE m_types_setup
USE m_types_kpts
IMPLICIT NONE
CLASS(t_regionCharges), INTENT(INOUT) :: thisRegCharges
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_kpts), INTENT(IN) :: kpts
INTEGER, INTENT(IN) :: jsp_start
INTEGER, INTENT(IN) :: jsp_end
ALLOCATE(thisRegCharges%qis(dimension%neigd,kpts%nkpt,dimension%jspd))
ALLOCATE(thisRegCharges%qal(0:3,atoms%ntype,dimension%neigd,jsp_start:jsp_end))
ALLOCATE(thisRegCharges%sqal(0:3,atoms%ntype,jsp_start:jsp_end))
ALLOCATE(thisRegCharges%ener(0:3,atoms%ntype,jsp_start:jsp_end))
ALLOCATE(thisRegCharges%sqlo(atoms%nlod,atoms%ntype,jsp_start:jsp_end))
ALLOCATE(thisRegCharges%enerlo(atoms%nlod,atoms%ntype,jsp_start:jsp_end))
ALLOCATE(thisRegCharges%qvac(dimension%neigd,2,kpts%nkpt,dimension%jspd))
ALLOCATE(thisRegCharges%svac(2,jsp_start:jsp_end))
ALLOCATE(thisRegCharges%pvac(2,jsp_start:jsp_end))
thisRegCharges%qis = 0.0
thisRegCharges%qal = 0.0
thisRegCharges%sqal = 0.0
thisRegCharges%ener = 0.0
thisRegCharges%sqlo = 0.0
thisRegCharges%enerlo = 0.0
thisRegCharges%qvac = 0.0
thisRegCharges%svac = 0.0
thisRegCharges%pvac = 0.0
END SUBROUTINE regionCharges_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