Commit 402b0a82 authored by Robin Hilgers's avatar Robin Hilgers

Merge branch 'develop' of https://iffgit.fz-juelich.de/fleur/fleur into develop

parents 8619abcb 38c47eb8
......@@ -46,7 +46,6 @@ CONTAINS
USE m_vgen
USE m_vgen_coulomb
USE m_writexcstuff
USE m_vmatgen
USE m_eigen
USE m_eigenso
USE m_fermie
......@@ -68,8 +67,6 @@ CONTAINS
USE m_plot
USE m_hubbard1_setup
#ifdef CPP_MPI
USE m_mpi_bc_potden
#endif
......
......@@ -4,26 +4,28 @@
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_vgen
USE m_juDFT
CONTAINS
!> FLAPW potential generator
!! The full potential is generated by the following main steps:
!! * generation of Coulomb potential
!! * copy of VCoul to both spins
!! * generation of XC potential
!! In addition, the rotation of the density in the noco case and some scaling is done
!! In results we store:
!! TE_VCOUL : charge density-coulomb potential integral
!! TE_VEFF: charge density-effective potential integral
!! TE_EXC : charge density-ex-corr.energy density integral
SUBROUTINE vgen(hybdat,field,input,xcpot,atoms,sphhar,stars,vacuum,sym,&
cell,oneD,sliceplot,mpi,results,noco,nococonv,EnergyDen,den,vTot,vx,vCoul)
!--------------------------------------------------------------------------
! FLAPW potential generator (main routine)
!
! The full potential is generated by the following main steps:
! a) Generation of Coulomb potential from the total density.
! b) Copying of VCoul to both spins.
! c) Generation of XC potential.
! d) Finalizations including e.g. rescaling and rotations.
!
! In results we store:
! TE_VCOUL : charge density-coulomb potential integral
! TE_VEFF : charge density-effective potential integral
! TE_EXC : charge density-xc-energy density integral
!--------------------------------------------------------------------------
USE m_types
USE m_rotate_int_den_to_local
USE m_rotate_int_den_tofrom_local
USE m_bfield
USE m_vgen_coulomb
USE m_vgen_xcpot
......@@ -32,48 +34,52 @@ CONTAINS
#ifdef CPP_MPI
USE m_mpi_bc_potden
#endif
IMPLICIT NONE
TYPE(t_results), INTENT(INOUT) :: results
CLASS(t_xcpot), INTENT(IN) :: xcpot
TYPE(t_hybdat), INTENT(IN) :: hybdat
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_sliceplot), INTENT(IN) :: sliceplot
TYPE(t_input), INTENT(IN) :: input
TYPE(t_field), INTENT(IN) :: field
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_nococonv), INTENT(INOUT) :: nococonv
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sphhar), INTENT(IN) :: sphhar
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
TYPE(t_potden) :: workden,denRot
TYPE(t_results), INTENT(INOUT) :: results
CLASS(t_xcpot), INTENT(IN) :: xcpot
TYPE(t_hybdat), INTENT(IN) :: hybdat
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_sliceplot), INTENT(IN) :: sliceplot
TYPE(t_input), INTENT(IN) :: input
TYPE(t_field), INTENT(IN) :: field
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_nococonv), INTENT(INOUT) :: nococonv
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sphhar), INTENT(IN) :: sphhar
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
TYPE(t_potden) :: workden, denRot
INTEGER :: i
COMPLEX :: mmpmat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,atoms%n_u+atoms%n_hia),MERGE(3,input%jspins,noco%l_mperp))
COMPLEX :: mmpmat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const, &
MAX(1,atoms%n_u+atoms%n_hia),MERGE(3,input%jspins,noco%l_mperp))
if (mpi%irank==0) WRITE (6,FMT=8000)
IF (mpi%irank==0) WRITE (6,FMT=8000)
8000 FORMAT (/,/,t10,' p o t e n t i a l g e n e r a t o r',/)
IF(atoms%n_u+atoms%n_hia>0.AND.input%ldaUAdjEnpara) THEN
!In this case we need the last mmpmat after vgen
mmpmat = vTot%mmpmat
ENDIF
END IF
CALL vTot%resetPotDen()
CALL vCoul%resetPotDen()
CALL vx%resetPotDen()
IF(atoms%n_u+atoms%n_hia>0.AND.input%ldaUAdjEnpara) THEN
!In this case we need the last mmpmat after vgen
vTot%mmpmat = mmpmat
ENDIF
END IF
ALLOCATE(vx%pw_w,mold=vTot%pw)
vx%pw_w = 0.0
......@@ -82,30 +88,35 @@ CONTAINS
#else
ALLOCATE( vTot%pw_w(size(vTot%pw,1),size(vTot%pw,2)))
#endif
ALLOCATE(vCoul%pw_w(SIZE(vCoul%pw,1),size(vCoul%pw,2)))
vCoul%pw_w = CMPLX(0.0,0.0)
CALL workDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,0)
!sum up both spins in den into workden
! a)
! Sum up both spins in den into workden:
CALL den%sum_both_spin(workden)
CALL vgen_coulomb(1,mpi,oneD,input,field,vacuum,sym,stars,cell,sphhar,atoms,.FALSE.,workden,vCoul,results)
! b)
CALL vCoul%copy_both_spin(vTot)
vCoul%mt(:,:,:,input%jspins)=vCoul%mt(:,:,:,1)
! c)
IF (noco%l_noco) THEN
CALL denRot%init(stars,atoms,sphhar,vacuum,noco,input%jspins,0)
denRot=den
CALL rotate_int_den_to_local(sym,stars,atoms,sphhar,vacuum,cell,input,noco,oneD,denRot)
IF (noco%l_mtnocoPot) CALL rotate_mt_den_to_local(atoms,sphhar,sym,noco,denrot)
ENDIF
END IF
CALL vgen_xcpot(hybdat,input,xcpot,atoms,sphhar,stars,vacuum,sym,&
cell,oneD,sliceplot,mpi,noco,den,denRot,EnergyDen,vTot,vx,results)
!ToDo, check if this is needed for more potentials as well...
! d)
! TODO: Check if this is needed for more potentials as well!
CALL vgen_finalize(mpi,oneD,field,cell,atoms,stars,vacuum,sym,noco,nococonv,input,xcpot,sphhar,vTot,vCoul,denRot)
!DEALLOCATE(vcoul%pw_w)
......@@ -117,4 +128,5 @@ CONTAINS
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,vx)
#endif
END SUBROUTINE vgen
END MODULE m_vgen
......@@ -31,11 +31,10 @@ vgen/vgen_xcpot.F90
vgen/vgen_finalize.F90
vgen/prp_xcfft_map.f90
vgen/psqpw.F90
vgen/rotate_int_den_to_local.F90
vgen/rotate_int_den_tofrom_local.F90
vgen/vintcz.f90
vgen/vis_xc.F90
vgen/pw_tofrom_grid.F90
vgen/vmatgen.f90
vgen/vmts.F90
vgen/vmt_xc.F90
vgen/vvac.f90
......
......@@ -15,14 +15,14 @@ CONTAINS
!
! Non-noco: Some rescaling is done here.
!
! Noco: vmatgen is called to generate 2x2 interstitial V matrix.
! Noco: rotate_int_den_from_local is called to generate 2x2 interstitial V matrix.
!
! Fully fully noco: rotate_mt_den_from_local does so for the Muffin Tins.
!
! Sourcefree: The xc-B-field is scaled up an source terms are purged out.
!--------------------------------------------------------------------------
USE m_constants
USE m_vmatgen
USE m_rotate_int_den_tofrom_local
USE m_types
USE m_rotate_mt_den_tofrom_local
USE m_sfTests
......@@ -30,6 +30,7 @@ CONTAINS
USE m_pw_tofrom_grid
IMPLICIT NONE
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_field), INTENT(IN) :: field
......@@ -45,13 +46,14 @@ CONTAINS
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_potden), INTENT(INOUT) :: vTot, vCoul, denRot
TYPE(t_potden) :: div, phi, checkdiv
TYPE(t_potden), DIMENSION(3) :: cvec, corrB, bxc
TYPE(t_gradients) :: tmp_grad
TYPE(t_potden) :: div, phi, checkdiv
TYPE(t_potden), DIMENSION(3) :: cvec, corrB, bxc
TYPE(t_gradients) :: tmp_grad
INTEGER :: i, js, n
REAL :: b(3,atoms%ntype), dummy1(atoms%ntype), dummy2(atoms%ntype), sfscale
REAL, ALLOCATABLE :: intden(:,:)
INTEGER :: i, js, n
REAL :: sfscale
REAL :: b(3,atoms%ntype), dummy1(atoms%ntype), dummy2(atoms%ntype)
REAL, ALLOCATABLE :: intden(:,:)
IF (.NOT.noco%l_noco) THEN
! Rescale vTot%pw_w with number of stars:
......@@ -62,7 +64,7 @@ CONTAINS
END DO
ELSE IF(noco%l_noco) THEN
! Rotate interstital potential back to global frame:
CALL vmatgen(stars,atoms,vacuum,sym,input,denRot,vTot)
CALL rotate_int_den_from_local(stars,atoms,vacuum,sym,input,denRot,vTot)
IF (noco%l_mtnocoPot) THEN
! Rotate Muffin Tin potential back to global frame:
CALL rotate_mt_den_from_local(atoms,sphhar,sym,denRot,noco,vtot)
......
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_vmatgen
USE m_juDFT
!**********************************************************************
! This subroutine prepares the spin dependent 2x2 matrix potential
! for the Hamiltonian setup. This is done in 4 steps.
!
! i) The spin up and down potential and the direction of the
! magentic field, theta and phi, are reloaded from files nrp,
! dirofmag.
! ii) The spin up and down potential is Fouriertransformed to real
! space (theta and phi are stored in real space).
! iii) The four components of the matrix potential are calculated on
! the real space mesh.
! iv) The matrix potential is Fouriertransformed, stored in terms of
! stars and written to file potmat.
!
! Philipp Kurz 99/11/01
!
! Extended for the investigation of the exch-corr B-field, which is
! analogously saved as a potden type with 3 integers (i.e. in com-
! ponent space.
!
! A.Neukirchen 05.09.2019
!**********************************************************************
CONTAINS
SUBROUTINE vmatgen(stars,atoms,vacuum,sym,input,den,vTot)
!******** ABBREVIATIONS ***********************************************
! ifft3 : size of the 3d real space mesh
! ifft2 : size of the 2d real space mesh
! vpw : first interstitial spin up and down potential
! later four components of matrix potential
! all stored in terms of 3d-stars
! vis : first interstitial spin up and down potential and
! direction of magnetic field (theta and phi)
! later four components of matrix potential
! all stored on real space mesh
!**********************************************************************
USE m_fft2d
USE m_fft3d
USE m_types
IMPLICIT NONE
! TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: den
TYPE(t_potden),INTENT(INOUT):: vTot
! ..
! .. Local Scalars ..
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(:),vis2(:,:)
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)
ALLOCATE ( vis(ifft3,4),fftwork(ifft3),vis2(ifft3,4))
!---> fouriertransform the spin up and down potential
!---> in the interstitial, vpw, to real space (vis)
DO jspin = 1,input%jspins
CALL fft3d(vis(:,jspin),fftwork, vTot%pw(:,jspin), stars,+1)
ENDDO
!---> calculate the four components of the matrix potential on
!---> real space mesh
DO imeshpt = 1,ifft3
vup = vis(imeshpt,1)
vdown = vis(imeshpt,2)
theta = den%theta_pw(imeshpt)
phi = den%phi_pw(imeshpt)
!---> at first determine the effective potential and magnetic fields
veff = (vup + vdown)/2.0
beff = (vup - vdown)/2.0
!---> now calculate the matrix potential, which is hermitian.
!---> thus calculate the diagonal elements:
!---> V_11
vis(imeshpt,1) = veff + beff*COS(theta)
!---> V_22
vis(imeshpt,2) = veff - beff*COS(theta)
!---> the real part of V_21
vis(imeshpt,3) = beff*SIN(theta)*COS(phi)
!---> and the imaginary part of V_21
vis(imeshpt,4) = beff*SIN(theta)*SIN(phi)
DO ipot = 1,4
vis2(imeshpt,ipot) = vis(imeshpt,ipot) * stars%ufft(imeshpt-1)
ENDDO
ENDDO
!---> Fouriertransform the matrix potential back to reciprocal space
DO ipot = 1,2
fftwork=0.0
CALL fft3d(vis(:,ipot),fftwork, vTot%pw(1,ipot), stars,-1)
fftwork=0.0
CALL fft3d(vis2(:,ipot),fftwork, vTot%pw_w(1,ipot), stars,-1)
ENDDO
CALL fft3d(vis(:,3),vis(:,4), vTot%pw(1,3), stars,-1)
CALL fft3d(vis2(:,3),vis2(:,4), vTot%pw_w(1,3), stars,-1)
IF (.NOT. input%film) RETURN
!Now the vacuum part starts
ALLOCATE(vvacxy(ifft2,vacuum%nmzxyd,2,4))
!---> fouriertransform the spin up and down potential
!---> in the vacuum, vz & vxy, to real space (vvacxy)
DO jspin = 1,input%jspins
DO ivac = 1,vacuum%nvac
DO imz = 1,vacuum%nmzxyd
vziw = 0.0
!IF (oneD%odi%d1) THEN
IF (.FALSE.) THEN
CALL judft_error("oneD not implemented",calledby="vmatgen")
! CALL fft2d(&
! & oneD%k3,odi%M,odi%n2d,&
! & vvacxy(0,imz,ivac,jspin),fftwork,&
! & vz(imz,ivac,jspin),vziw,vxy(imz,1,ivac,jspin),&
! & vacuum,odi%nq2,odi%kimax2,1,&
! & %igf,odl%pgf,odi%nst2)
ELSE
CALL fft2d(stars, vvacxy(:,imz,ivac,jspin),fftwork,&
vTot%vacz(imz,ivac,jspin),vziw,vTot%vacxy(imz,1,ivac,jspin), vacuum%nmzxyd,1)
ENDIF
ENDDO
ENDDO
ENDDO
!---> calculate the four components of the matrix potential on
!---> real space mesh
DO ivac = 1,vacuum%nvac
DO imz = 1,vacuum%nmzxyd
DO imeshpt = 1,ifft2
vup = vvacxy(imeshpt,imz,ivac,1)
vdown = vvacxy(imeshpt,imz,ivac,2)
theta = den%theta_vacxy(imeshpt,imz,ivac)
phi = den%phi_vacxy(imeshpt,imz,ivac)
veff = (vup + vdown)/2.0
beff = (vup - vdown)/2.0
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
vup = vTot%vacz(imz,ivac,1)
vdown = vTot%vacz(imz,ivac,2)
theta = den%theta_vacz(imz,ivac)
phi = den%phi_vacz(imz,ivac)
veff = (vup + vdown)/2.0
beff = (vup - vdown)/2.0
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
!---> Fouriertransform the matrix potential back to reciprocal space
DO ipot = 1,2
DO ivac = 1,vacuum%nvac
DO imz = 1,vacuum%nmzxyd
fftwork=0.0
!IF (oneD%odi%d1) THEN
IF (.FALSE.) THEN
CALL judft_error("oneD not implemented",calledby="vmatgen")
! CALL fft2d(&
! & oneD%k3,odi%M,odi%n2d,&
! & vvacxy(0,imz,ivac,ipot),fftwork,&
! & vz(imz,ivac,ipot),vziw,vxy(imz,1,ivac,ipot),&
! & vacuum,odi%nq2,odi%kimax2,-1,&
! & %igf,odl%pgf,odi%nst2)
ELSE
CALL fft2d(stars, vvacxy(:,imz,ivac,ipot),fftwork,&
vTot%vacz(imz,ivac,ipot),vziw,vTot%vacxy(imz,1,ivac,ipot), vacuum%nmzxyd,-1)
END IF
ENDDO
ENDDO
ENDDO
DO ivac = 1,vacuum%nvac
DO imz = 1,vacuum%nmzxyd
fftwork=0.0
!IF (oneD%odi%d1) THEN
IF (.FALSE.) THEN
CALL judft_error("oneD not implemented",calledby="vmatgen")
! CALL fft2d(&
! & oneD%k3,odi%M,odi%n2d,&
! & vvacxy(0,imz,ivac,3),vvacxy(0,imz,ivac,4),&
! & vz(imz,ivac,3),vz(imz,ivac,4),vxy(imz,1,ivac,3),&
! & vacuum,odi%nq2,odi%kimax2,-1,&
! & %igf,odl%pgf,odi%nst2)
ELSE
CALL fft2d(stars, vvacxy(:,imz,ivac,3),vvacxy(:,imz,ivac,4),&
vTot%vacz(imz,ivac,3),vTot%vacz(imz,ivac,4),vTot%vacxy(imz,1,ivac,3), vacuum%nmzxyd,-1)
END IF
ENDDO
ENDDO
RETURN
END SUBROUTINE vmatgen
END MODULE m_vmatgen
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