Commit c4fb6bfe authored by Gregor Michalicek's avatar Gregor Michalicek

Eliminate potden%cdom

parent fb3df010
......@@ -64,7 +64,7 @@ CONTAINS
! matrix. This subroutine generates this density matrix in the
! interstitial region. The diagonal elements of this matrix
! (n_11 & n_22) are stored in den%pw, while the real and imaginary part
! of the off-diagonal element are store in den%cdom.
! of the off-diagonal element are store in den%pw(:,3).
!
! Philipp Kurz 99/07
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
......@@ -690,12 +690,12 @@ CONTAINS
ELSE IF (idens.EQ.3) THEN
!---> add to off-diag. part of density matrix (only non-collinear)
DO istr = 1 , stars%ng3_fft
den%cdom(istr) = den%cdom(istr) + cwk(istr)
den%pw(istr,3) = den%pw(istr,3) + cwk(istr)
ENDDO
ELSE
!---> add to off-diag. part of density matrix (only non-collinear)
DO istr = 1 , stars%ng3_fft
den%cdom(istr) = den%cdom(istr) + CMPLX(0.0,1.0)*cwk(istr)
den%pw(istr,3) = den%pw(istr,3) + CMPLX(0.0,1.0)*cwk(istr)
ENDDO
ENDIF
......
......@@ -280,7 +280,7 @@ MODULE m_cdn_io
! read in additional data if l_noco and data is present
IF ((archiveType.EQ.CDN_ARCHIVE_TYPE_NOCO_const).AND.l_rhomatFile) THEN
READ (iUnit,iostat=datend) (den%cdom(k),k=1,stars%ng3)
READ (iUnit,iostat=datend) (den%pw(k,3),k=1,stars%ng3)
IF (datend == 0) THEN
IF (input%film) THEN
ALLOCATE(cdomvz(vacuum%nmz,vacuum%nvac))
......@@ -301,14 +301,14 @@ MODULE m_cdn_io
WRITE(*,*) 'datend = ', datend
CALL juDFT_error("density file has illegal state.",calledby ="readDensity")
END IF
den%cdom = CMPLX(0.0,0.0)
den%pw(:,3) = CMPLX(0.0,0.0)
IF (input%film) THEN
den%vacz(:,:,3:4) = 0.0
den%vacxy(:,:,:,3) = CMPLX(0.0,0.0)
END IF
END IF
ELSE IF (archiveType.EQ.CDN_ARCHIVE_TYPE_NOCO_const) THEN
den%cdom = CMPLX(0.0,0.0)
den%pw(:,3) = CMPLX(0.0,0.0)
IF (input%film) THEN
den%vacz(:,:,3:4) = 0.0
den%vacxy(:,:,:,3) = CMPLX(0.0,0.0)
......@@ -607,7 +607,7 @@ MODULE m_cdn_io
! Write additional data if l_noco
IF (archiveType.EQ.CDN_ARCHIVE_TYPE_NOCO_const) THEN
WRITE (iUnit) (den%cdom(k),k=1,stars%ng3)
WRITE (iUnit) (den%pw(k,3),k=1,stars%ng3)
IF (input%film) THEN
ALLOCATE(cdomvz(vacuum%nmz,vacuum%nvac))
DO iVac = 1, vacuum%nvac
......
......@@ -1705,7 +1705,7 @@ MODULE m_cdnpot_io_hdf
dimsInt(:2)=(/2,ng3/)
CALL h5dopen_f(groupID, 'cdom', cdomSetID, hdfError)
CALL io_write_complex1(cdomSetID,(/-1,1/),dimsInt(:2),den%cdom)
CALL io_write_complex1(cdomSetID,(/-1,1/),dimsInt(:2),den%pw(:,3))
CALL h5dclose_f(cdomSetID, hdfError)
IF (l_film) THEN
......@@ -1784,7 +1784,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(2,dims(:2),cdomSpaceID,hdfError)
CALL h5dcreate_f(groupID, "cdom", H5T_NATIVE_DOUBLE, cdomSpaceID, cdomSetID, hdfError)
CALL h5sclose_f(cdomSpaceID,hdfError)
CALL io_write_complex1(cdomSetID,(/-1,1/),dimsInt(:2),den%cdom)
CALL io_write_complex1(cdomSetID,(/-1,1/),dimsInt(:2),den%pw(:,3))
CALL h5dclose_f(cdomSetID, hdfError)
IF (l_film) THEN
......@@ -1888,7 +1888,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(2,dims(:2),cdomSpaceID,hdfError)
CALL h5dcreate_f(groupID, "cdom", H5T_NATIVE_DOUBLE, cdomSpaceID, cdomSetID, hdfError)
CALL h5sclose_f(cdomSpaceID,hdfError)
CALL io_write_complex1(cdomSetID,(/-1,1/),dimsInt(:2),den%cdom)
CALL io_write_complex1(cdomSetID,(/-1,1/),dimsInt(:2),den%pw(:,3))
CALL h5dclose_f(cdomSetID, hdfError)
IF (l_film) THEN
......@@ -2447,13 +2447,13 @@ MODULE m_cdnpot_io_hdf
IF((localDensityType.EQ.DENSITY_TYPE_NOCO_IN_const).OR.&
(localDensityType.EQ.DENSITY_TYPE_NOCO_OUT_const)) THEN
den%cdom = CMPLX(0.0,0.0)
den%pw(:,3) = CMPLX(0.0,0.0)
ALLOCATE(cdomTemp(ng3))
dimsInt(:2)=(/2,ng3/)
CALL h5dopen_f(groupID, 'cdom', cdomSetID, hdfError)
CALL io_read_complex1(cdomSetID,(/-1,1/),dimsInt(:2),cdomTemp)
CALL h5dclose_f(cdomSetID, hdfError)
den%cdom(1:ng3Out) = cdomTemp(1:ng3Out)
den%pw(1:ng3Out,3) = cdomTemp(1:ng3Out)
DEALLOCATE(cdomTemp)
IF (l_film) THEN
......
......@@ -208,9 +208,9 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
!rho_22
outDen%pw(1,2) = outDen%pw(1,2) + rhoint - momint*cos(noco%beta(ityp))
!real part rho_21
outDen%cdom(1) = outDen%cdom(1) + cmplx(0.5*momint *cos(noco%alph(ityp))*sin(noco%beta(ityp)),0.0)
outDen%pw(1,3) = outDen%pw(1,3) + cmplx(0.5*momint *cos(noco%alph(ityp))*sin(noco%beta(ityp)),0.0)
!imaginary part rho_21
outDen%cdom(1) = outDen%cdom(1) + cmplx(0.0,-0.5*momint *sin(noco%alph(ityp))*sin(noco%beta(ityp)))
outDen%pw(1,3) = outDen%pw(1,3) + cmplx(0.0,-0.5*momint *sin(noco%alph(ityp))*sin(noco%beta(ityp)))
END DO
END IF
!pk non-collinear (end)
......@@ -270,9 +270,9 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
!rho_22
outDen%pw(1,2) = outDen%pw(1,2) + rhoint - momint*cos(noco%beta(ityp))
!real part rho_21
outDen%cdom(1) = outDen%cdom(1) + cmplx(0.5*momint *cos(noco%alph(ityp))*sin(noco%beta(ityp)),0.0)
outDen%pw(1,3) = outDen%pw(1,3) + cmplx(0.5*momint *cos(noco%alph(ityp))*sin(noco%beta(ityp)),0.0)
!imaginary part rho_21
outDen%cdom(1) = outDen%cdom(1) + cmplx(0.0,-0.5*momint *sin(noco%alph(ityp))*sin(noco%beta(ityp)))
outDen%pw(1,3) = outDen%pw(1,3) + cmplx(0.0,-0.5*momint *sin(noco%alph(ityp))*sin(noco%beta(ityp)))
END DO
!pk non-collinear (end)
ELSE
......@@ -304,7 +304,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
!pk non-collinear (start)
IF (noco%l_noco) THEN
!fix also the off-diagonal part of the density matrix
outDen%cdom(:stars%ng3) = fix*outDen%cdom(:stars%ng3)
outDen%pw(:stars%ng3,3) = fix*outDen%pw(:stars%ng3,3)
IF (input%film) THEN
outDen%vacz(:,:,3:4) = fix*outDen%vacz(:,:,3:4)
outDen%vacxy(:,:,:,3) = fix*outDen%vacxy(:,:,:,3)
......@@ -449,7 +449,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
OPEN (20,file='cdn_slice',form='unformatted',status='unknown')
CALL wrtdop(stars,vacuum,atoms,sphhar, input,sym, 20, outDen%iter,outDen%mt,outDen%pw,outDen%vacz,outDen%vacxy)
IF (noco%l_noco) THEN
WRITE (20) (outDen%cdom(k),k=1,stars%ng3)
WRITE (20) (outDen%pw(k,3),k=1,stars%ng3)
IF (input%film) THEN
ALLOCATE(cdomvz(vacuum%nmz,vacuum%nvac))
DO ivac = 1, vacuum%nvac
......
......@@ -494,12 +494,12 @@ CONTAINS
IF ( .NOT.xcpot%is_gga() ) THEN
! LDA
CALL visxc(ifftd,stars,noco,xcpot,input, workDen%pw,workDen%cdom,&
CALL visxc(ifftd,stars,noco,xcpot,input,workDen,&
vTot%pw,vpw_w,vx%pw,vxpw_w, excpw)
ELSE ! GGA
CALL visxcg(ifftd,stars,sym, ifftxc3d, cell, workDen%pw,workDen%cdom, xcpot,input,&
CALL visxcg(ifftd,stars,sym,ifftxc3d,cell,workDen,xcpot,input,&
obsolete,noco, rhmn,ichsmrg, vTot%pw,vpw_w,vx%pw,vxpw_w, excpw)
END IF
......
......@@ -94,11 +94,11 @@ CONTAINS
!---> off-diagonal part of the density matrix
DO i = 1,stars%ng3
j = j + 1
sout(j) = REAL(den%cdom(i))
sout(j) = REAL(den%pw(i,3))
END DO
DO i = 1,stars%ng3
j = j + 1
sout(j) = AIMAG(den%cdom(i))
sout(j) = AIMAG(den%pw(i,3))
END DO
IF (input%film) THEN
DO iv = 1,vacuum%nvac
......
......@@ -29,7 +29,6 @@ CONTAINS
den%mt = 0.0
den%vacz = 0.0
den%vacxy = CMPLX(0.0,0.0)
den%cdom = CMPLX(0.0,0.0)
j=0
DO js = 1,input%jspins
......@@ -83,11 +82,11 @@ CONTAINS
!---> off-diagonal part of the density matrix
DO i = 1,stars%ng3
j = j + 1
den%cdom(i) = CMPLX(s_in(j),0.0)
den%pw(i,3) = CMPLX(s_in(j),0.0)
END DO
DO i = 1,stars%ng3
j = j + 1
den%cdom(i) = den%cdom(i) + CMPLX(0.0,s_in(j))
den%pw(i,3) = den%pw(i,3) + CMPLX(0.0,s_in(j))
END DO
IF (input%film) THEN
DO iv = 1,vacuum%nvac
......
......@@ -32,20 +32,12 @@ CONTAINS
l_denMatAlloc = .FALSE.
l_vaczAlloc = .FALSE.
IF(mpi%irank.EQ.0) THEN
IF (ALLOCATED(potden%cdom)) l_nocoAlloc = .TRUE.
IF (ALLOCATED(potden%mmpMat)) l_denMatAlloc = .TRUE.
IF (ALLOCATED(potden%vacz)) l_vaczAlloc = .TRUE.
END IF
CALL MPI_BCAST(l_nocoAlloc,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(l_denMatAlloc,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(l_vaczAlloc,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
IF((mpi%irank.NE.0).AND.l_nocoAlloc) THEN
IF (noco%l_noco) THEN
IF(.NOT.ALLOCATED(potden%cdom)) ALLOCATE (potden%cdom(stars%ng3))
ELSE
IF(.NOT.ALLOCATED(potden%cdom)) ALLOCATE (potden%cdom(1))
END IF
END IF
IF((mpi%irank.NE.0).AND.l_denMatAlloc) THEN
IF(.NOT.ALLOCATED(potden%mmpMat)) THEN
ALLOCATE(potDen%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u),input%jspins))
......@@ -66,11 +58,6 @@ CONTAINS
CALL MPI_BCAST(potden%vacxy,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
END IF
IF (l_nocoAlloc) THEN
n = SIZE(potden%cdom,1)
CALL MPI_BCAST(potden%cdom,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
END IF
IF (l_denMatAlloc) THEN
n = SIZE(potden%mmpMat,1) * SIZE(potden%mmpMat,2) * SIZE(potden%mmpMat,3) * SIZE(potden%mmpMat,4)
CALL MPI_BCAST(potden%mmpMat,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
......
......@@ -350,9 +350,9 @@ CONTAINS
n = stars%ng3
ALLOCATE(c_b(n))
CALL MPI_REDUCE(den%cdom,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(den%pw(:,3),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, den%cdom, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, den%pw(:,3), 1)
ENDIF
DEALLOCATE (c_b)
!
......
......@@ -310,7 +310,7 @@ SUBROUTINE pldngen(sym,stars,atoms,sphhar,vacuum,&
den%vacz(1:,1:,1:1) = rht(1:,1:,1:1)
den%vacxy(1:,1:,1:,1:1) = rhtxy(1:,1:,1:,1:1)
IF(noco%l_noco) THEN
den%cdom = cdom
den%pw(:,3) = cdom
den%vacz(:,:,3) = REAL(cdomvz(:,:))
den%vacz(:,:,4) = AIMAG(cdomvz(:,:))
den%vacxy(:,:,:,3) = cdomvxy
......
......@@ -13,8 +13,6 @@ MODULE m_types_potden
REAL,ALLOCATABLE :: mt(:,:,:,:)
REAL,ALLOCATABLE :: vacz(:,:,:)
COMPLEX,ALLOCATABLE :: vacxy(:,:,:,:)
! For density only (noco case)
COMPLEX, ALLOCATABLE :: cdom(:)
!For angles of density/potential in noco case
REAL,ALLOCATABLE :: theta_pw(:)
REAL,ALLOCATABLE :: phi_pw(:)
......@@ -75,17 +73,11 @@ CONTAINS
IF(ALLOCATED(pd%mt)) DEALLOCATE (pd%mt)
IF(ALLOCATED(pd%vacz)) DEALLOCATE (pd%vacz)
IF(ALLOCATED(pd%vacxy)) DEALLOCATE (pd%vacxy)
IF(ALLOCATED(pd%cdom)) DEALLOCATE (pd%cdom)
IF(ALLOCATED(pd%mmpMat)) DEALLOCATE (pd%mmpMat)
ALLOCATE (pd%pw(ng3,MERGE(3,jspins,nocoExtraDim)),stat=err(1))
ALLOCATE (pd%mt(jmtd,0:nlhd,ntype,jspins),stat=err(2))
ALLOCATE (pd%vacz(nmzd,2,MERGE(4,jspins,nocoExtraDim)),stat=err(3))
ALLOCATE (pd%vacxy(nmzxyd,n2d-1,2,MERGE(3,jspins,nocoExtraDim)),stat=err(4))
IF (l_noco) THEN
ALLOCATE (pd%cdom(ng3))
ELSE
ALLOCATE (pd%cdom(1))
END IF
ALLOCATE (pd%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,n_u),jspins))
......@@ -94,7 +86,6 @@ CONTAINS
pd%mt=0.0
pd%vacz=0.0
pd%vacxy=CMPLX(0.0,0.0)
pd%cdom = CMPLX(0.0,0.0)
pd%mmpMat = CMPLX(0.0,0.0)
END SUBROUTINE init_potden_simple
......@@ -108,7 +99,6 @@ CONTAINS
pd%mt=0.0
pd%vacz=0.0
pd%vacxy=CMPLX(0.0,0.0)
pd%cdom = CMPLX(0.0,0.0)
pd%mmpMat = CMPLX(0.0,0.0)
END SUBROUTINE resetPotDen
END MODULE m_types_potden
......@@ -101,7 +101,7 @@ CONTAINS
CALL fft3d(ris(:,iden),fftwork,den%pw(:,iden),stars,+1)
ENDDO
!---> fouriertransform the off-diagonal part of the density matrix
CALL fft3d(ris(:,3),ris(:,4),den%cdom(:),stars,+1)
CALL fft3d(ris(:,3),ris(:,4),den%pw(:,3),stars,+1)
!test
! DO iden=1,4
......
......@@ -6,7 +6,7 @@
CONTAINS
SUBROUTINE visxc(&
& ifftd,stars,noco,xcpot,input,&
& qpw,cdom,&
& den,&
& vpw,vpw_w,vxpw,vxpw_w,&
& excpw)
......@@ -24,15 +24,15 @@
IMPLICIT NONE
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ifftd
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_input),INTENT(IN) :: input
INTEGER, INTENT (IN) :: ifftd
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_input),INTENT(IN) :: input
TYPE(t_potden),INTENT(IN) :: den
! ..
! .. Array Arguments ..
COMPLEX, INTENT (IN) :: qpw(stars%ng3,input%jspins),cdom(stars%ng3)
COMPLEX, INTENT (OUT) :: excpw(stars%ng3)
COMPLEX, INTENT (INOUT) ::vpw(stars%ng3,input%jspins),vpw_w(stars%ng3,input%jspins)
COMPLEX, INTENT (INOUT) ::vxpw(stars%ng3,input%jspins),vxpw_w(stars%ng3,input%jspins)
......@@ -59,7 +59,7 @@
DO js = 1,input%jspins
CALL fft3d(&
& af3(0,js),bf3,&
& qpw(1,js),&
& den%pw(1,js),&
& stars,+1)
ENDDO
......@@ -69,7 +69,7 @@
CALL fft3d(&
& mx,my,&
& cdom,&
& den%pw(:,3),&
& stars,+1)
DO i=0,27*stars%mx1*stars%mx2*stars%mx3-1
chdens= (af3(i,1)+af3(i,2))/2.
......
......@@ -9,8 +9,7 @@ CONTAINS
SUBROUTINE visxcg(&
& ifftd,stars,sym,&
& ifftxc3d,&
& cell,&
& qpw,cdom,&
& cell,den,&
& xcpot,input,&
& obsolete,noco,&
& rhmn,ichsmrg,&
......@@ -45,6 +44,7 @@ CONTAINS
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden),INTENT(IN) :: den
! ..
! .. Scalar Arguments ..
! ..
......@@ -64,9 +64,8 @@ CONTAINS
!
!-----> charge density, potential and energy density
!
COMPLEX, INTENT (IN) :: qpw(stars%ng3,input%jspins)
COMPLEX, INTENT (OUT) :: excpw(stars%ng3)
COMPLEX, INTENT (INOUT) ::vpw(stars%ng3,input%jspins),vpw_w(stars%ng3,input%jspins),cdom(stars%ng3)
COMPLEX, INTENT (INOUT) ::vpw(stars%ng3,input%jspins),vpw_w(stars%ng3,input%jspins)
COMPLEX, INTENT (INOUT) ::vxpw(stars%ng3,input%jspins),vxpw_w(stars%ng3,input%jspins)
! ..
! .. Local Scalars ..
......@@ -96,7 +95,7 @@ CONTAINS
!-------> abbreviations
!
! ph_wrk: work array containing phase * g_x,gy......
! qpw : charge density stored as stars
! den%pw: charge density stored as stars
! rho : charge density stored in real space
! vxc : exchange-correlation potential in real space
! exc : exchange-correlation energy density in real space
......@@ -165,7 +164,7 @@ CONTAINS
DO js=1,input%jspins
CALL fft3dxc(&
& rho(0:,js),bf3,&
& qpw(:,js),&
& den%pw(:,js),&
& stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,&
& stars%nxc3_fft,stars%kmxxc_fft,+1,&
& stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr)
......@@ -176,7 +175,7 @@ CONTAINS
! for off-diagonal parts the same
CALL fft3dxc(&
& mx,my,&
& cdom,&
& den%pw(:,3),&
& stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,&
& stars%nxc3_fft,stars%kmxxc_fft,+1,&
& stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr)
......@@ -204,7 +203,7 @@ CONTAINS
DO js= 1,input%jspins
DO i = 1,stars%ng3
cqpw(i,js)= ci*qpw(i,js)
cqpw(i,js)= ci*den%pw(i,js)
END DO
END DO
......@@ -248,7 +247,7 @@ CONTAINS
DO i = 1,stars%ng3
DO js=1,input%jspins
cqpw(i,js)= -qpw(i,js)
cqpw(i,js)= -den%pw(i,js)
END DO
END DO
......
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