Skip to content

GitLab

fleur
fleur
Commit 3ddb201b authored by Robin Hilgers's avatar Robin Hilgers
Browse files
Options

Fully fully noco not working (temporarily) with LDA anymore after this commit.... 

Fully fully noco not working (temporarily) with LDA anymore after this commit. Preparations to fix GGA which has never been working with fully fully noco.
parent 16b18e8b
Hide whitespace changes
Inline Side-by-side
Showing with 40 additions and 656 deletions
cdn_mt/alignSpinAxisMagn.f90
View file @ 3ddb201b
......@@ -46,24 +46,24 @@ SUBROUTINE rotateMagnetToSpinAxis(vacuum,sphhar,stars&
! atoms%theta_mt_avg(i)=0.0
! END IF
! END DO
write(*,*) "mx1"
write(*,*) moments(1,1)
write(*,*) "mz1"
write(*,*) moments(1,3)
write(*,*) "mx2"
write(*,*) moments(2,1)
write(*,*) "mz2"
write(*,*) moments(2,3)
!write(*,*) "mx1"
!write(*,*) moments(1,1)
!write(*,*) "mz1"
!write(*,*) moments(1,3)
!write(*,*) "mx2"
!write(*,*) moments(2,1)
!write(*,*) "mz2"
!write(*,*) moments(2,3)
CALL flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell,-atoms%phi_mt_avg,-atoms%theta_mt_avg,den)
!write (*,*)"mx my mz"
!CALL sphericaltocart(SQRT(moments(1,1)**2+moments(1,2)**2+moments(1,3)**2),thetaTemp(1),phiTemp(1),x,y,z)
!write(*,*) x,y,z
!CALL sphericaltocart(SQRT(moments(2,1)**2+moments(2,2)**2+moments(2,3)**2),thetaTemp(2),phiTemp(2),x,y,z)
!write(*,*) x,y,z
write(*,*) "atoms%phi_mt_avg"
write(*,*) atoms%phi_mt_avg
write(*,*) "atoms%theta_mt_avg"
write(*,*) atoms%theta_mt_avg
!write(*,*) "atoms%phi_mt_avg"
!!write(*,*) atoms%phi_mt_avg
!write(*,*) "atoms%theta_mt_avg"
!write(*,*) atoms%theta_mt_avg
noco%alph=mod(atoms%phi_mt_avg+phiTemp,2*pimach())
noco%beta=mod(atoms%theta_mt_avg+thetaTemp,2*pimach())
atoms%phi_mt_avg=noco%alph
......
cdn_mt/magnMomFromDen.f90
View file @ 3ddb201b
......@@ -28,7 +28,6 @@ SUBROUTINE magnMomFromDen(input,atoms,noco,den,moments)
INTEGER :: jsp,i,j
REAL :: mx,my,mz
REAL :: eps=1E-14
REAL, ALLOCATABLE :: dummyResults(:,:)
......
main/vgen.F90
View file @ 3ddb201b
......@@ -89,7 +89,7 @@ CONTAINS
CALL denRot%init(stars,atoms,sphhar,vacuum,noco,input%jspins,0)
denRot=den
CALL rotate_int_den_to_local(DIMENSION,sym,stars,atoms,sphhar,vacuum,cell,input,noco,oneD,denRot)
IF (noco%l_mtnocoPot) CALL rotate_mt_den_to_local(atoms,sphhar,sym,denrot)
IF (noco%l_mtnocoPot) CALL rotate_mt_den_to_local(atoms,sphhar,sym,noco,denrot)
ENDIF
CALL vgen_xcpot(hybrid,input,xcpot,dimension,atoms,sphhar,stars,vacuum,sym,&
......
vgen/CMakeLists.txt
View file @ 3ddb201b
......@@ -48,8 +48,6 @@ vgen/b_field.F90
vgen/write_xcstuff.f90
vgen/xy_av_den.f90
vgen/VYukawaFilm.f90
vgen/divergence.f90
vgen/xcBfield.f90
)
#vdW Stuff
set(fleur_F90 ${fleur_F90}
......
vgen/divergence.f90 deleted 100644 → 0
View file @ 16b18e8b
!--------------------------------------------------------------------------------
! Copyright (c) 2019 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_divergence
USE m_types
PRIVATE
PUBLIC :: mt_div, pw_div, divergence, mt_grad, pw_grad, divpotgrad
CONTAINS
SUBROUTINE mt_div(n,atoms,sphhar,sym,bxc,div)
USE m_mt_tofrom_grid
!--------------------------------------------------------------------------
!By use of the cartesian components of a field, its radial/angular derivati-
!ves in the muffin tin at each spherical grid point and the corresponding an-
!gles:
!
!Make the divergence of said field in real space and store it as a source
!density, again represented by mt-coefficients in a potden.
!
!Code by A. Neukirchen, September 2019
!--------------------------------------------------------------------------
IMPLICIT NONE
INTEGER, INTENT(IN) :: n
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_potden), DIMENSION(3), INTENT(IN) :: bxc
TYPE(t_potden), INTENT(INOUT) :: div
TYPE(t_gradients) :: gradx, grady, gradz
REAL, ALLOCATABLE :: thet(:), phi(:), div_temp(:, :), div_temp2(:, :)
REAL :: r, th, ph, eps
INTEGER :: jr, k, nsp, kt, i, lh, lhmax
nsp = atoms%nsp()
lhmax=sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n - 1)) + 1))
eps=1.e-10
ALLOCATE (gradx%gr(3,atoms%jri(n)*nsp,1),grady%gr(3,atoms%jri(n)*nsp,1), &
gradz%gr(3,atoms%jri(n)*nsp,1))
ALLOCATE (div_temp(atoms%jri(n)*nsp,1))
ALLOCATE (div_temp2(atoms%jri(n)*nsp,1))
ALLOCATE (thet(atoms%nsp()),phi(atoms%nsp()))
CALL init_mt_grid(1, atoms, sphhar, .TRUE., sym, thet, phi)
CALL mt_to_grid(.TRUE., 1, atoms, sphhar, bxc(1)%mt(:,0:,n,:), n, gradx)
CALL mt_to_grid(.TRUE., 1, atoms, sphhar, bxc(2)%mt(:,0:,n,:), n, grady)
CALL mt_to_grid(.TRUE., 1, atoms, sphhar, bxc(3)%mt(:,0:,n,:), n, gradz)
kt = 0
DO jr = 1, atoms%jri(n)
r =atoms%rmsh(jr, n)
DO k = 1, nsp
th = thet(k)
ph = phi(k)
div_temp(kt+k,1) = (SIN(th)*COS(ph)*gradx%gr(1,kt+k,1) + SIN(th)*SIN(ph)*grady%gr(1,kt+k,1) + COS(th)*gradz%gr(1,kt+k,1))&
+(COS(th)*COS(ph)*gradx%gr(2,kt+k,1) + COS(th)*SIN(ph)*grady%gr(2,kt+k,1) - SIN(th)*gradz%gr(2,kt+k,1))/r&
-(SIN(ph)*gradx%gr(3,kt+k,1) - COS(ph)*grady%gr(3,kt+k,1))/(r*SIN(th))
ENDDO ! k
kt = kt+nsp
ENDDO ! jr
CALL mt_from_grid(atoms, sphhar, n, 1, div_temp, div%mt(:,0:,n,:))
DO jr = 1, atoms%jri(n)
DO lh=0, lhmax
IF (ABS(div%mt(jr,lh,n,1))<eps) THEN
div%mt(jr,lh,n,:)=0.0
END IF
END DO
END DO
kt = 0
DO jr = 1, atoms%jri(n)
r =atoms%rmsh(jr, n)
div%mt(jr,0:,n,:) = div%mt(jr,0:,n,:)*r**2
kt = kt+nsp
ENDDO ! jr
CALL mt_to_grid(.FALSE., 1, atoms, sphhar, div%mt(:,0:,n,:), n, gradx, div_temp2)
CALL finish_mt_grid
END SUBROUTINE mt_div
SUBROUTINE pw_div(stars,sym,cell,noco,bxc,div)
USE m_pw_tofrom_grid
!--------------------------------------------------------------------------
!By use of the cartesian components of a field and its cartesian derivatives
!in the interstitial/vacuum region at each grid point:
!
!Make the divergence of said field in real space and store it as a source
!density, again represented by pw-coefficients in a potden.
!
!Code by A. Neukirchen, September 2019
!--------------------------------------------------------------------------
IMPLICIT NONE
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_potden), DIMENSION(3), INTENT(IN) :: bxc
TYPE(t_potden), INTENT(INOUT) :: div
TYPE(t_gradients) :: gradx,grady,gradz
REAL, ALLOCATABLE :: div_temp(:, :)
INTEGER :: i,ifftxc3
ifftxc3=stars%kxc1_fft*stars%kxc2_fft*stars%kxc3_fft
ALLOCATE (div_temp(ifftxc3,1))
CALL init_pw_grid(.TRUE.,stars,sym,cell)
CALL pw_to_grid(.TRUE.,1,.FALSE.,stars,cell,bxc(1)%pw,gradx)
CALL pw_to_grid(.TRUE.,1,.FALSE.,stars,cell,bxc(2)%pw,grady)
CALL pw_to_grid(.TRUE.,1,.FALSE.,stars,cell,bxc(3)%pw,gradz)
DO i = 1, ifftxc3
div_temp(i,1)=gradx%gr(1,i,1)+grady%gr(2,i,1)+gradz%gr(3,i,1)
ENDDO ! i
CALL pw_from_grid(.TRUE.,stars,.TRUE.,div_temp,div%pw,div%pw_w)
CALL finish_pw_grid()
END SUBROUTINE pw_div
SUBROUTINE divergence(stars,atoms,sphhar,vacuum,sym,cell,noco,bxc,div)
!--------------------------------------------------------------------------
! Use the two divergence subroutines above to now put the complete diver-
! gence of a field into a t_potden variable.
!--------------------------------------------------------------------------
IMPLICIT NONE
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_potden), DIMENSION(3), INTENT(IN) :: bxc
TYPE(t_potden), INTENT(INOUT) :: div
INTEGER :: n
DO n=1,atoms%ntype
CALL mt_div(n,atoms,sphhar,sym,bxc,div)
END DO
CALL pw_div(stars,sym,cell,noco,bxc,div)
END SUBROUTINE divergence
SUBROUTINE mt_grad(n,atoms,sphhar,sym,den,gradphi)
!-----------------------------------------------------------------------------
!By use of the cartesian components of a field, its radial/angular derivati-
!ves in the muffin tin at each spherical grid point and the corresponding an-
!gles:
!
!Make the divergence of said field in real space and store it as a source
!density, again represented by mt-coefficients in a potden.
!
!Code by A. Neukirchen, September 2019
!-----------------------------------------------------------------------------
USE m_mt_tofrom_grid
USE m_constants
IMPLICIT NONE
INTEGER, INTENT(IN) :: n
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), dimension(3), INTENT(INOUT) :: gradphi
TYPE(t_gradients) :: grad
REAL, ALLOCATABLE :: thet(:), phi(:), grad_temp(:, :, :)
REAL :: r, th, ph, eps
INTEGER :: i, jr, k, nsp, kt, lh, lhmax
nsp = atoms%nsp()
lhmax=sphhar%nlh(atoms%ntypsy(SUM(atoms%neq(:n - 1)) + 1))
eps=1.e-10
ALLOCATE (grad%gr(3,atoms%jri(n)*nsp,1))
ALLOCATE (grad_temp(atoms%jri(n)*nsp,1,3))
ALLOCATE (thet(atoms%nsp()),phi(atoms%nsp()))
CALL init_mt_grid(1, atoms, sphhar, .TRUE., sym, thet, phi)
CALL mt_to_grid(.TRUE., 1, atoms, sphhar, den%mt(:,0:,n,:), n, grad)
kt = 0
DO jr = 1, atoms%jri(n)
r=atoms%rmsh(jr, n)
DO k = 1, nsp
th = thet(k)
ph = phi(k)
grad_temp(kt+k,1,1) = (SIN(th)*COS(ph)*grad%gr(1,kt+k,1) + COS(th)*COS(ph)*grad%gr(2,kt+k,1)/r - SIN(ph)*grad%gr(3,kt+k,1)/(r*SIN(th)))/(4.0*pi_const)
grad_temp(kt+k,1,2) = (SIN(th)*SIN(ph)*grad%gr(1,kt+k,1) + COS(th)*SIN(ph)*grad%gr(2,kt+k,1)/r + COS(ph)*grad%gr(3,kt+k,1)/(r*SIN(th)))/(4.0*pi_const)
grad_temp(kt+k,1,3) = ( COS(th)*grad%gr(1,kt+k,1) - SIN(th)*grad%gr(2,kt+k,1)/r )/(4.0*pi_const)
ENDDO ! k
kt = kt+nsp
ENDDO ! jr
DO i=1,3
CALL mt_from_grid(atoms, sphhar, n, 1, grad_temp(:,:,i), gradphi(i)%mt(:,0:,n,:))
DO lh=0, lhmax
gradphi(i)%mt(:,lh,n,1) = gradphi(i)%mt(:,lh,n,1)*atoms%rmsh(:, n)**2
END DO ! lh
END DO ! i
CALL finish_mt_grid
END SUBROUTINE mt_grad
SUBROUTINE pw_grad(stars,cell,noco,sym,den,gradphi)
!-----------------------------------------------------------------------------
!By use of the cartesian components of a field and its cartesian derivatives
!in the interstitial/vacuum region at each grid point:
!
!Make the divergence of said field in real space and store it as a source
!density, again represented by pw-coefficients in a potden.
!
!Code by A. Neukirchen, September 2019
!-----------------------------------------------------------------------------
USE m_constants
USE m_pw_tofrom_grid
IMPLICIT NONE
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden), dimension(3), INTENT(INOUT) :: gradphi
TYPE(t_potden), INTENT(IN) :: den
TYPE(t_gradients) :: grad
REAL, ALLOCATABLE :: grad_temp(:, :, :)
INTEGER :: i,ifftxc3
ifftxc3=stars%kxc1_fft*stars%kxc2_fft*stars%kxc3_fft
ALLOCATE (grad_temp(ifftxc3,1,3))
CALL init_pw_grid(.TRUE.,stars,sym,cell)
CALL pw_to_grid(.TRUE.,1,.FALSE.,stars,cell,den%pw,grad)
DO i = 1, ifftxc3
grad_temp(i,1,:)=grad%gr(:,i,1)/(4.0*pi_const)
ENDDO ! i
DO i=1,3
CALL pw_from_grid(.TRUE.,stars,.TRUE.,grad_temp(:,:,i),gradphi(i)%pw,gradphi(i)%pw_w)
END DO
CALL finish_pw_grid()
END SUBROUTINE pw_grad
SUBROUTINE divpotgrad(stars,atoms,sphhar,vacuum,sym,cell,noco,pot,grad)
USE m_types
USE m_constants
USE m_mt_tofrom_grid
IMPLICIT NONE
!-----------------------------------------------------------------------------
!Use the two gradient subroutines above to now put the complete gradient
!of a potential into a t_potden variable.
!-----------------------------------------------------------------------------
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_potden), INTENT(IN) :: pot
TYPE(t_potden), dimension(3), INTENT(INOUT) :: grad
INTEGER :: n
DO n=1,atoms%ntype
CALL mt_grad(n,atoms,sphhar,sym,pot,grad)
END DO
CALL pw_grad(stars,cell,noco,sym,pot,grad)
END SUBROUTINE divpotgrad
END MODULE m_divergence
vgen/mt_tofrom_grid.F90
View file @ 3ddb201b
......@@ -53,7 +53,7 @@ CONTAINS
!ENDIF
END SUBROUTINE init_mt_grid
SUBROUTINE mt_to_grid(dograds, jspins, atoms, sphhar, den_mt, n, grad, ch)
SUBROUTINE mt_to_grid(dograds, jspins, atoms, sphhar, den_mt, n, noco ,grad, ch)
USE m_grdchlh
USE m_mkgylm
IMPLICIT NONE
......@@ -64,6 +64,7 @@ CONTAINS
INTEGER, INTENT(IN) :: n, jspins
REAL, INTENT(OUT), OPTIONAL :: ch(:, :)
TYPE(t_gradients), INTENT(INOUT):: grad
TYPE(t_noco), INTENT(IN) :: noco
REAL, ALLOCATABLE :: chlh(:, :, :), chlhdr(:, :, :), chlhdrr(:, :, :)
REAL, ALLOCATABLE :: chdr(:, :), chdt(:, :), chdf(:, :), ch_tmp(:, :)
......
vgen/rotate_mt_den_tofrom_local.f90
View file @ 3ddb201b
......@@ -12,10 +12,11 @@ MODULE m_rotate_mt_den_tofrom_local
use m_mt_tofrom_grid
IMPLICIT NONE
CONTAINS
SUBROUTINE rotate_mt_den_to_local(atoms,sphhar,sym,den)
SUBROUTINE rotate_mt_den_to_local(atoms,sphhar,sym,noco,den)
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_potden),INTENT(INOUT) :: den
......@@ -35,7 +36,7 @@ CONTAINS
CALL init_mt_grid(4,atoms,sphhar,xcpot%needs_grad(),sym)
DO n=1,atoms%ntype
CALL mt_to_grid(xcpot%needs_grad(),4,atoms,sphhar,den%mt(:,0:,n,:),n,grad,ch)
CALL mt_to_grid(xcpot%needs_grad(),4,atoms,sphhar,den%mt(:,0:,n,:),n,noco,grad,ch)
DO imesh = 1,nsp*atoms%jri(n)
rho_11 = ch(imesh,1)
......@@ -66,11 +67,12 @@ CONTAINS
CALL finish_mt_grid()
END SUBROUTINE rotate_mt_den_to_local
SUBROUTINE rotate_mt_den_from_local(atoms,sphhar,sym,den,vtot)
SUBROUTINE rotate_mt_den_from_local(atoms,sphhar,sym,den,noco,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_noco),INTENT(IN) :: noco
TYPE(t_potden),INTENT(INOUT) :: vtot
TYPE(t_xcpot_inbuild) :: xcpot !local xcpot that is LDA to indicate we do not need gradients
......@@ -91,7 +93,7 @@ CONTAINS
vtot%mt(i,:,n,:)=vtot%mt(i,:,n,:)*atoms%rmsh(i,n)**2
ENDDO
CALL mt_to_grid(xcpot%needs_grad(),4,atoms,sphhar,vtot%mt(:,0:,n,:),n,grad,ch)
CALL mt_to_grid(xcpot%needs_grad(),4,atoms,sphhar,vtot%mt(:,0:,n,:),n,noco,grad,ch)
DO imesh = 1,nsp*atoms%jri(n)
vup = ch(imesh,1)
vdown = ch(imesh,2)
......
vgen/vgen_finalize.F90
View file @ 3ddb201b
......@@ -43,7 +43,7 @@ CONTAINS
ELSEIF(noco%l_noco) THEN
CALL vmatgen(stars,atoms,vacuum,sym,input,denRot,vTot)
IF (noco%l_mtnocoPot) THEN
CALL rotate_mt_den_from_local(atoms,sphhar,sym,denRot,vtot)
CALL rotate_mt_den_from_local(atoms,sphhar,sym,denRot,noco,vtot)
END IF
ENDIF
......
vgen/vgen_xcpot.F90
View file @ 3ddb201b
......@@ -135,13 +135,10 @@ CONTAINS
CALL timestart("Vxc in MT")
END IF
IF (noco%l_mtNocoPot) THEN
CALL vmt_xc(mpi, sphhar, atoms, denRot, xcpot, input, sym, &
EnergyDen, vTot, vx, exc)
ELSE
CALL vmt_xc(mpi, sphhar, atoms, den, xcpot, input, sym, &
EnergyDen, vTot, vx, exc)
END IF
EnergyDen, noco,vTot, vx, exc)
! add MT EXX potential to vr
IF (mpi%irank == 0) THEN
CALL timestop("Vxc in MT")
......
vgen/vmt_xc.F90
View file @ 3ddb201b
......@@ -24,7 +24,7 @@
CONTAINS
SUBROUTINE vmt_xc(mpi,sphhar,atoms,&
den,xcpot,input,sym,EnergyDen,vTot,vx,exc)
den,xcpot,input,sym,EnergyDen,noco,vTot,vx,exc)
#include"cpp_double.h"
use m_libxc_postprocess_gga
USE m_mt_tofrom_grid
......@@ -41,6 +41,7 @@
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: den,EnergyDen
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_potden),INTENT(INOUT) :: vTot,vx,exc
#ifdef CPP_MPI
include "mpif.h"
......@@ -105,7 +106,7 @@
call xcpot%kinED%alloc_mt(nsp*atoms%jmtd,input%jspins, n_start, atoms%ntype, n_stride)
DO n = n_start,atoms%ntype,n_stride
loc_n = loc_n + 1
CALL mt_to_grid(xcpot%needs_grad(), input%jspins, atoms,sphhar,den%mt(:,0:,n,:),n,grad,ch)
CALL mt_to_grid(xcpot%needs_grad(), input%jspins, atoms,sphhar,den%mt(:,0:,n,:),n,noco,grad,ch)
!
! calculate the ex.-cor. potential
......@@ -133,7 +134,7 @@
ENDIF
!Add postprocessing for libxc
IF (l_libxc.AND.xcpot%needs_grad()) CALL libxc_postprocess_gga_mt(xcpot,atoms,sphhar,n,v_xc,grad, atom_num=n)
IF (l_libxc.AND.xcpot%needs_grad()) CALL libxc_postprocess_gga_mt(xcpot,atoms,sphhar,noco,n,v_xc,grad, atom_num=n)
CALL mt_from_grid(atoms,sphhar,n,input%jspins,v_xc,vTot%mt(:,0:,n,:))
CALL mt_from_grid(atoms,sphhar,n,input%jspins,v_x,vx%mt(:,0:,n,:))
......
vgen/xcBfield.f90 deleted 100644 → 0
View file @ 16b18e8b
!--------------------------------------------------------------------------------
! Copyright (c) 2019 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_xcBfield
USE m_types
USE m_constants
USE m_plot
USE m_divergence
!-----------------------------------------------------------------------------
! When finished, this module will contain all the operations on exchange-cor-
! relation B-fields, that are currenlty done in fleur.F90 after the scf-loop.
! This way, the whole modification towards source-free fields can be done by
! one call, either as a postprocess test or in the scf-loop to achieve self-
! consistent source-free fields.
!-----------------------------------------------------------------------------
PUBLIC :: makeBxc, sourcefree, builddivtest
CONTAINS
SUBROUTINE makeBxc(stars,atoms,sphhar,vacuum,input,noco,vTot,bxc)
! Contructs the exchange-correlation magnetic field from the total poten-
! tial matrix. Only used for the implementation of source free fields and
! therefore only applicable in a fully non-collinear description of magne-
! tism.
!
! Assumes the following form for the potential matrix:
! V_mat = V*Id_(2x2) + sigma_vec*B_vec
!
! B_vec is saved as a density type with an additional r^2-factor.
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_input), INTENT(IN) :: input
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_potden), INTENT(IN) :: vTot
TYPE(t_potden), DIMENSION(3), INTENT(OUT) :: bxc
TYPE(t_potden), DIMENSION(4) :: dummyDen
INTEGER :: i, itype, ir
REAL :: r2
! Initialize and fill a dummy density array, that takes the initial result
! of matrixsplit.
DO i=1, 4
CALL dummyDen(i)%init_potden_simple(stars%ng3,atoms%jmtd,sphhar%nlhd, &
atoms%ntype,atoms%n_u,1,.FALSE.,.FALSE., &
POTDEN_TYPE_POTTOT,vacuum%nmzd,vacuum%nmzxyd,stars%ng2)
ALLOCATE(dummyDen(i)%pw_w,mold=dummyDen(i)%pw)
ENDDO
CALL matrixsplit(stars,atoms,sphhar,vacuum,input,noco,2.0,vtot, &
dummyDen(1),dummyDen(2),dummyDen(3),dummyDen(4))
! Initialize and fill the magnetic field.
DO itype=1,atoms%ntype
DO ir=1,atoms%jri(itype)
r2=atoms%rmsh(ir,itype)**2
DO i=1,3
CALL bxc(i)%init_potden_simple(stars%ng3,atoms%jmtd,sphhar%nlhd, &
atoms%ntype,atoms%n_u,1,.FALSE.,.FALSE., &
POTDEN_TYPE_POTTOT,vacuum%nmzd,vacuum%nmzxyd,stars%ng2)
ALLOCATE(bxc(i)%pw_w,mold=bxc(i)%pw)
bxc(i)%mt(:,0:,:,:) = dummyDen(i+1)%mt(:,0:,:,:)
bxc(i)%pw(1:,:) = dummyDen(i+1)%pw(1:,:)
bxc(i)%vacz(1:,1:,:) = dummyDen(i+1)%vacz(1:,1:,:)
bxc(i)%vacxy(1:,1:,1:,:) = dummyDen(i+1)%vacxy(1:,1:,1:,:)
ENDDO
END DO
END DO
END SUBROUTINE makeBxc
SUBROUTINE sourcefree(mpi,dimension,field,stars,atoms,sphhar,vacuum,input,oneD,sym,cell,noco,bxc)
USE m_vgen_coulomb
! Takes a vectorial quantity, i.e. a t_potden variable of dimension 3, and
! makes it into a source free vector field as follows:
!
! a) Build the divergence d of the vector field A_vec as d=nabla_vec*A_vec.
! b) Solve the Poisson equation (nabla_vec*nabla_vec)phi=-4*pi*d.
! c) Construct an auxiliary vector field C_vec=(nabla_vec phi)/(4*pi).
! d) Build A_vec_sf=A_vec+C_vec, which is source free by construction.
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_field), INTENT(INOUT) :: field
TYPE(t_stars), INTENT(IN) :: stars