Commit 3a94e1e4 authored by Alexander Neukirchen's avatar Alexander Neukirchen

Reverting sourcefree content I already merged and which did not work

parent 31f47fec
......@@ -98,7 +98,6 @@ CONTAINS
TYPE(t_wann) :: wann
TYPE(t_potden) :: vTot, vx, vCoul, vTemp
TYPE(t_potden) :: inDen, outDen, EnergyDen
TYPE(t_potden), dimension(3):: xcB
CLASS(t_xcpot), ALLOCATABLE :: xcpot
CLASS(t_forcetheo), ALLOCATABLE :: forcetheo
......@@ -139,9 +138,7 @@ CONTAINS
! Initialize and load inDen density (start)
CALL inDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
DO i=1,3
CALL xcB(i)%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
......@@ -242,7 +239,7 @@ CONTAINS
CALL timestart("generation of potential")
CALL vgen(hybrid,field,input,xcpot,DIMENSION,atoms,sphhar,stars,vacuum,sym,&
obsolete,cell,oneD,sliceplot,mpi,results,noco,EnergyDen,inDen,vTot,vx,vCoul,xcB)
obsolete,cell,oneD,sliceplot,mpi,results,noco,EnergyDen,inDen,vTot,vx,vCoul)
CALL timestop("generation of potential")
#ifdef CPP_MPI
......@@ -406,7 +403,7 @@ CONTAINS
!!$ input%total = .FALSE.
!!$ CALL timestart("generation of potential (total)")
!!$ CALL vgen(hybrid,reap,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,sym,&
!!$ obsolete,cell,oneD,sliceplot,mpi, results,noco,outDen,inDenRot,vTot,vx,vCoul,xcB)
!!$ obsolete,cell,oneD,sliceplot,mpi, results,noco,outDen,inDenRot,vTot,vx,vCoul)
!!$ CALL timestop("generation of potential (total)")
!!$
!!$ CALL potdis(stars,vacuum,atoms,sphhar, input,cell,sym)
......
......@@ -20,7 +20,7 @@ CONTAINS
!! TE_EXC : charge density-ex-corr.energy density integral
SUBROUTINE vgen(hybrid,field,input,xcpot,DIMENSION,atoms,sphhar,stars,vacuum,sym,&
obsolete,cell,oneD,sliceplot,mpi,results,noco,EnergyDen,den,vTot,vx,vCoul,xcB)
obsolete,cell,oneD,sliceplot,mpi,results,noco,EnergyDen,den,vTot,vx,vCoul)
USE m_types
USE m_rotate_int_den_to_local
......@@ -54,7 +54,6 @@ CONTAINS
TYPE(t_potden), INTENT(IN) :: EnergyDen
TYPE(t_potden), INTENT(INOUT) :: den
TYPE(t_potden), INTENT(INOUT) :: vTot,vx,vCoul
TYPE(t_potden),dimension(3),INTENT(INOUT) :: xcB
TYPE(t_potden) :: workden,denRot
......@@ -65,11 +64,6 @@ CONTAINS
CALL vTot%resetPotDen()
CALL vCoul%resetPotDen()
CALL vx%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)
vx%pw_w = 0.0
......@@ -102,7 +96,7 @@ CONTAINS
obsolete,cell,oneD,sliceplot,mpi,noco,den,denRot,EnergyDen,vTot,vx,results)
!ToDo, check if this is needed for more potentials as well...
CALL vgen_finalize(atoms,stars,vacuum,sym,noco,input,sphhar,vTot,vCoul,denRot,xcB)
CALL vgen_finalize(atoms,stars,vacuum,sym,noco,input,sphhar,vTot,vCoul,denRot)
!DEALLOCATE(vcoul%pw_w)
CALL bfield(input,noco,atoms,field,vTot)
......
......@@ -89,13 +89,12 @@ CONTAINS
CALL finish_mt_grid()
END SUBROUTINE rotate_mt_den_to_local
SUBROUTINE rotate_mt_den_from_local(atoms,sphhar,sym,den,vtot,xcB)
SUBROUTINE rotate_mt_den_from_local(atoms,sphhar,sym,den,vtot)
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_potden),INTENT(IN) :: den
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
TYPE(t_gradients) :: grad
......@@ -103,12 +102,10 @@ CONTAINS
INTEGER :: n,nsp,imesh,i
REAL :: vup,vdown,veff,beff
REAL :: theta,phi
REAL,ALLOCATABLE :: ch(:,:),b_xc(:,:)
REAL,ALLOCATABLE :: livemt(:,:,:,:)
REAL,ALLOCATABLE :: ch(:,:)
nsp=atoms%nsp()
ALLOCATE(ch(nsp*atoms%jmtd,4))
ALLOCATE(livemt(size(xcB(1)%mt,1),size(xcB(1)%mt,2),size(xcB(1)%mt,3),3))
CALL xcpot%init("vwn",.FALSE.,1)
CALL init_mt_grid(4,atoms,sphhar,xcpot%needs_grad(),sym)
......@@ -121,23 +118,15 @@ CONTAINS
phi = den%phi_mt(imesh,n)
veff = (vup + vdown)/2.0
beff = (vup - vdown)/2.0
b_xc(imesh,1) = beff*SIN(theta)*COS(phi)
b_xc(imesh,2) = beff*SIN(theta)*SIN(phi)
b_xc(imesh,3) = beff*COS(theta)
ch(imesh,1) = veff + b_xc(imesh,3)
ch(imesh,2) = veff - b_xc(imesh,3)
ch(imesh,3) = b_xc(imesh,1)
ch(imesh,4) = b_xc(imesh,2)
ch(imesh,1) = veff + beff*COS(theta)
ch(imesh,2) = veff - beff*COS(theta)
ch(imesh,3) = beff*SIN(theta)*COS(phi)
ch(imesh,4) = beff*SIN(theta)*SIN(phi)
ENDDO
vtot%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,livemt(:,0:,n,:))
DO i=1,3
xcB(i)%mt(:,0:,n,1)=livemt(:,0:,n,i)
ENDDO
DO i=1,atoms%jri(n)
vtot%mt(i,:,n,:)=vtot%mt(i,:,n,:)*atoms%rmsh(i,n)**2
ENDDO
......
......@@ -6,7 +6,7 @@
MODULE m_vgen_finalize
USE m_juDFT
CONTAINS
SUBROUTINE vgen_finalize(atoms,stars,vacuum,sym,noco,input,sphhar,vTot,vCoul,denRot,xcB)
SUBROUTINE vgen_finalize(atoms,stars,vacuum,sym,noco,input,sphhar,vTot,vCoul,denRot)
! ***********************************************************
! FLAPW potential generator *
! ***********************************************************
......@@ -27,7 +27,6 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_potden),INTENT(INOUT) :: vTot,vCoul,denRot
TYPE(t_potden),dimension(3),INTENT(INOUT) :: xcB
! ..
! .. Local Scalars ..
INTEGER i,js,n
......@@ -48,8 +47,8 @@ CONTAINS
END DO
END DO
ELSEIF(noco%l_noco) THEN
CALL vmatgen(stars,atoms,vacuum,sym,input,denRot,vTot,xcB)
IF (noco%l_mtnocoPot) CALL rotate_mt_den_from_local(atoms,sphhar,sym,denRot,vtot,xcB)
CALL vmatgen(stars,atoms,vacuum,sym,input,denRot,vTot)
IF (noco%l_mtnocoPot) CALL rotate_mt_den_from_local(atoms,sphhar,sym,denRot,vtot)
ENDIF
! Rescale vCoul%pw_w with number of stars
......@@ -62,19 +61,10 @@ CONTAINS
!Copy first vacuum into second vacuum if this was not calculated before
IF (vacuum%nvac==1) THEN
vTot%vacz(:,2,:) = vTot%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,:))
DO i=1,3
xcB(i)%vacxy(:,:,2,:) = CMPLX(xcB(i)%vacxy(:,:,1,:))
ENDDO
ELSE
vTot%vacxy(:,:,2,:) = vTot%vacxy(:,:,1,:)
DO i=1,3
xcB(i)%vacxy(:,:,2,:) = xcB(i)%vacxy(:,:,1,:)
ENDDO
ENDIF
ENDIF
......
......@@ -29,7 +29,7 @@ MODULE m_vmatgen
! A.Neukirchen 05.09.2019
!**********************************************************************
CONTAINS
SUBROUTINE vmatgen(stars,atoms,vacuum,sym,input,den,vTot,xcB)
SUBROUTINE vmatgen(stars,atoms,vacuum,sym,input,den,vTot)
!******** ABBREVIATIONS ***********************************************
! ifft3 : size of the 3d real space mesh
......@@ -55,28 +55,20 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: den
TYPE(t_potden),INTENT(INOUT):: vTot
TYPE(t_potden),dimension(3),INTENT(INOUT):: xcB
! ..
! .. Local Scalars ..
INTEGER imeshpt,ipot,jspin,ig2 ,ig3,ivac,ifft2,ifft3,imz,iter,b_ind,i
INTEGER imeshpt,ipot,jspin,ig2 ,ig3,ivac,ifft2,ifft3,imz,iter,i
REAL vup,vdown,veff,beff,vziw,theta,phi
! ..
! .. Local Arrays ..
REAL, ALLOCATABLE :: vvacxy(:,:,:,:),vis(:,:),fftwork(:),b_xc(:,:),b_xc_vacxy(:,:,:,:)
REAL, ALLOCATABLE :: vvacxy(:,:,:,:),vis(:,:),fftwork(:)
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)
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))
!---> fouriertransform the spin up and down potential
!---> in the interstitial, vpw, to real space (vis)
......@@ -94,26 +86,20 @@ CONTAINS
!---> at first determine the effective potential and magnetic fields
veff = (vup + vdown)/2.0
beff = (vup - vdown)/2.0
b_xc(imeshpt,1)=beff*SIN(theta)*COS(phi)
b_xc(imeshpt,2)=beff*SIN(theta)*SIN(phi)
b_xc(imeshpt,3)=beff*COS(theta)
!---> now calculate the matrix potential, which is hermitian.
!---> thus calculate the diagonal elements:
!---> V_11
vis(imeshpt,1) = veff + b_xc(imeshpt,3)
vis(imeshpt,1) = veff + beff*COS(theta)
!---> V_22
vis(imeshpt,2) = veff - b_xc(imeshpt,3)
vis(imeshpt,2) = veff - beff*COS(theta)
!---> the real part of V_21
vis(imeshpt,3) = b_xc(imeshpt,1)
vis(imeshpt,3) = beff*SIN(theta)*COS(phi)
!---> and the imaginary part of V_21
vis(imeshpt,4) = b_xc(imeshpt,2)
vis(imeshpt,4) = beff*SIN(theta)*SIN(phi)
DO ipot = 1,4
vis(imeshpt,ipot) = vis(imeshpt,ipot) * stars%ufft(imeshpt-1)
ENDDO
DO b_ind = 1,3
b_xc(imeshpt,b_ind) = b_xc(imeshpt,b_ind) * stars%ufft(imeshpt-1)
ENDDO
ENDDO
!---> Fouriertransform the matrix potential back to reciprocal space
......@@ -124,19 +110,12 @@ CONTAINS
CALL fft3d(vis(:,3),vis(:,4), vTot%pw_w(1,3), stars,-1)
DO b_ind=1,3
fftwork=0.0
CALL fft3d(b_xc(:,b_ind),fftwork, xcB(b_ind)%pw_w(1,1), stars,-1)
ENDDO
IF (.NOT. input%film) RETURN
!Now the vacuum part starts
ALLOCATE(vvacxy(ifft2,vacuum%nmzxyd,2,4))
ALLOCATE(b_xc_vacxy(ifft2,vacuum%nmzxyd,2,3))
!---> fouriertransform the spin up and down potential
!---> in the vacuum, vz & vxy, to real space (vvacxy)
......@@ -172,13 +151,10 @@ CONTAINS
phi = den%phi_vacxy(imeshpt,imz,ivac)
veff = (vup + vdown)/2.0
beff = (vup - vdown)/2.0
b_xc_vacxy(imeshpt,imz,ivac,1) = beff*SIN(theta)*COS(phi)
b_xc_vacxy(imeshpt,imz,ivac,2) = beff*SIN(theta)*SIN(phi)
b_xc_vacxy(imeshpt,imz,ivac,3) = beff*COS(theta)
vvacxy(imeshpt,imz,ivac,1) = veff + b_xc_vacxy(imeshpt,imz,ivac,3)
vvacxy(imeshpt,imz,ivac,2) = veff - b_xc_vacxy(imeshpt,imz,ivac,3)
vvacxy(imeshpt,imz,ivac,3) = b_xc_vacxy(imeshpt,imz,ivac,1)
vvacxy(imeshpt,imz,ivac,4) = b_xc_vacxy(imeshpt,imz,ivac,2)
vvacxy(imeshpt,imz,ivac,1) = veff + beff*COS(theta)
vvacxy(imeshpt,imz,ivac,2) = veff - beff*COS(theta)
vvacxy(imeshpt,imz,ivac,3) = beff*SIN(theta)*COS(phi)
vvacxy(imeshpt,imz,ivac,4) = beff*SIN(theta)*SIN(phi)
ENDDO
ENDDO
DO imz = vacuum%nmzxyd+1,vacuum%nmzd
......@@ -188,13 +164,10 @@ CONTAINS
phi = den%phi_vacz(imz,ivac)
veff = (vup + vdown)/2.0
beff = (vup - vdown)/2.0
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)
vTot%vacz(imz,ivac,1) = veff + beff*COS(theta)
vTot%vacz(imz,ivac,2) = veff - beff*COS(theta)
vTot%vacz(imz,ivac,3) = beff*SIN(theta)*COS(phi)
vTot%vacz(imz,ivac,4) = beff*SIN(theta)*SIN(phi)
ENDDO
ENDDO
......@@ -220,16 +193,6 @@ CONTAINS
ENDDO
ENDDO
DO b_ind = 1,3
DO ivac = 1,vacuum%nvac
DO imz = 1,vacuum%nmzxyd
fftwork=0.0
CALL fft2d(stars, b_xc_vacxy(:,imz,ivac,b_ind),fftwork,&
xcB(b_ind)%vacz(imz,ivac,1),vziw,xcB(b_ind)%vacxy(imz,1,ivac,1), vacuum%nmzxyd,-1)
ENDDO
ENDDO
ENDDO
DO ivac = 1,vacuum%nvac
DO imz = 1,vacuum%nmzxyd
fftwork=0.0
......
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