Commit fa58d844 authored by Gregor Michalicek's avatar Gregor Michalicek

Eliminate potden%cdomvxy

Note: This seems to have introduced some bugs. ...to be corrected soon.
parent f92042da
......@@ -2,8 +2,8 @@ MODULE m_cdnval
use m_juDFT
CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atoms,enpara,stars,&
vacuum,dimension,sphhar,sym,obsolete,igq_fft,vr,vz,oneD,coreSpecInput,n_mmp,results, qpw,rhtxy,&
rho,rht,cdom,cdomvz,cdomvxy,qvac,qvlay,qa21, chmom,clmom)
vacuum,dimension,sphhar,sym,obsolete,igq_fft,vr,vz,oneD,coreSpecInput,den,results,&
qvac,qvlay,qa21, chmom,clmom)
!
! ***********************************************************
! this subroutin is a modified version of cdnval.F.
......@@ -44,6 +44,7 @@ CONTAINS
! and bands
!***********************************************************************
!
USE m_constants
USE m_eig66_io,ONLY: write_dos
USE m_radfun
USE m_radflo
......@@ -111,26 +112,19 @@ CONTAINS
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_coreSpecInput),INTENT(IN) :: coreSpecInput
TYPE(t_potden),INTENT(INOUT) :: den
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: eig_id,jspin
! .. Array Arguments ..
COMPLEX, INTENT(INOUT) :: qpw(stars%ng3,dimension%jspd)
COMPLEX, INTENT(INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,dimension%jspd)
COMPLEX, INTENT(INOUT) :: cdom(stars%ng3)
COMPLEX, INTENT(INOUT) :: cdomvz(vacuum%nmzd,2)
COMPLEX, INTENT(INOUT) :: cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2)
COMPLEX, INTENT(INOUT) :: qa21(atoms%ntype)
INTEGER, INTENT (IN) :: igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1)
REAL, INTENT (IN) :: vz(vacuum%nmzd,2)
REAL, INTENT (IN) :: vr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd)
REAL, INTENT (OUT) :: chmom(atoms%ntype,dimension%jspd),clmom(3,atoms%ntype,dimension%jspd)
REAL, INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd)
REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2,dimension%jspd)
REAL, INTENT (INOUT) :: qvac(dimension%neigd,2,kpts%nkpt,dimension%jspd)
REAL, INTENT (INOUT) :: qvlay(dimension%neigd,vacuum%layerd,2,kpts%nkpt,dimension%jspd)
COMPLEX, INTENT(INOUT) :: n_mmp(-3:3,-3:3,atoms%n_u)
#ifdef CPP_MPI
INCLUDE 'mpif.h'
......@@ -665,7 +659,7 @@ CONTAINS
IF (.NOT.((jspin.EQ.2) .AND. noco%l_noco)) THEN
CALL timestart("cdnval: pwden")
CALL pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym,ikpt,&
jspin,lapw,noccbd,igq_fft,we, eig,qpw,cdom,qis,results%force,f_b8,zMat)
jspin,lapw,noccbd,igq_fft,we, eig,den,qis,results%force,f_b8,zMat)
CALL timestop("cdnval: pwden")
END IF
!+new
......@@ -687,7 +681,7 @@ CONTAINS
CALL timestart("cdnval: vacden")
CALL vacden(vacuum,dimension,stars,oneD, kpts,input, cell,atoms,noco,banddos,&
gvac1d,gvac2d, we,ikpt,jspin,vz,vz0, noccbd,lapw, evac,eig,&
rhtxy,rht,qvac,qvlay, qstars,cdomvz,cdomvxy,zMat)
den,qvac,qvlay, qstars,zMat)
CALL timestop("cdnval: vacden")
END IF
!---> perform Brillouin zone integration and summation over the
......@@ -742,7 +736,7 @@ CONTAINS
IF (atoms%n_u.GT.0) THEN
CALL n_mat(atoms,sym,noccbd,usdus,ispin,we, acof(:,0:,:,ispin),bcof(:,0:,:,ispin),&
ccof(-atoms%llod:,:,:,:,ispin), n_mmp)
ccof(-atoms%llod:,:,:,:,ispin), den%mmpMat(:,:,:,jspin))
END IF
!
!---> perform Brillouin zone integration and summation over the
......@@ -904,8 +898,8 @@ CONTAINS
CALL timestart("cdnval: mpi_col_den")
DO ispin = jsp_start,jsp_end
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,&
input,noco,l_fmpl,ispin,llpd, rhtxy(1,1,1,ispin),&
rht(1,1,ispin),qpw(1,ispin), ener(0,1,ispin),sqal(0,1,ispin),&
input,noco,l_fmpl,ispin,llpd, den%vacxy(1,1,1,ispin),&
den%vacz(1,1,ispin),den%pw(1,ispin), ener(0,1,ispin),sqal(0,1,ispin),&
results,svac(1,ispin),pvac(1,ispin),uu(0,1,ispin),&
dd(0,1,ispin),du(0,1,ispin),uunmt(0,1,1,ispin),ddnmt(0,1,1,ispin),&
udnmt(0,1,1,ispin),dunmt(0,1,1,ispin),sqlo(1,1,ispin),&
......@@ -914,7 +908,7 @@ CONTAINS
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,&
uunmt21,ddnmt21,udnmt21,dunmt21,cdom,cdomvz,cdomvxy,n_mmp)
uunmt21,ddnmt21,udnmt21,dunmt21,den,den%mmpMat(:,:,:,jspin))
END DO
CALL timestop("cdnval: mpi_col_den")
#endif
......@@ -954,7 +948,7 @@ CONTAINS
orb,orbl,orblo,mt21,lo21,uloulopn21,uloulop21,&
uunmt21,ddnmt21,udnmt21,dunmt21,&
chmom,clmom,&
qa21,rho)
qa21,den%mt)
DO ispin = jsp_start,jsp_end
WRITE (6,*) 'Energy Parameters for spin:',ispin
......@@ -992,7 +986,7 @@ CONTAINS
xp,npd,0,0,ivac,1,ispin,.true.,dimension,atoms,&
sphhar,stars,sym,&
vacuum,cell,oneD,&
qpw,rho,rhtxy,rht)
den%pw,den%mt,den%vacxy,den%vacz)
END DO
ELSE IF (oneD%odi%d1) THEN
!-odim
......@@ -1002,7 +996,7 @@ CONTAINS
xp,npd,0,0,ivac,1,ispin,.true.,dimension,atoms,&
sphhar,stars,sym,&
vacuum,cell,oneD,&
qpw,rho,rhtxy,rht)
den%pw,den%mt,den%vacxy,den%vacz)
!+odim
END IF
!---> m.t. boundaries
......@@ -1013,7 +1007,7 @@ CONTAINS
xp,dimension%nspd,n,nat,0,-1,ispin,.true.,&
dimension,atoms,sphhar,stars,sym,&
vacuum,cell,oneD,&
qpw,rho,rhtxy,rht)
den%pw,den%mt,den%vacxy,den%vacz)
nat = nat + atoms%neq(n)
END DO
CALL timestop("cdnval: cdninf-stuff")
......@@ -1023,7 +1017,7 @@ CONTAINS
!---> forces of equ. A8 of Yu et al.
IF ((input%l_f)) THEN
CALL timestart("cdnval: force_a8")
CALL force_a8(input,atoms,sphhar, ispin, vr(:,:,:,ispin),rho,&
CALL force_a8(input,atoms,sphhar, ispin, vr(:,:,:,ispin),den%mt,&
f_a12,f_a21,f_b4,f_b8,results%force)
CALL timestop("cdnval: force_a8")
END IF
......
......@@ -18,6 +18,7 @@ CONTAINS
!
USE m_types
USE m_constants
IMPLICIT NONE
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_sym),INTENT(IN) :: sym
......@@ -31,7 +32,7 @@ CONTAINS
COMPLEX, INTENT (IN) :: acof(:,0:,:)!(nobd,0:atoms%lmaxd*(lmaxd+2) ,natd)
COMPLEX, INTENT (IN) :: bcof(:,0:,:)!(nobd,0:atoms%lmaxd*(lmaxd+2) ,natd)
COMPLEX, INTENT (IN) :: ccof(-atoms%llod:,:,:,:)!(-llod:llod,nobd,atoms%nlod,atoms%nat)
COMPLEX, INTENT (INOUT) :: n_mmp(-3:3,-3:3,atoms%n_u)
COMPLEX, INTENT (INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
! ..
! .. Local Scalars ..
COMPLEX c_0
......
......@@ -7,7 +7,7 @@
MODULE m_pwden
CONTAINS
SUBROUTINE pwden(stars,kpts,banddos,oneD, input,mpi,noco,cell,atoms,sym, &
ikpt,jspin,lapw,ne, igq_fft,we,eig, qpw,cdom, qis,forces,f_b8,zMat)
ikpt,jspin,lapw,ne, igq_fft,we,eig,den,qis,forces,f_b8,zMat)
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! In this subroutine the star function expansion coefficients of
! the plane wave charge density is determined.
......@@ -31,24 +31,24 @@ CONTAINS
! Brillouine zone sampling
! FFT information
!
! OUTPUT: qpw(s)
! OUTPUT: den%pw(s)
! 1) using FFT
!
! 2) traditional method
!
! -1 ef
! qpw (g) = vol * sum{ sum{ sum{ sum{ w(k) * f(nu) *
! den%pw(g) = vol * sum{ sum{ sum{ sum{ w(k) * f(nu) *
! sp k nu g'
! *
! c(g'-g,nu,k) * c(g',nu,k) } } } }
! or :
! -1 ef
! qpw (g) = vol * sum{ sum{ sum{ sum{ w(k) * f(nu) *
! den%pw(g) = vol * sum{ sum{ sum{ sum{ w(k) * f(nu) *
! sp k nu g'
! *
! c(g',nu,k) * c(g'+g,nu,k) } } } }
!
! qpw(g) are actuall
! den%pw(g) are actuall
!
! the weights w(k) are normalized: sum{w(k)} = 1
! k -6
......@@ -63,8 +63,8 @@ CONTAINS
! In non-collinear calculations the density becomes a hermitian 2x2
! matrix. This subroutine generates this density matrix in the
! interstitial region. The diagonal elements of this matrix
! (n_11 & n_22) are stored in qpw, while the real and imaginary part
! of the off-diagonal element are store in cdom.
! (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.
!
! Philipp Kurz 99/07
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
......@@ -80,18 +80,19 @@ CONTAINS
USE m_types
USE m_fft_interface
IMPLICIT NONE
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_input),INTENT(IN) :: input
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_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_input),INTENT(IN) :: input
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_atoms),INTENT(IN) :: atoms
TYPE(t_zMat),INTENT(IN) :: zMat
TYPE(t_potden),INTENT(INOUT) :: den
INTEGER, INTENT (IN) :: igq_fft(0:stars%kq1_fft*stars%kq2_fft*stars%kq3_fft-1)
REAL,INTENT(IN) :: we(:) !(nobd)
......@@ -100,8 +101,6 @@ CONTAINS
INTEGER,INTENT(IN):: ne
!-----> CHARGE DENSITY INFORMATION
INTEGER,INTENT(IN) :: ikpt,jspin
COMPLEX,INTENT(INOUT) :: qpw(:,:) !(stars%ng3,dimension%jspd)
COMPLEX,INTENT(INOUT) :: cdom(:)!(stars%ng3)
REAL,INTENT(OUT) :: qis(:,:,:) !(dimension%neigd,kpts%nkpt,dimension%jspd)
COMPLEX, INTENT (INOUT) :: f_b8(3,atoms%ntype)
REAL, INTENT (INOUT) :: forces(:,:,:) !(3,atoms%ntype,dimension%jspd)
......@@ -148,7 +147,7 @@ CONTAINS
! cv=z : wavefunction in g-space (reciprocal space)
! psir : wavefunction in r-space (real-space)
! cwk : complex work array: charge density in g-space (as stars)
! qpw : charge density stored as stars
! den%pw : charge density stored as stars
! trdchg: logical key, determines the mode of charge density
! calculation: false (default) : fft
! true : double sum over stars
......@@ -686,17 +685,17 @@ CONTAINS
ispin = jspin
IF (noco%l_noco) ispin = idens
DO istr = 1 , stars%ng3_fft
qpw(istr,ispin) = qpw(istr,ispin) + cwk(istr)
den%pw(istr,ispin) = den%pw(istr,ispin) + cwk(istr)
ENDDO
ELSE IF (idens.EQ.3) THEN
!---> add to off-diag. part of density matrix (only non-collinear)
DO istr = 1 , stars%ng3_fft
cdom(istr) = cdom(istr) + cwk(istr)
den%cdom(istr) = den%cdom(istr) + cwk(istr)
ENDDO
ELSE
!---> add to off-diag. part of density matrix (only non-collinear)
DO istr = 1 , stars%ng3_fft
cdom(istr) = cdom(istr) + CMPLX(0.0,1.0)*cwk(istr)
den%cdom(istr) = den%cdom(istr) + CMPLX(0.0,1.0)*cwk(istr)
ENDDO
ENDIF
......
This diff is collapsed.
......@@ -282,7 +282,7 @@ MODULE m_cdn_io
IF (datend == 0) THEN
IF (input%film) THEN
READ (iUnit) ((den%cdomvz(i,iVac),i=1,vacuum%nmz),iVac=1,vacuum%nvac)
READ (iUnit) (((den%cdomvxy(i,j-1,iVac),i=1,vacuum%nmzxy),j=2,oneD%odi%nq2), iVac=1,vacuum%nvac)
READ (iUnit) (((den%vacxy(i,j-1,iVac,3),i=1,vacuum%nmzxy),j=2,oneD%odi%nq2), iVac=1,vacuum%nvac)
END IF
ELSE
! (datend < 0) => no off-diagonal magnetisation stored
......@@ -294,14 +294,14 @@ MODULE m_cdn_io
den%cdom = CMPLX(0.0,0.0)
IF (input%film) THEN
den%cdomvz = CMPLX(0.0,0.0)
den%cdomvxy = CMPLX(0.0,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)
IF (input%film) THEN
den%cdomvz = CMPLX(0.0,0.0)
den%cdomvxy = CMPLX(0.0,0.0)
den%vacxy(:,:,:,3) = CMPLX(0.0,0.0)
END IF
END IF
CLOSE(iUnit)
......@@ -598,7 +598,7 @@ MODULE m_cdn_io
WRITE (iUnit) (den%cdom(k),k=1,stars%ng3)
IF (input%film) THEN
WRITE (iUnit) ((den%cdomvz(i,iVac),i=1,vacuum%nmz),iVac=1,vacuum%nvac)
WRITE (iUnit) (((den%cdomvxy(i,j-1,iVac),i=1,vacuum%nmzxy),j=2,oneD%odi%nq2), iVac=1,vacuum%nvac)
WRITE (iUnit) (((den%vacxy(i,j-1,iVac,3),i=1,vacuum%nmzxy),j=2,oneD%odi%nq2), iVac=1,vacuum%nvac)
END IF
END IF
......
......@@ -1682,18 +1682,18 @@ MODULE m_cdnpot_io_hdf
dimsInt(:3)=(/2,ng3,input%jspins/)
CALL h5dopen_f(groupID, 'fpw', fpwSetID, hdfError)
CALL io_write_complex2(fpwSetID,(/-1,1,1/),dimsInt(:3),den%pw)
CALL io_write_complex2(fpwSetID,(/-1,1,1/),dimsInt(:3),den%pw(:,:input%jspins))
CALL h5dclose_f(fpwSetID, hdfError)
IF (l_film) THEN
dimsInt(:3)=(/nmzd,2,input%jspins/)
CALL h5dopen_f(groupID, 'fz', fzSetID, hdfError)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),den%vacz)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),den%vacz(:,:,:input%jspins))
CALL h5dclose_f(fzSetID, hdfError)
dimsInt(:5)=(/2,nmzxyd,ng2-1,2,input%jspins/)
CALL h5dopen_f(groupID, 'fzxy', fzxySetID, hdfError)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),den%vacxy)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),den%vacxy(:,:,:,:input%jspins))
CALL h5dclose_f(fzxySetID, hdfError)
END IF
......@@ -1713,7 +1713,7 @@ MODULE m_cdnpot_io_hdf
dimsInt(:4)=(/2,nmzxy,od_nq2-1,nvac/)
CALL h5dopen_f(groupID, 'cdomvxy', cdomvxySetID, hdfError)
CALL io_write_complex3(cdomvxySetID,(/-1,1,1,1/),dimsInt(:4),den%cdomvxy)
CALL io_write_complex3(cdomvxySetID,(/-1,1,1,1/),dimsInt(:4),den%vacxy(:,:,:,3))
CALL h5dclose_f(cdomvxySetID, hdfError)
END IF
END IF
......@@ -1745,7 +1745,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(3,dims(:3),fpwSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fpw", H5T_NATIVE_DOUBLE, fpwSpaceID, fpwSetID, hdfError)
CALL h5sclose_f(fpwSpaceID,hdfError)
CALL io_write_complex2(fpwSetID,(/-1,1,1/),dimsInt(:3),den%pw)
CALL io_write_complex2(fpwSetID,(/-1,1,1/),dimsInt(:3),den%pw(:,:input%jspins))
CALL h5dclose_f(fpwSetID, hdfError)
IF (l_film) THEN
......@@ -1754,7 +1754,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(3,dims(:3),fzSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fz", H5T_NATIVE_DOUBLE, fzSpaceID, fzSetID, hdfError)
CALL h5sclose_f(fzSpaceID,hdfError)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),den%vacz)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),den%vacz(:,:,:input%jspins))
CALL h5dclose_f(fzSetID, hdfError)
dims(:5)=(/2,nmzxyd,ng2-1,2,input%jspins/)
......@@ -1762,7 +1762,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(5,dims(:5),fzxySpaceID,hdfError)
CALL h5dcreate_f(groupID, "fzxy", H5T_NATIVE_DOUBLE, fzxySpaceID, fzxySetID, hdfError)
CALL h5sclose_f(fzxySpaceID,hdfError)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),den%vacxy)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),den%vacxy(:,:,:,:input%jspins))
CALL h5dclose_f(fzxySetID, hdfError)
END IF
......@@ -1791,7 +1791,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(4,dims(:4),cdomvxySpaceID,hdfError)
CALL h5dcreate_f(groupID, "cdomvxy", H5T_NATIVE_DOUBLE, cdomvxySpaceID, cdomvxySetID, hdfError)
CALL h5sclose_f(cdomvxySpaceID,hdfError)
CALL io_write_complex3(cdomvxySetID,(/-1,1,1,1/),dimsInt(:4),den%cdomvxy)
CALL io_write_complex3(cdomvxySetID,(/-1,1,1,1/),dimsInt(:4),den%vacxy(:,:,:,3))
CALL h5dclose_f(cdomvxySetID, hdfError)
END IF
END IF
......@@ -1842,7 +1842,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(3,dims(:3),fpwSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fpw", H5T_NATIVE_DOUBLE, fpwSpaceID, fpwSetID, hdfError)
CALL h5sclose_f(fpwSpaceID,hdfError)
CALL io_write_complex2(fpwSetID,(/-1,1,1/),dimsInt(:3),den%pw)
CALL io_write_complex2(fpwSetID,(/-1,1,1/),dimsInt(:3),den%pw(:,:input%jspins))
CALL h5dclose_f(fpwSetID, hdfError)
IF (l_film) THEN
......@@ -1851,7 +1851,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(3,dims(:3),fzSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fz", H5T_NATIVE_DOUBLE, fzSpaceID, fzSetID, hdfError)
CALL h5sclose_f(fzSpaceID,hdfError)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),den%vacz)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),den%vacz(:,:,:input%jspins))
CALL h5dclose_f(fzSetID, hdfError)
dims(:5)=(/2,nmzxyd,ng2-1,2,input%jspins/)
......@@ -1859,7 +1859,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(5,dims(:5),fzxySpaceID,hdfError)
CALL h5dcreate_f(groupID, "fzxy", H5T_NATIVE_DOUBLE, fzxySpaceID, fzxySetID, hdfError)
CALL h5sclose_f(fzxySpaceID,hdfError)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),den%vacxy)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),den%vacxy(:,:,:,:input%jspins))
CALL h5dclose_f(fzxySetID, hdfError)
END IF
......@@ -1888,7 +1888,7 @@ MODULE m_cdnpot_io_hdf
CALL h5screate_simple_f(4,dims(:4),cdomvxySpaceID,hdfError)
CALL h5dcreate_f(groupID, "cdomvxy", H5T_NATIVE_DOUBLE, cdomvxySpaceID, cdomvxySetID, hdfError)
CALL h5sclose_f(cdomvxySpaceID,hdfError)
CALL io_write_complex3(cdomvxySetID,(/-1,1,1,1/),dimsInt(:4),den%cdomvxy)
CALL io_write_complex3(cdomvxySetID,(/-1,1,1,1/),dimsInt(:4),den%vacxy(:,:,:,3))
CALL h5dclose_f(cdomvxySetID, hdfError)
END IF
END IF
......@@ -2205,9 +2205,9 @@ MODULE m_cdnpot_io_hdf
COMPLEX, ALLOCATABLE :: cdomTemp(:), cdomvzTemp(:,:), cdomvxyTemp(:,:,:)
COMPLEX, ALLOCATABLE :: mmpMatTemp(:,:,:,:)
den%cdom = CMPLX(0.0,0.0)
den%cdomvz = CMPLX(0.0,0.0)
den%cdomvxy = CMPLX(0.0,0.0)
den%pw = CMPLX(0.0,0.0)
den%vacz = CMPLX(0.0,0.0)
den%vacxy = CMPLX(0.0,0.0)
CALL h5gopen_f(fileID, '/general', generalGroupID, hdfError)
! read in file format version from the header '/general'
......@@ -2394,7 +2394,7 @@ MODULE m_cdnpot_io_hdf
ALLOCATE(fpwTemp(ng3,jspins))
dimsInt(:3)=(/2,ng3,jspins/)
CALL h5dopen_f(groupID, 'fpw', fpwSetID, hdfError)
CALL io_read_complex2(fpwSetID,(/-1,1,1/),dimsInt(:3),fpwTemp)
CALL io_read_complex2(fpwSetID,(/-1,1,1/),dimsInt(:3),fpwTemp(:,:jspins))
CALL h5dclose_f(fpwSetID, hdfError)
den%pw(1:ng3Out,1:jspinsOut) = fpwTemp(1:ng3Out,1:jspinsOut)
DEALLOCATE(fpwTemp)
......@@ -2404,7 +2404,7 @@ MODULE m_cdnpot_io_hdf
ALLOCATE(fzTemp(nmzd,2,jspins))
dimsInt(:3)=(/nmzd,2,jspins/)
CALL h5dopen_f(groupID, 'fz', fzSetID, hdfError)
CALL io_read_real3(fzSetID,(/1,1,1/),dimsInt(:3),fzTemp)
CALL io_read_real3(fzSetID,(/1,1,1/),dimsInt(:3),fzTemp(:,:,:jspins))
CALL h5dclose_f(fzSetID, hdfError)
den%vacz(1:nmzdOut,1:2,1:jspinsOut) = fzTemp(1:nmzdOut,1:2,1:jspinsOut)
DEALLOCATE(fzTemp)
......@@ -2413,7 +2413,7 @@ MODULE m_cdnpot_io_hdf
ALLOCATE(fzxyTemp(nmzxyd,ng2-1,2,jspins))
dimsInt(:5)=(/2,nmzxyd,ng2-1,2,jspins/)
CALL h5dopen_f(groupID, 'fzxy', fzxySetID, hdfError)
CALL io_read_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),fzxyTemp)
CALL io_read_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),fzxyTemp(:,:,:,:jspins))
CALL h5dclose_f(fzxySetID, hdfError)
den%vacxy(1:nmzxydOut,1:ng2Out-1,1:2,1:jspinsOut) =&
fzxyTemp(1:nmzxydOut,1:ng2Out-1,1:2,1:jspinsOut)
......@@ -2442,14 +2442,14 @@ MODULE m_cdnpot_io_hdf
den%cdomvz(1:nmzOut,1:nvacOut) = cdomvzTemp(1:nmzOut,1:nvacOut)
DEALLOCATE(cdomvzTemp)
den%cdomvxy = CMPLX(0.0,0.0)
den%vacxy(:,:,:,3) = CMPLX(0.0,0.0)
! No change in od_nq2 allowed at the moment!
ALLOCATE(cdomvxyTemp(nmzxy,od_nq2-1,nvac))
dimsInt(:4)=(/2,nmzxy,od_nq2-1,nvac/)
CALL h5dopen_f(groupID, 'cdomvxy', cdomvxySetID, hdfError)
CALL io_read_complex3(cdomvxySetID,(/-1,1,1,1/),dimsInt(:4),cdomvxyTemp)
CALL h5dclose_f(cdomvxySetID, hdfError)
den%cdomvxy(1:nmzxyOut,1:od_nq2Out-1,1:nvacOut) =&
den%vacxy(1:nmzxyOut,1:od_nq2Out-1,1:nvacOut,3) =&
cdomvxyTemp(1:nmzxyOut,1:od_nq2Out-1,1:nvacOut)
DEALLOCATE(cdomvxyTemp)
END IF
......
......@@ -96,7 +96,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
!pk non-collinear (end)
iter = inIter
CALL outDen%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,.FALSE.,POTDEN_TYPE_DEN)
CALL outDen%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
IF (mpi%irank.EQ.0) THEN
INQUIRE(file='enpara',exist=l_enpara)
......@@ -134,8 +134,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,igq_fft,vTot%mt,vTot%vacz(:,:,jspin),oneD,coreSpecInput,&
outDen%mmpMat(-lmaxU_const:,-lmaxU_const:,:,jspin),results, outDen%pw,outDen%vacxy,outDen%mt,outDen%vacz,&
outDen%cdom,outDen%cdomvz,outDen%cdomvxy,qvac,qvlay,qa21, chmom,clmom)
outDen,results,qvac,qvlay,qa21, chmom,clmom)
CALL timestop("cdngen: cdnval")
!-fo
END DO
......@@ -308,7 +307,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
outDen%cdom(:stars%ng3) = fix*outDen%cdom(:stars%ng3)
IF (input%film) THEN
outDen%cdomvz(:,:) = fix*outDen%cdomvz(:,:)
outDen%cdomvxy(:,:,:) = fix*outDen%cdomvxy(:,:,:)
outDen%vacxy(:,:,:,3) = fix*outDen%vacxy(:,:,:,3)
END IF
END IF
!pk non-collinear (end)
......@@ -453,7 +452,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
WRITE (20) (outDen%cdom(k),k=1,stars%ng3)
IF (input%film) THEN
WRITE (20) ((outDen%cdomvz(j,ivac),j=1,vacuum%nmz),ivac=1,vacuum%nvac)
WRITE (20) (((outDen%cdomvxy(j,k-1,ivac),j=1,vacuum%nmzxy),k=2,oneD%odi%nq2) ,ivac=1,vacuum%nvac)
WRITE (20) (((outDen%vacxy(j,k-1,ivac,3),j=1,vacuum%nmzxy),k=2,oneD%odi%nq2) ,ivac=1,vacuum%nvac)
END IF
END IF
CLOSE(20)
......
......@@ -174,8 +174,8 @@ CONTAINS
IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('scfLoop')
! Initialize and load inDen density (start)
CALL inDen%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,.FALSE.,POTDEN_TYPE_DEN)
CALL inDenRot%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,.FALSE.,POTDEN_TYPE_DEN)
CALL inDen%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL inDenRot%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
IF (noco%l_noco) THEN
archiveType = CDN_ARCHIVE_TYPE_NOCO_const
ELSE
......
......@@ -174,9 +174,6 @@ SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,&
END IF
!initiatlize mixed density and extract it with brysh2 call
inDen%cdom = CMPLX(0.0,0.0)
inDen%cdomvz = CMPLX(0.0,0.0)
inDen%cdomvxy = CMPLX(0.0,0.0)
inDen%mmpMat = CMPLX(0.0,0.0)
CALL brysh2(input,stars,atoms,sphhar,noco,vacuum,sym,sm,oneD,inDen)
......
......@@ -134,7 +134,7 @@ CONTAINS
vpw_w(stars%ng3,dimension%jspd),vxpw_w(stars%ng3,dimension%jspd),psq(stars%ng3) )
vTot%iter = den%iter
CALL workDen%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,.FALSE.,POTDEN_TYPE_DEN)
CALL workDen%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
workDen = den
IF (mpi%irank == 0) THEN
......@@ -445,15 +445,15 @@ CONTAINS
IF (.NOT.oneD%odi%d1) THEN
CALL vvacxc(ifftd2,stars,vacuum,xcpot,input,noco,&
workDen%vacxy,workDen%vacz,workDen%cdomvxy,workDen%cdomvz, vTot%vacxy,vTot%vacz, excxy,excz)
CALL vvacxc(ifftd2,stars,vacuum,xcpot,input,noco,workDen,&
vTot%vacxy,vTot%vacz, excxy,excz)
ELSE
CALL judft_error("OneD broken")
! CALL vvacxc(&
! & stars,oneD%M,vacuum,odi%n2d,dimension,ifftd2,&
! & xcpot,input,odi%nq2,&
! & odi%nst2,workDen%vacxy,workDen%vacz,workDen%cdomvxy,workDen%cdomvz,noco,&
! & odi%nst2,den,noco,&
! & odi%kimax2%igf,odl%pgf,&
! & vTot%vacxy,vTot%vacz,&
! & excxy,excz)
......@@ -466,13 +466,13 @@ CONTAINS
CALL judft_error("OneD broken")
CALL vvacxcg(ifftd2,stars,vacuum,noco,oneD,&
cell,xcpot,input,obsolete, ichsmrg,&
workDen%vacxy,workDen%vacz,workDen%cdomvxy,workDen%cdomvz, vTot%vacxy,vTot%vacz,rhmn, excxy,excz)
cell,xcpot,input,obsolete,workDen, ichsmrg,&
vTot%vacxy,vTot%vacz,rhmn, excxy,excz)
ELSE
CALL vvacxcg(ifftd2,stars,vacuum,noco,oneD,&
cell,xcpot,input,obsolete, ichsmrg,&
workDen%vacxy,workDen%vacz,workDen%cdomvxy,workDen%cdomvz, vTot%vacxy,vTot%vacz,rhmn, excxy,excz)
cell,xcpot,input,obsolete,workDen, ichsmrg,&
vTot%vacxy,vTot%vacz,rhmn, excxy,excz)
END IF
......
......@@ -111,7 +111,7 @@ CONTAINS
DO i = 1,vacuum%nmzxy
mapvac2 = mapvac2 + 1
j = j + 1
sout(j) = REAL(den%cdomvxy(i,k,iv))
sout(j) = REAL(den%vacxy(i,k,iv,3))
END DO
END DO
END DO
......@@ -125,7 +125,7 @@ CONTAINS
DO i = 1,vacuum%nmzxy
mapvac2 = mapvac2 + 1
j = j + 1
sout(j) = AIMAG(den%cdomvxy(i,k,iv))
sout(j) = AIMAG(den%vacxy(i,k,iv,3))
END DO
END DO
END DO
......
......@@ -25,6 +25,13 @@ CONTAINS
! Local Scalars
INTEGER i,iv,j,js,k,l,n,na
den%pw = CMPLX(0.0,0.0)
den%mt = 0.0
den%vacz = 0.0
den%vacxy = CMPLX(0.0,0.0)
den%cdom = CMPLX(0.0,0.0)
den%cdomvz = 0.0
j=0
DO js = 1,input%jspins
IF (sym%invs) THEN
......@@ -92,7 +99,7 @@ CONTAINS
DO k = 1,oneD%odi%nq2-1
DO i = 1,vacuum%nmzxy
j = j + 1
den%cdomvxy(i,k,iv) = CMPLX(s_in(j),0.0)
den%vacxy(i,k,iv,3) = CMPLX(s_in(j),0.0)
END DO
END DO
END DO
......@@ -104,7 +111,7 @@ CONTAINS
DO k = 1,oneD%odi%nq2-1
DO i = 1,vacuum%nmzxy
j = j + 1
den%cdomvxy(i,k,iv) = den%cdomvxy(i,k,iv)+ CMPLX(0.0,s_in(j))
den%vacxy(i,k,iv,3) = den%vacxy(i,k,iv,3)+ CMPLX(0.0,s_in(j))
END DO
END DO
END DO
......
......@@ -43,11 +43,9 @@ CONTAINS
IF (noco%l_noco) THEN
IF(.NOT.ALLOCATED(potden%cdom)) ALLOCATE (potden%cdom(stars%ng3))
IF(.NOT.ALLOCATED(potden%cdomvz)) ALLOCATE (potden%cdomvz(vacuum%nmzd,2))
IF(.NOT.ALLOCATED(potden%cdomvxy)) ALLOCATE (potden%cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2))
ELSE
IF(.NOT.ALLOCATED(potden%cdom)) ALLOCATE (potden%cdom(1))
IF(.NOT.ALLOCATED(potden%cdomvz)) ALLOCATE (potden%cdomvz(1,1))
IF(.NOT.ALLOCATED(potden%cdomvxy)) ALLOCATE (potden%cdomvxy(1,1,1))
END IF
END IF
IF((mpi%irank.NE.0).AND.l_denMatAlloc) THEN
......@@ -56,7 +54,7 @@ CONTAINS
END IF
END IF
n = stars%ng3 * input%jspins
n = stars%ng3 * SIZE(potden%pw,2)
CALL MPI_BCAST(potden%pw,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
n = atoms%jmtd * (sphhar%nlhd+1) * atoms%ntype * input%jspins
......@@ -66,7 +64,7 @@ CONTAINS
n = vacuum%nmzd * 2 * SIZE(potden%vacz,3)
CALL MPI_BCAST(potden%vacz,n,MPI_DOUBLE,0,mpi%mpi_comm,ierr)
n = vacuum%nmzxyd * (stars%ng2-1) * 2 * input%jspins
n = vacuum%nmzxyd * (stars%ng2-1) * 2 * SIZE(potden%vacxy,4)
CALL MPI_BCAST(potden%vacxy,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
END IF
......@@ -76,9 +74,6 @@ CONTAINS
n = SIZE(potden%cdomvz,1) * SIZE(potden%cdomvz,2)
CALL MPI_BCAST(potden%cdomvz,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
n = SIZE(potden%cdomvxy,1) * SIZE(potden%cdomvxy,2) * SIZE(potden%cdomvxy,3)
CALL MPI_BCAST(potden%cdomvxy,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
END IF
IF (l_denMatAlloc) THEN
......