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 ...@@ -101,7 +101,7 @@ CONTAINS
qtot, qistot qtot, qistot
call tmp_potden%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN) 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 do n_atm =1,atoms%ntype
call mt_from_grid(atoms, sphhar, n_atm, input%jspins, mt(:,:,n_atm), & call mt_from_grid(atoms, sphhar, n_atm, input%jspins, mt(:,:,n_atm), &
tmp_potden%mt(:,0:,n_atm,:)) tmp_potden%mt(:,0:,n_atm,:))
...@@ -112,8 +112,8 @@ CONTAINS ...@@ -112,8 +112,8 @@ CONTAINS
enddo enddo
call finish_mt_grid() call finish_mt_grid()
call init_pw_grid(xcpot, stars, sym, cell) call init_pw_grid(xcpot%needs_grad(), stars, sym, cell)
call pw_from_grid(xcpot, stars, .False., is, tmp_potden%pw) call pw_from_grid(xcpot%needs_grad(), stars, .False., is, tmp_potden%pw)
call finish_pw_grid() call finish_pw_grid()
call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, tmp_potden, & call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, tmp_potden, &
......
...@@ -98,12 +98,13 @@ CONTAINS ...@@ -98,12 +98,13 @@ CONTAINS
TYPE(t_wann) :: wann TYPE(t_wann) :: wann
TYPE(t_potden) :: vTot, vx, vCoul, vTemp TYPE(t_potden) :: vTot, vx, vCoul, vTemp
TYPE(t_potden) :: inDen, outDen, EnergyDen TYPE(t_potden) :: inDen, outDen, EnergyDen
TYPE(t_potden), dimension(3):: xcB
CLASS(t_xcpot), ALLOCATABLE :: xcpot CLASS(t_xcpot), ALLOCATABLE :: xcpot
CLASS(t_forcetheo), ALLOCATABLE :: forcetheo CLASS(t_forcetheo), ALLOCATABLE :: forcetheo
! local scalars ! local scalars
INTEGER :: eig_id,archiveType, num_threads INTEGER :: eig_id,archiveType, num_threads
INTEGER :: iter,iterHF INTEGER :: iter,iterHF,i
LOGICAL :: l_opti,l_cont,l_qfix,l_real LOGICAL :: l_opti,l_cont,l_qfix,l_real
REAL :: fix REAL :: fix
#ifdef CPP_MPI #ifdef CPP_MPI
...@@ -138,6 +139,9 @@ CONTAINS ...@@ -138,6 +139,9 @@ CONTAINS
! Initialize and load inDen density (start) ! Initialize and load inDen density (start)
CALL inDen%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN) 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 archiveType = CDN_ARCHIVE_TYPE_CDN1_const
IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const
IF(mpi%irank.EQ.0) THEN IF(mpi%irank.EQ.0) THEN
...@@ -238,7 +242,7 @@ CONTAINS ...@@ -238,7 +242,7 @@ CONTAINS
CALL timestart("generation of potential") CALL timestart("generation of potential")
CALL vgen(hybrid,field,input,xcpot,DIMENSION,atoms,sphhar,stars,vacuum,sym,& 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") CALL timestop("generation of potential")
#ifdef CPP_MPI #ifdef CPP_MPI
...@@ -402,7 +406,7 @@ CONTAINS ...@@ -402,7 +406,7 @@ CONTAINS
!!$ input%total = .FALSE. !!$ input%total = .FALSE.
!!$ CALL timestart("generation of potential (total)") !!$ CALL timestart("generation of potential (total)")
!!$ CALL vgen(hybrid,reap,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,sym,& !!$ 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 timestop("generation of potential (total)")
!!$ !!$
!!$ CALL potdis(stars,vacuum,atoms,sphhar, input,cell,sym) !!$ CALL potdis(stars,vacuum,atoms,sphhar, input,cell,sym)
......
...@@ -20,7 +20,7 @@ CONTAINS ...@@ -20,7 +20,7 @@ CONTAINS
!! TE_EXC : charge density-ex-corr.energy density integral !! TE_EXC : charge density-ex-corr.energy density integral
SUBROUTINE vgen(hybrid,field,input,xcpot,DIMENSION,atoms,sphhar,stars,vacuum,sym,& 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_types
USE m_rotate_int_den_to_local USE m_rotate_int_den_to_local
...@@ -54,17 +54,25 @@ CONTAINS ...@@ -54,17 +54,25 @@ CONTAINS
TYPE(t_potden), INTENT(IN) :: EnergyDen TYPE(t_potden), INTENT(IN) :: EnergyDen
TYPE(t_potden), INTENT(INOUT) :: den TYPE(t_potden), INTENT(INOUT) :: den
TYPE(t_potden), INTENT(INOUT) :: vTot,vx,vCoul TYPE(t_potden), INTENT(INOUT) :: vTot,vx,vCoul
TYPE(t_potden),dimension(3),INTENT(INOUT) :: xcB
TYPE(t_potden) :: workden,denRot TYPE(t_potden) :: workden,denRot
INTEGER :: i
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',/) 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 vTot%resetPotDen()
CALL vCoul%resetPotDen() CALL vCoul%resetPotDen()
CALL vx%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) ALLOCATE(vx%pw_w,mold=vTot%pw)
vx%pw_w = 0.0 vx%pw_w = 0.0
#ifndef CPP_OLDINTEL #ifndef CPP_OLDINTEL
ALLOCATE(vTot%pw_w,mold=vTot%pw) ALLOCATE(vTot%pw_w,mold=vTot%pw)
#else #else
...@@ -94,7 +102,7 @@ CONTAINS ...@@ -94,7 +102,7 @@ CONTAINS
obsolete,cell,oneD,sliceplot,mpi,noco,den,denRot,EnergyDen,vTot,vx,results) obsolete,cell,oneD,sliceplot,mpi,noco,den,denRot,EnergyDen,vTot,vx,results)
!ToDo, check if this is needed for more potentials as well... !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) !DEALLOCATE(vcoul%pw_w)
CALL bfield(input,noco,atoms,field,vTot) CALL bfield(input,noco,atoms,field,vTot)
......
...@@ -12,7 +12,7 @@ ...@@ -12,7 +12,7 @@
!! In addition to overloading the t_xcpot datatype also mpi_bc_xcpot must be adjusted !! In addition to overloading the t_xcpot datatype also mpi_bc_xcpot must be adjusted
!! for additional implementations. !! for additional implementations.
MODULE m_types_xcpot MODULE m_types_xcpot
use m_types_potden USE m_types_potden
IMPLICIT NONE IMPLICIT NONE
PRIVATE PRIVATE
PUBLIC :: t_xcpot,t_gradients PUBLIC :: t_xcpot,t_gradients
...@@ -69,8 +69,8 @@ MODULE m_types_xcpot ...@@ -69,8 +69,8 @@ MODULE m_types_xcpot
REAL,ALLOCATABLE :: laplace(:,:) REAL,ALLOCATABLE :: laplace(:,:)
END TYPE t_gradients END TYPE t_gradients
CONTAINS CONTAINS
subroutine kED_alloc_mt(kED,nsp_x_jmtd, jspins, n_start, n_types, n_stride) SUBROUTINE kED_alloc_mt(kED,nsp_x_jmtd, jspins, n_start, n_types, n_stride)
implicit none IMPLICIT NONE
class(t_kinED), intent(inout) :: kED class(t_kinED), intent(inout) :: kED
integer, intent(in) :: nsp_x_jmtd, jspins, n_start, n_types, n_stride integer, intent(in) :: nsp_x_jmtd, jspins, n_start, n_types, n_stride
integer :: cnt, n integer :: cnt, n
......
...@@ -48,6 +48,7 @@ vgen/b_field.F90 ...@@ -48,6 +48,7 @@ vgen/b_field.F90
vgen/write_xcstuff.f90 vgen/write_xcstuff.f90
vgen/xy_av_den.f90 vgen/xy_av_den.f90
vgen/VYukawaFilm.f90 vgen/VYukawaFilm.f90
vgen/divergence.f90
) )
#vdW Stuff #vdW Stuff
set(fleur_F90 ${fleur_F90} 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 ...@@ -7,8 +7,8 @@ MODULE m_lhglptg
CONTAINS CONTAINS
SUBROUTINE lhglptg(& SUBROUTINE lhglptg(&
& sphhar,atoms,& & sphhar,atoms,&
& rx,nsp,xcpot,sym,& & rx,nsp,dograds,sym,&
& ylh,thet,ylht1,ylht2,ylhf1,ylhf2,ylhtf) & ylh,thet,phi,ylht1,ylht2,ylhf1,ylhf2,ylhtf)
! !
USE m_polangle USE m_polangle
USE m_ylm USE m_ylm
...@@ -16,7 +16,7 @@ CONTAINS ...@@ -16,7 +16,7 @@ CONTAINS
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN) :: xcpot LOGICAL, INTENT(IN) :: dograds
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
...@@ -27,6 +27,7 @@ CONTAINS ...@@ -27,6 +27,7 @@ CONTAINS
! .. Array Arguments .. ! .. Array Arguments ..
REAL, INTENT (IN) :: rx(:,:)!(3,dimension%nspd) REAL, INTENT (IN) :: rx(:,:)!(3,dimension%nspd)
REAL, INTENT (OUT):: thet(:) !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):: 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):: ylht1(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
REAL, INTENT (OUT):: ylht2(:,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 ...@@ -35,7 +36,7 @@ CONTAINS
REAL, INTENT (OUT):: ylhf2(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd) REAL, INTENT (OUT):: ylhf2(:,0:,:)!(dimension%nspd,0:sphhar%nlhd,sphhar%ntypsd)
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
REAL s,st1,st2,sf1,sf2,stf,phi REAL s,st1,st2,sf1,sf2,stf
INTEGER k,lh,mem,nd,lm,ll1 INTEGER k,lh,mem,nd,lm,ll1
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
...@@ -56,9 +57,9 @@ CONTAINS ...@@ -56,9 +57,9 @@ CONTAINS
& ylm) & ylm)
CALL pol_angle(& CALL pol_angle(&
& rx(1,k),rx(2,k),rx(3,k),& & 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(& CALL dylm3(&
& atoms%lmaxd,atoms%lmaxd,rx(:,k),ylm,& & atoms%lmaxd,atoms%lmaxd,rx(:,k),ylm,&
& dylmt1,dylmt2,dylmf1,dylmf2,dylmtf) & dylmt1,dylmt2,dylmf1,dylmf2,dylmtf)
...@@ -80,7 +81,7 @@ CONTAINS ...@@ -80,7 +81,7 @@ CONTAINS
ylh(k,lh,nd) = s ylh(k,lh,nd) = s
IF (xcpot%needs_grad()) THEN IF (dograds) THEN
DO mem = 1,sphhar%nmem(lh,nd) DO mem = 1,sphhar%nmem(lh,nd)
lm = ll1 + sphhar%mlh(mem,lh,nd) lm = ll1 + sphhar%mlh(mem,lh,nd)
......
...@@ -10,10 +10,10 @@ MODULE m_mt_tofrom_grid ...@@ -10,10 +10,10 @@ MODULE m_mt_tofrom_grid
INTEGER, PARAMETER :: ndvgrd = 6 ! this should be consistent across GGA derivative routines INTEGER, PARAMETER :: ndvgrd = 6 ! this should be consistent across GGA derivative routines
REAL, ALLOCATABLE :: ylh(:, :, :), ylht(:, :, :), ylhtt(:, :, :) REAL, ALLOCATABLE :: ylh(:, :, :), ylht(:, :, :), ylhtt(:, :, :)
REAL, ALLOCATABLE :: ylhf(:, :, :), ylhff(:, :, :), ylhtf(:, :, :) 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 PUBLIC :: init_mt_grid, mt_to_grid, mt_from_grid, finish_mt_grid
CONTAINS CONTAINS
SUBROUTINE init_mt_grid(jspins, atoms, sphhar, xcpot, sym) SUBROUTINE init_mt_grid(jspins, atoms, sphhar, dograds, sym)
USE m_gaussp USE m_gaussp
USE m_lhglptg USE m_lhglptg
USE m_lhglpts USE m_lhglpts
...@@ -21,36 +21,36 @@ CONTAINS ...@@ -21,36 +21,36 @@ CONTAINS
INTEGER, INTENT(IN) :: jspins INTEGER, INTENT(IN) :: jspins
TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar TYPE(t_sphhar), INTENT(IN) :: sphhar
CLASS(t_xcpot), INTENT(IN) :: xcpot LOGICAL, INTENT(IN) :: dograds
TYPE(t_sym), INTENT(IN) :: sym TYPE(t_sym), INTENT(IN) :: sym
! generate nspd points on a sherical shell with radius 1.0 ! generate nspd points on a sherical shell with radius 1.0
! angular mesh equidistant in phi, ! angular mesh equidistant in phi,
! theta are zeros of the legendre polynomials ! 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) CALL gaussp(atoms%lmaxd, rx, wt)
! generate the lattice harmonics on the angular mesh ! generate the lattice harmonics on the angular mesh
ALLOCATE (ylh(atoms%nsp(), 0:sphhar%nlhd, sphhar%ntypsd)) ALLOCATE (ylh(atoms%nsp(), 0:sphhar%nlhd, sphhar%ntypsd))
IF (xcpot%needs_grad()) THEN IF (dograds) THEN
ALLOCATE (ylht, MOLD=ylh) ALLOCATE (ylht, MOLD=ylh)
ALLOCATE (ylhtt, MOLD=ylh) ALLOCATE (ylhtt, MOLD=ylh)
ALLOCATE (ylhf, MOLD=ylh) ALLOCATE (ylhf, MOLD=ylh)
ALLOCATE (ylhff, MOLD=ylh) ALLOCATE (ylhff, MOLD=ylh)
ALLOCATE (ylhtf, MOLD=ylh) ALLOCATE (ylhtf, MOLD=ylh)
CALL lhglptg(sphhar, atoms, rx, atoms%nsp(), xcpot, sym, & CALL lhglptg(sphhar, atoms, rx, atoms%nsp(), dograds, sym, &
ylh, thet, ylht, ylhtt, ylhf, ylhff, ylhtf) ylh, thet, phi, ylht, ylhtt, ylhf, ylhff, ylhtf)
ELSE ELSE
CALL lhglpts(sphhar, atoms, rx, atoms%nsp(), sym, ylh) CALL lhglpts(sphhar, atoms, rx, atoms%nsp(), sym, ylh)
END IF END IF
!ENDIF !ENDIF
END SUBROUTINE init_mt_grid 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_grdchlh
USE m_mkgylm USE m_mkgylm
IMPLICIT NONE IMPLICIT NONE
CLASS(t_xcpot), INTENT(IN) :: xcpot LOGICAL, INTENT(IN) :: dograds
TYPE(t_atoms), INTENT(IN) :: atoms TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar TYPE(t_sphhar), INTENT(IN) :: sphhar
REAL, INTENT(IN) :: den_mt(:, 0:, :) REAL, INTENT(IN) :: den_mt(:, 0:, :)
...@@ -69,7 +69,7 @@ CONTAINS ...@@ -69,7 +69,7 @@ CONTAINS
ALLOCATE (chlh(atoms%jmtd, 0:sphhar%nlhd, jspins)) ALLOCATE (chlh(atoms%jmtd, 0:sphhar%nlhd, jspins))
ALLOCATE (ch_tmp(nsp, 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), & 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), & chdtt(nsp, jspins), chdff(nsp, jspins), chdtf(nsp, jspins), chdrt(nsp, jspins), &
chdrf(nsp, jspins)) chdrf(nsp, jspins))
...@@ -87,7 +87,7 @@ CONTAINS ...@@ -87,7 +87,7 @@ CONTAINS
DO jr = 1, atoms%jri(n) DO jr = 1, atoms%jri(n)
chlh(jr, lh, js) = den_mt(jr, lh, js)/(atoms%rmsh(jr, n)*atoms%rmsh(jr, n)) chlh(jr, lh, js) = den_mt(jr, lh, js)/(atoms%rmsh(jr, n)*atoms%rmsh(jr, n))
ENDDO 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)) chlh(1, lh, js), ndvgrd, chlhdr(1, lh, js), chlhdrr(1, lh, js))
ENDDO ! js ENDDO ! js
...@@ -106,7 +106,7 @@ CONTAINS ...@@ -106,7 +106,7 @@ CONTAINS
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
IF (xcpot%needs_grad()) THEN IF (dograds) THEN
chdr(:, :) = 0.0 ! d(ch)/dr chdr(:, :) = 0.0 ! d(ch)/dr
chdt(:, :) = 0.0 ! d(ch)/dtheta chdt(:, :) = 0.0 ! d(ch)/dtheta
chdf(:, :) = 0.0 ! d(ch)/dfai chdf(:, :) = 0.0 ! d(ch)/dfai
...@@ -185,7 +185,7 @@ CONTAINS ...@@ -185,7 +185,7 @@ CONTAINS
END SUBROUTINE mt_from_grid END SUBROUTINE mt_from_grid
SUBROUTINE finish_mt_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) IF (ALLOCATED(ylht)) DEALLOCATE (ylht, ylhtt, ylhf, ylhff, ylhtf)
END SUBROUTINE finish_mt_grid END SUBROUTINE finish_mt_grid
......
...@@ -15,11 +15,11 @@ MODULE m_pw_tofrom_grid ...@@ -15,11 +15,11 @@ MODULE m_pw_tofrom_grid
PUBLIC :: init_pw_grid,pw_to_grid,pw_from_grid,finish_pw_grid PUBLIC :: init_pw_grid,pw_to_grid,pw_from_grid,finish_pw_grid
CONTAINS CONTAINS
SUBROUTINE init_pw_grid(xcpot,stars,sym,cell) SUBROUTINE init_pw_grid(dograds,stars,sym,cell)
USE m_prpxcfftmap USE m_prpxcfftmap
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN) :: xcpot LOGICAL,INTENT(IN) :: dograds
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
...@@ -34,13 +34,13 @@ CONTAINS ...@@ -34,13 +34,13 @@ CONTAINS
ifftd=27*stars%mx1*stars%mx2*stars%mx3 ifftd=27*stars%mx1*stars%mx2*stars%mx3
ifftxc3 = stars%kxc1_fft*stars%kxc2_fft*stars%kxc3_fft