Commit 8f635e0f authored by Matthias Redies's avatar Matthias Redies

Merge branch 'source_free' into 'develop'

Source free merge

See merge request fleur/fleur!32
parents 3fb3098b ab04db50
......@@ -101,7 +101,7 @@ CONTAINS
qtot, qistot
call tmp_potden%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN)
call init_mt_grid(input%jspins, atoms, sphhar, xcpot, sym)
call init_mt_grid(input%jspins, atoms, sphhar, xcpot%needs_grad(), sym)
do n_atm =1,atoms%ntype
call mt_from_grid(atoms, sphhar, n_atm, input%jspins, mt(:,:,n_atm), &
tmp_potden%mt(:,0:,n_atm,:))
......@@ -112,8 +112,8 @@ CONTAINS
enddo
call finish_mt_grid()
call init_pw_grid(xcpot, stars, sym, cell)
call pw_from_grid(xcpot, stars, .False., is, tmp_potden%pw)
call init_pw_grid(xcpot%needs_grad(), stars, sym, cell)
call pw_from_grid(xcpot%needs_grad(), stars, .False., is, tmp_potden%pw)
call finish_pw_grid()
call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, tmp_potden, &
......
......@@ -98,12 +98,13 @@ 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
! local scalars
INTEGER :: eig_id,archiveType, num_threads
INTEGER :: iter,iterHF
INTEGER :: iter,iterHF,i
LOGICAL :: l_opti,l_cont,l_qfix,l_real
REAL :: fix
#ifdef CPP_MPI
......@@ -138,6 +139,9 @@ 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
......@@ -238,7 +242,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)
obsolete,cell,oneD,sliceplot,mpi,results,noco,EnergyDen,inDen,vTot,vx,vCoul,xcB)
CALL timestop("generation of potential")
#ifdef CPP_MPI
......@@ -402,7 +406,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)
!!$ obsolete,cell,oneD,sliceplot,mpi, results,noco,outDen,inDenRot,vTot,vx,vCoul,xcB)
!!$ 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)
obsolete,cell,oneD,sliceplot,mpi,results,noco,EnergyDen,den,vTot,vx,vCoul,xcB)
USE m_types
USE m_rotate_int_den_to_local
......@@ -54,17 +54,25 @@ 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
INTEGER :: i
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',/)
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
#ifndef CPP_OLDINTEL
ALLOCATE(vTot%pw_w,mold=vTot%pw)
#else
......@@ -94,7 +102,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)
CALL vgen_finalize(atoms,stars,vacuum,sym,noco,input,sphhar,vTot,vCoul,denRot,xcB)
!DEALLOCATE(vcoul%pw_w)
CALL bfield(input,noco,atoms,field,vTot)
......
......@@ -12,7 +12,7 @@
!! In addition to overloading the t_xcpot datatype also mpi_bc_xcpot must be adjusted
!! for additional implementations.
MODULE m_types_xcpot
use m_types_potden
USE m_types_potden
IMPLICIT NONE
PRIVATE
PUBLIC :: t_xcpot,t_gradients
......@@ -69,8 +69,8 @@ MODULE m_types_xcpot
REAL,ALLOCATABLE :: laplace(:,:)
END TYPE t_gradients
CONTAINS
subroutine kED_alloc_mt(kED,nsp_x_jmtd, jspins, n_start, n_types, n_stride)
implicit none
SUBROUTINE kED_alloc_mt(kED,nsp_x_jmtd, jspins, n_start, n_types, n_stride)
IMPLICIT NONE
class(t_kinED), intent(inout) :: kED
integer, intent(in) :: nsp_x_jmtd, jspins, n_start, n_types, n_stride
integer :: cnt, n
......
......@@ -48,6 +48,7 @@ vgen/b_field.F90
vgen/write_xcstuff.f90
vgen/xy_av_den.f90
vgen/VYukawaFilm.f90
vgen/divergence.f90
)
#vdW Stuff
set(fleur_F90 ${fleur_F90}
......
!--------------------------------------------------------------------------------
! 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
CONTAINS
SUBROUTINE mt_div(jspins,n,atoms,sphhar,sym,xcB,div)
!-----------------------------------------------------------------------------!
!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
IMPLICIT NONE
INTEGER, INTENT(IN) :: jspins, 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(INOUT) :: xcB
TYPE(t_potden), INTENT(INOUT) :: div
TYPE(t_gradients) :: gradx, grady, gradz
REAL, ALLOCATABLE :: div_temp(:, :)
REAL, ALLOCATABLE :: thet(:), phi(:)
REAL :: r,th,ph
INTEGER :: jr, k, nsp, kt
nsp = atoms%nsp()
ALLOCATE (gradx%gr(3,atoms%jri(n)*nsp,jspins),grady%gr(3,atoms%jri(n)*nsp,jspins),gradz%gr(3,atoms%jri(n)*nsp,jspins))
ALLOCATE (div_temp(atoms%jri(n)*nsp,jspins))
CALL init_mt_grid(jspins, atoms, sphhar, .TRUE., sym)
CALL mt_to_grid(.TRUE., jspins, atoms, sphhar, xcB(1)%mt(:,0:,n,:), n, gradx)
CALL mt_to_grid(.TRUE., jspins, atoms, sphhar, xcB(2)%mt(:,0:,n,:), n, grady)
CALL mt_to_grid(.TRUE., jspins, atoms, sphhar, xcB(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+nsp,1) = (SIN(th)*COS(ph)*gradx%gr(1,kt+nsp,jspins) + SIN(th)*SIN(ph)*grady%gr(1,kt+nsp,jspins) + COS(th)*gradz%gr(1,kt+nsp,jspins))&
+(COS(th)*COS(ph)*gradx%gr(2,kt+nsp,jspins) + COS(th)*SIN(ph)*grady%gr(2,kt+nsp,jspins) - SIN(th)*gradz%gr(2,kt+nsp,jspins))/r&
-(SIN(ph)*gradx%gr(3,kt+nsp,jspins) + COS(ph)*grady%gr(3,kt+nsp,jspins))/(r*SIN(th))
ENDDO ! k
kt = kt+nsp
ENDDO ! jr
CALL mt_from_grid(atoms, sphhar, n, jspins, div_temp, div%mt(:,0:,n,:))
CALL finish_mt_grid
END SUBROUTINE mt_div
SUBROUTINE pw_div(ifftxc3,jspins,stars,cell,noco,sym,xcB,div)
!-----------------------------------------------------------------------------!
!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_pw_tofrom_grid
IMPLICIT NONE
INTEGER, INTENT(IN) :: jspins, ifftxc3
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) :: xcB
TYPE(t_potden), INTENT(INOUT) :: div
TYPE(t_gradients) :: gradx, grady, gradz
REAL, ALLOCATABLE :: div_temp(:, :)
INTEGER :: i, nsp
nsp = 3*ifftxc3
ALLOCATE (gradx%gr(3,nsp,jspins),grady%gr(3,nsp,jspins),gradz%gr(3,nsp,jspins))
ALLOCATE (div_temp(nsp,jspins))
CALL init_pw_grid(.TRUE.,stars,sym,cell)
CALL pw_to_grid(.TRUE.,jspins,noco%l_noco,stars,cell,xcB(1)%pw,gradx)
CALL pw_to_grid(.TRUE.,jspins,noco%l_noco,stars,cell,xcB(2)%pw,grady)
CALL pw_to_grid(.TRUE.,jspins,noco%l_noco,stars,cell,xcB(3)%pw,gradz)
DO i = 1, nsp
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(jspins,n,ifftxc3,atoms,sphhar,sym,stars,cell,vacuum,noco,xcB,div)
USE m_types
IMPLICIT NONE
INTEGER, INTENT(IN) :: jspins, n, ifftxc3
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_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_potden), dimension(3), INTENT(INOUT) :: xcB
TYPE(t_potden), INTENT(OUT) :: div
CALL div%init(stars,atoms,sphhar,vacuum,noco,jspins,1001)
CALL mt_div(jspins,n,atoms,sphhar,sym,xcB,div)
CALL pw_div(ifftxc3,jspins,stars,cell,noco,sym,xcB,div)
END SUBROUTINE divergence
END MODULE m_divergence
......@@ -7,8 +7,8 @@ MODULE m_lhglptg
CONTAINS
SUBROUTINE lhglptg(&
& sphhar,atoms,&
& rx,nsp,xcpot,sym,&
& ylh,thet,ylht1,ylht2,ylhf1,ylhf2,ylhtf)
& rx,nsp,dograds,sym,&
& ylh,thet,phi,ylht1,ylht2,ylhf1,ylhf2,ylhtf)
!
USE m_polangle
USE m_ylm
......@@ -16,7 +16,7 @@ CONTAINS
USE m_types
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN) :: xcpot
LOGICAL, INTENT(IN) :: dograds
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
......@@ -27,6 +27,7 @@ CONTAINS
! .. Array Arguments ..
REAL, INTENT (IN) :: rx(:,:)!(3,dimension%nspd)
REAL, INTENT (OUT):: thet(:) !nspd
REAL, INTENT (OUT):: phi(:) !nspd
REAL, INTENT (OUT):: ylh(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd),thet(nspd)
REAL, INTENT (OUT):: ylht1(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
REAL, INTENT (OUT):: ylht2(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
......@@ -35,7 +36,7 @@ CONTAINS
REAL, INTENT (OUT):: ylhf2(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
! ..
! .. Local Scalars ..
REAL s,st1,st2,sf1,sf2,stf,phi
REAL s,st1,st2,sf1,sf2,stf
INTEGER k,lh,mem,nd,lm,ll1
! ..
! .. Local Arrays ..
......@@ -56,9 +57,9 @@ CONTAINS
& ylm)
CALL pol_angle(&
& rx(1,k),rx(2,k),rx(3,k),&
& thet(k),phi)
& thet(k),phi(k))
IF (xcpot%needs_grad()) THEN
IF (dograds) THEN
CALL dylm3(&
& atoms%lmaxd,atoms%lmaxd,rx(:,k),ylm,&
& dylmt1,dylmt2,dylmf1,dylmf2,dylmtf)
......@@ -80,7 +81,7 @@ CONTAINS
ylh(k,lh,nd) = s
IF (xcpot%needs_grad()) THEN
IF (dograds) THEN
DO mem = 1,sphhar%nmem(lh,nd)
lm = ll1 + sphhar%mlh(mem,lh,nd)
......
......@@ -10,10 +10,10 @@ MODULE m_mt_tofrom_grid
INTEGER, PARAMETER :: ndvgrd = 6 ! this should be consistent across GGA derivative routines
REAL, ALLOCATABLE :: ylh(:, :, :), ylht(:, :, :), ylhtt(:, :, :)
REAL, ALLOCATABLE :: ylhf(:, :, :), ylhff(:, :, :), ylhtf(:, :, :)
REAL, ALLOCATABLE :: wt(:), rx(:, :), thet(:)
REAL, ALLOCATABLE :: wt(:), rx(:, :), thet(:), phi(:)
PUBLIC :: init_mt_grid, mt_to_grid, mt_from_grid, finish_mt_grid
CONTAINS
SUBROUTINE init_mt_grid(jspins, atoms, sphhar, xcpot, sym)
SUBROUTINE init_mt_grid(jspins, atoms, sphhar, dograds, sym)
USE m_gaussp
USE m_lhglptg
USE m_lhglpts
......@@ -21,36 +21,36 @@ CONTAINS
INTEGER, INTENT(IN) :: jspins
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
CLASS(t_xcpot), INTENT(IN) :: xcpot
LOGICAL, INTENT(IN) :: dograds
TYPE(t_sym), INTENT(IN) :: sym
! generate nspd points on a sherical shell with radius 1.0
! angular mesh equidistant in phi,
! theta are zeros of the legendre polynomials
ALLOCATE (wt(atoms%nsp()), rx(3, atoms%nsp()), thet(atoms%nsp()))
ALLOCATE (wt(atoms%nsp()), rx(3, atoms%nsp()), thet(atoms%nsp()), phi(atoms%nsp()))
CALL gaussp(atoms%lmaxd, rx, wt)
! generate the lattice harmonics on the angular mesh
ALLOCATE (ylh(atoms%nsp(), 0:sphhar%nlhd, sphhar%ntypsd))
IF (xcpot%needs_grad()) THEN
IF (dograds) THEN
ALLOCATE (ylht, MOLD=ylh)
ALLOCATE (ylhtt, MOLD=ylh)
ALLOCATE (ylhf, MOLD=ylh)
ALLOCATE (ylhff, MOLD=ylh)
ALLOCATE (ylhtf, MOLD=ylh)
CALL lhglptg(sphhar, atoms, rx, atoms%nsp(), xcpot, sym, &
ylh, thet, ylht, ylhtt, ylhf, ylhff, ylhtf)
CALL lhglptg(sphhar, atoms, rx, atoms%nsp(), dograds, sym, &
ylh, thet, phi, ylht, ylhtt, ylhf, ylhff, ylhtf)
ELSE
CALL lhglpts(sphhar, atoms, rx, atoms%nsp(), sym, ylh)
END IF
!ENDIF
END SUBROUTINE init_mt_grid
SUBROUTINE mt_to_grid(xcpot, jspins, atoms, sphhar, den_mt, n, grad, ch)
SUBROUTINE mt_to_grid(dograds, jspins, atoms, sphhar, den_mt, n, grad, ch)
USE m_grdchlh
USE m_mkgylm
IMPLICIT NONE
CLASS(t_xcpot), INTENT(IN) :: xcpot
LOGICAL, INTENT(IN) :: dograds
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
REAL, INTENT(IN) :: den_mt(:, 0:, :)
......@@ -69,7 +69,7 @@ CONTAINS
ALLOCATE (chlh(atoms%jmtd, 0:sphhar%nlhd, jspins))
ALLOCATE (ch_tmp(nsp, jspins))
IF (xcpot%needs_grad()) THEN
IF (dograds) THEN
ALLOCATE (chdr(nsp, jspins), chdt(nsp, jspins), chdf(nsp, jspins), chdrr(nsp, jspins), &
chdtt(nsp, jspins), chdff(nsp, jspins), chdtf(nsp, jspins), chdrt(nsp, jspins), &
chdrf(nsp, jspins))
......@@ -87,7 +87,7 @@ CONTAINS
DO jr = 1, atoms%jri(n)
chlh(jr, lh, js) = den_mt(jr, lh, js)/(atoms%rmsh(jr, n)*atoms%rmsh(jr, n))
ENDDO
IF (xcpot%needs_grad()) CALL grdchlh(1, 1, atoms%jri(n), atoms%dx(n), atoms%rmsh(1, n), &
IF (dograds) CALL grdchlh(1, 1, atoms%jri(n), atoms%dx(n), atoms%rmsh(1, n), &
chlh(1, lh, js), ndvgrd, chlhdr(1, lh, js), chlhdrr(1, lh, js))
ENDDO ! js
......@@ -106,7 +106,7 @@ CONTAINS
ENDDO
ENDDO
ENDDO
IF (xcpot%needs_grad()) THEN
IF (dograds) THEN
chdr(:, :) = 0.0 ! d(ch)/dr
chdt(:, :) = 0.0 ! d(ch)/dtheta
chdf(:, :) = 0.0 ! d(ch)/dfai
......@@ -185,7 +185,7 @@ CONTAINS
END SUBROUTINE mt_from_grid
SUBROUTINE finish_mt_grid()
DEALLOCATE (ylh, wt, rx, thet)
DEALLOCATE (ylh, wt, rx, thet, phi)
IF (ALLOCATED(ylht)) DEALLOCATE (ylht, ylhtt, ylhf, ylhff, ylhtf)
END SUBROUTINE finish_mt_grid
......
......@@ -15,11 +15,11 @@ MODULE m_pw_tofrom_grid
PUBLIC :: init_pw_grid,pw_to_grid,pw_from_grid,finish_pw_grid
CONTAINS
SUBROUTINE init_pw_grid(xcpot,stars,sym,cell)
SUBROUTINE init_pw_grid(dograds,stars,sym,cell)
USE m_prpxcfftmap
USE m_types
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN) :: xcpot
LOGICAL,INTENT(IN) :: dograds
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
......@@ -34,13 +34,13 @@ CONTAINS
ifftd=27*stars%mx1*stars%mx2*stars%mx3
ifftxc3 = stars%kxc1_fft*stars%kxc2_fft*stars%kxc3_fft
IF (xcpot%needs_grad()) THEN
IF (dograds) THEN
CALL prp_xcfft_map(stars,sym, cell, igxc_fft,gxc_fft)
ENDIF
END SUBROUTINE init_pw_grid
SUBROUTINE pw_to_grid(xcpot,jspins,l_noco,stars,cell,den_pw,grad,rho)
SUBROUTINE pw_to_grid(dograds,jspins,l_noco,stars,cell,den_pw,grad,xcpot,rho)
!.....------------------------------------------------------------------
!-------> abbreviations
!
......@@ -73,16 +73,18 @@ CONTAINS
USE m_fft3dxc
USE m_fft3d
USE m_types
use m_constants
USE m_constants
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN) :: xcpot
LOGICAL,INTENT(IN) :: dograds
INTEGER,INTENT(IN) :: jspins
LOGICAL,INTENT(IN) :: l_noco
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
COMPLEX,INTENT(IN) :: den_pw(:,:)
TYPE(t_gradients),INTENT(OUT) :: grad
REAL,ALLOCATABLE,INTENT(out),OPTIONAL :: rho(:,:)
CLASS(t_xcpot), INTENT(IN),OPTIONAL :: xcpot
REAL,ALLOCATABLE,INTENT(OUT),OPTIONAL :: rho(:,:)
INTEGER :: js,i,idm,ig,ndm,jdm
......@@ -96,7 +98,7 @@ CONTAINS
! Allocate arrays
ALLOCATE( bf3(0:ifftd-1))
IF (xcpot%needs_grad()) THEN
IF (dograds) THEN
IF (PRESENT(rho)) ALLOCATE(rho(0:ifftxc3-1,jspins))
ALLOCATE( ph_wrk(0:ifftxc3-1),rhd1(0:ifftxc3-1,jspins,3))
ALLOCATE( rhd2(0:ifftxc3-1,jspins,6) )
......@@ -104,7 +106,7 @@ CONTAINS
IF (PRESENT(rho)) ALLOCATE(rho(0:ifftd-1,jspins))
ENDIF
IF (l_noco) THEN
IF (xcpot%needs_grad()) THEN
IF (dograds) THEN
ALLOCATE( mx(0:ifftxc3-1),my(0:ifftxc3-1),magmom(0:ifftxc3-1))
ALLOCATE(dmagmom(0:ifftxc3-1,3),ddmagmom(0:ifftxc3-1,3,3) )
ELSE
......@@ -115,7 +117,7 @@ CONTAINS
IF (PRESENT(rho)) THEN
!Put den_pw on grid and store into rho(:,1:2)
DO js=1,jspins
IF (xcpot%needs_grad()) THEN
IF (dograds) THEN
CALL fft3dxc(rho(0:,js),bf3, den_pw(:,js), stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,&
stars%nxc3_fft,stars%kmxxc_fft,+1, stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr)
ELSE
......@@ -125,7 +127,7 @@ CONTAINS
IF (l_noco) THEN
! Get mx,my on real space grid and recalculate rho and magmom
IF (xcpot%needs_grad()) THEN
IF (dograds) THEN
CALL fft3dxc(mx,my, den_pw(:,3), stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,&
stars%nxc3_fft,stars%kmxxc_fft,+1, stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr)
ELSE
......@@ -139,7 +141,7 @@ CONTAINS
END DO
ENDIF
ENDIF
IF (xcpot%needs_grad()) THEN
IF (dograds) THEN
! In collinear calculations all derivatives are calculated in g-spce,
! in non-collinear calculations the derivatives of |m| are calculated in real space.
......@@ -215,7 +217,10 @@ CONTAINS
ENDDO !jdm
ENDDO !idm
END IF
IF (PRESENT(xcpot)) THEN
CALL xcpot%alloc_gradients(ifftxc3,jspins,grad)
END IF
!
! calculate the quantities such as abs(grad(rho)),.. used in
......@@ -238,12 +243,12 @@ CONTAINS
END SUBROUTINE pw_to_grid
SUBROUTINE pw_from_grid(xcpot,stars,l_pw_w,v_in,v_out_pw,v_out_pw_w)
SUBROUTINE pw_from_grid(dograds,stars,l_pw_w,v_in,v_out_pw,v_out_pw_w)
USE m_fft3d
USE m_fft3dxc
USE m_types
IMPLICIT NONE
CLASS(t_xcpot),INTENT(in) :: xcpot
LOGICAL,INTENT(IN) :: dograds
TYPE(t_stars),INTENT(IN) :: stars
REAL,INTENT(INOUT) :: v_in(0:,:)
LOGICAL,INTENT(in) :: l_pw_w
......@@ -258,19 +263,19 @@ CONTAINS
ALLOCATE ( vcon(0:ifftd-1) )
DO js = 1,SIZE(v_in,2)
bf3=0.0
IF (xcpot%needs_grad()) THEN
IF (dograds) THEN
CALL fft3dxc(v_in(0:,js),bf3, fg3, stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,&
stars%nxc3_fft,stars%kmxxc_fft,-1, stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr)
ELSE
vcon(0:)=v_in(0:,js)
CALL fft3d(v_in(0:,js),bf3, fg3, stars,-1)
ENDIF
DO k = 1,MERGE(stars%nxc3_fft,stars%ng3,xcpot%needs_grad())
DO k = 1,MERGE(stars%nxc3_fft,stars%ng3,dograds)
v_out_pw(k,js) = v_out_pw(k,js) + fg3(k)
ENDDO
IF (l_pw_w) THEN
IF (xcpot%needs_grad()) THEN
IF (dograds) THEN
!----> Perform fft transform: v_xc(star) --> vxc(r)
! !Use large fft mesh for convolution
fg3(stars%nxc3_fft+1:)=0.0
......
......@@ -21,7 +21,7 @@ CONTAINS
TYPE(t_xcpot_inbuild) :: xcpot !local xcpot that is LDA to indicate we do not need gradients
TYPE(t_gradients) :: grad
INTEGER :: n,nsp,imesh,i
INTEGER :: n,nsp,imesh,i,b_ind
REAL :: rho_11,rho_22,rho_21r,rho_21i,mx,my,mz,magmom
REAL :: rhotot,rho_up,rho_down,theta,phi
REAL,ALLOCATABLE :: ch(:,:)
......@@ -32,9 +32,9 @@ CONTAINS
den%phi_mt(nsp*atoms%jmtd,atoms%ntype))
CALL xcpot%init("vwn",.FALSE.,1)
CALL init_mt_grid(4,atoms,sphhar,xcpot,sym)
CALL init_mt_grid(4,atoms,sphhar,xcpot%needs_grad(),sym)
DO n=1,atoms%ntype
CALL mt_to_grid(xcpot,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,grad,ch)
DO imesh = 1,nsp*atoms%jri(n)
rho_11 = ch(imesh,1)
......@@ -89,13 +89,13 @@ 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,vtot,xcB)
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