Commit 06fedc2f authored by Alexander Neukirchen's avatar Alexander Neukirchen

b to density form with 3 entries

parent 0275ea35
......@@ -97,7 +97,8 @@ CONTAINS
TYPE(t_coreSpecInput) :: coreSpecInput
TYPE(t_wann) :: wann
TYPE(t_potden) :: vTot, vx, vCoul, vTemp
TYPE(t_potden) :: inDen, outDen, EnergyDen, xcB
TYPE(t_potden) :: inDen, outDen, EnergyDen
TYPE(t_potden),dimension(3) :: xcB
CLASS(t_xcpot), ALLOCATABLE :: xcpot
CLASS(t_forcetheo), ALLOCATABLE :: forcetheo
......@@ -138,7 +139,9 @@ CONTAINS
! Initialize and load inDen density (start)
CALL inDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
CALL xcB%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_POTTOT)
DO i=1,3
CALL xcB%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
ENDDO
archiveType = CDN_ARCHIVE_TYPE_CDN1_const
IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const
IF(mpi%irank.EQ.0) THEN
......
......@@ -53,7 +53,8 @@ CONTAINS
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_potden), INTENT(IN) :: EnergyDen
TYPE(t_potden), INTENT(INOUT) :: den
TYPE(t_potden), INTENT(INOUT) :: vTot,vx,vCoul,xcB
TYPE(t_potden), INTENT(INOUT) :: vTot,vx,vCoul
TYPE(t_potden),dimension(3),INTENT(INOUT) :: xcB
TYPE(t_potden) :: workden,denRot
......@@ -63,11 +64,14 @@ CONTAINS
CALL vTot%resetPotDen()
CALL vCoul%resetPotDen()
CALL vx%resetPotDen()
CALL xcB%resetPotden()
DO i=1,3
CALL xcB(i)%resetPotden()
ALLOCATE(xcB(i)%pw_w,mold=vTot%pw)
xcB(i)%pw_w = 0.0
ENDDO
ALLOCATE(vx%pw_w,mold=vTot%pw)
ALLOCATE(xcB%pw_w,mold=vTot%pw)
vx%pw_w = 0.0
xcB%pw_w = 0.0
#ifndef CPP_OLDINTEL
ALLOCATE(vTot%pw_w,mold=vTot%pw)
#else
......
......@@ -94,7 +94,8 @@ CONTAINS
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_potden),INTENT(IN) :: den
TYPE(t_potden),INTENT(INOUT) :: vtot,xcB
TYPE(t_potden),INTENT(INOUT) :: vtot
TYPE(t_potden),dimension(3),INTENT(INOUT) :: xcB
TYPE(t_xcpot_inbuild) :: xcpot !local xcpot that is LDA to indicate we do not need gradients
......@@ -128,9 +129,13 @@ CONTAINS
ch(imesh,4) = b_xc(imesh,2)
ENDDO
vtot%mt(:,0:,n,:)=0.0
xcB%mt(:,0:,n,:)=0.0
Do i=1,3
xcB(i)%mt(:,0:,n,:)=0.0
ENDDO
CALL mt_from_grid(atoms,sphhar,n,4,ch,vtot%mt(:,0:,n,:))
CALL mt_from_grid(atoms,sphhar,n,3,b_xc,xcB%mt(:,0:,n,:))
DO i=1,3
CALL mt_from_grid(atoms,sphhar,n,1,b_xc(:,i),xcB(i)%mt(:,0:,n,:))
ENDDO
DO i=1,atoms%jri(n)
vtot%mt(i,:,n,:)=vtot%mt(i,:,n,:)*atoms%rmsh(i,n)**2
ENDDO
......
......@@ -26,7 +26,8 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_potden),INTENT(INOUT) :: vTot,vCoul,denRot,xcB
TYPE(t_potden),INTENT(INOUT) :: vTot,vCoul,denRot
TYPE(t_potden),dimension(3),INTENT(INOUT) :: xcB
! ..
! .. Local Scalars ..
INTEGER i,js,n
......@@ -61,13 +62,19 @@ CONTAINS
!Copy first vacuum into second vacuum if this was not calculated before
IF (vacuum%nvac==1) THEN
vTot%vacz(:,2,:) = vTot%vacz(:,1,:)
xcB%vacz(:,2,:) = xcB%vacz(:,1,:)
DO i=1,3
xcB(i)%vacz(:,2,:) = xcB(i)%vacz(:,1,:)
ENDDO
IF (sym%invs) THEN
vTot%vacxy(:,:,2,:) = CMPLX(vTot%vacxy(:,:,1,:))
xcB%vacxy(:,:,2,:) = CMPLX(xcB%vacxy(:,:,1,:))
DO i=1,3
xcB(i)%vacxy(:,:,2,:) = CMPLX(xcB(i)%vacxy(:,:,1,:))
ENDDO
ELSE
vTot%vacxy(:,:,2,:) = vTot%vacxy(:,:,1,:)
xcB%vacxy(:,:,2,:) = xcB%vacxy(:,:,1,:)
DO i=1,3
xcB(i)%vacxy(:,:,2,:) = xcB(i)%vacxy(:,:,1,:)
ENDDO
ENDIF
ENDIF
......
......@@ -54,7 +54,8 @@ CONTAINS
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: den
TYPE(t_potden),INTENT(INOUT):: vTot,xcB
TYPE(t_potden),INTENT(INOUT):: vTot
TYPE(t_potden),dimension(3),INTENT(INOUT):: xcB
! ..
......@@ -68,9 +69,10 @@ CONTAINS
ifft3 = 27*stars%mx1*stars%mx2*stars%mx3
IF (ifft3.NE.SIZE(den%theta_pw)) CALL judft_error("Wrong size of angles")
ifft2 = SIZE(den%phi_vacxy,1)
xcB%vacxy(:,:,:,:)=0.0
xcB%vacz(:,:,:)=0.0
DO i=1,3
xcB(i)%vacxy(:,:,:,:)=0.0
xcB(i)%vacz(:,:,:)=0.0
ENDDO
ALLOCATE ( vis(ifft3,4),fftwork(ifft3))
ALLOCATE (b_xc(ifft3,3))
......@@ -124,7 +126,7 @@ CONTAINS
DO b_ind=1,3
fftwork=0.0
CALL fft3d(b_xc(:,b_ind),fftwork, xcB%pw_w(1,b_ind), stars,-1)
CALL fft3d(b_xc(:,b_ind),fftwork, xcB(b_ind)%pw_w(1,1), stars,-1)
ENDDO
IF (.NOT. input%film) RETURN
......@@ -186,13 +188,13 @@ CONTAINS
phi = den%phi_vacz(imz,ivac)
veff = (vup + vdown)/2.0
beff = (vup - vdown)/2.0
xcB%vacz(imz,ivac,1) = beff*SIN(theta)*COS(phi)
xcB%vacz(imz,ivac,2) = beff*SIN(theta)*SIN(phi)
xcB%vacz(imz,ivac,3) = beff*COS(theta)
vTot%vacz(imz,ivac,1) = veff + xcB%vacz(imz,ivac,3)
vTot%vacz(imz,ivac,2) = veff - xcB%vacz(imz,ivac,3)
vTot%vacz(imz,ivac,3) = xcB%vacz(imz,ivac,1)
vTot%vacz(imz,ivac,4) = xcB%vacz(imz,ivac,2)
xcB(1)%vacz(imz,ivac,1) = beff*SIN(theta)*COS(phi)
xcB(2)%vacz(imz,ivac,1) = beff*SIN(theta)*SIN(phi)
xcB(3)%vacz(imz,ivac,1) = beff*COS(theta)
vTot%vacz(imz,ivac,1) = veff + xcB(3)%vacz(imz,ivac,1)
vTot%vacz(imz,ivac,2) = veff - xcB(3)%vacz(imz,ivac,1)
vTot%vacz(imz,ivac,3) = xcB(1)%vacz(imz,ivac,1)
vTot%vacz(imz,ivac,4) = xcB(2)%vacz(imz,ivac,2)
ENDDO
ENDDO
......@@ -223,7 +225,7 @@ CONTAINS
DO imz = 1,vacuum%nmzxyd
fftwork=0.0
CALL fft2d(stars, b_xc_vacxy(:,imz,ivac,b_ind),fftwork,&
xcB%vacz(imz,ivac,b_ind),vziw,xcB%vacxy(imz,1,ivac,b_ind), vacuum%nmzxyd,-1)
xcB(b_ind)%vacz(imz,ivac,1),vziw,xcB(b_ind)%vacxy(imz,1,ivac,1), vacuum%nmzxyd,-1)
ENDDO
ENDDO
ENDDO
......
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