Commit e5e541fa authored by Miriam Hinzen's avatar Miriam Hinzen

Extend subroutines and types, add comments and introduce a test

The preconditioner already improves the convergence of Cu and Fe files, but the starting distance is higher than for the older fleur version and tests run up to test 7 only (does not fail, but hangs).
parent 5a4e3145
......@@ -24,6 +24,7 @@ MODULE m_constants
INTEGER, PARAMETER :: POTDEN_TYPE_POTTOT = 1 ! 0 < POTDEN_TYPE <= 1000 ==> potential
INTEGER, PARAMETER :: POTDEN_TYPE_POTCOUL = 2
INTEGER, PARAMETER :: POTDEN_TYPE_POTX = 3
INTEGER, PARAMETER :: POTDEN_TYPE_POTYUK = 4
INTEGER, PARAMETER :: POTDEN_TYPE_DEN = 1001 ! 1000 < POTDEN_TYPE ==> density
CHARACTER(2),DIMENSION(0:103),PARAMETER :: namat_const=(/&
......
......@@ -229,7 +229,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, .false., inDen, vTot, vx, &
sym, obsolete, cell, oneD, sliceplot, mpi, results, noco, inDen, vTot, vx, &
vCoul )
CALL timestop("generation of potential")
......
This diff is collapsed.
......@@ -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, yukawa_residual, &
vacuum, sym, obsolete, cell, oneD, sliceplot, mpi, results, noco, &
den, vTot, vx, vCoul )
USE m_rotate_int_den_to_local
......@@ -51,7 +51,6 @@ CONTAINS
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
logical, intent(in) :: yukawa_residual
TYPE(t_potden), INTENT(INOUT) :: den
TYPE(t_potden), INTENT(INOUT) :: vTot,vx,vCoul
......@@ -73,7 +72,7 @@ CONTAINS
CALL den%sum_both_spin( workden )
CALL vgen_coulomb( 1, mpi, DIMENSION, oneD, input, field, vacuum, sym, stars, cell, &
sphhar, atoms, workden, yukawa_residual, vCoul, results )
sphhar, atoms, workden, vCoul, results )
CALL vCoul%copy_both_spin( vTot )
......
......@@ -161,7 +161,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,cell,atoms,enpara,stars,vacuum,di
CALL overallDen%sum_both_spin()!workden)
CALL overallVCoul%resetPotDen()
CALL vgen_coulomb( 1, mpi, DIMENSION, oneD, input, field, vacuum, sym, stars, cell, &
sphhar, atoms, overallDen, .false., overallVCoul )
sphhar, atoms, overallDen, overallVCoul )
CALL convol(stars, overallVCoul%pw_w(:,1), overallVCoul%pw(:,1), stars%ufft) ! Is there a problem with a second spin?!
#ifdef CPP_MPI
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,overallVCoul)
......
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<fleurInput fleurInputVersion="0.29">
<comment>
Fe preconditioning testcase
</comment>
<calculationSetup>
<cutoffs Kmax="3.50000000" Gmax="10.50000000" GmaxXC="8.70000000" numbands="0"/>
<scfLoop itmax="3" minDistance=".00000000" maxIterBroyd="99" imix="Anderson" alpha=".15000000" preconditioning_param="1.2" spinf="2.00000000"/>
<coreElectrons ctail="T" frcor="F" kcrel="0" coretail_lmax="0"/>
<magnetism jspins="2" l_noco="F" swsp="F" lflip="F"/>
<soc theta=".00000000" phi=".00000000" l_soc="F" spav="F"/>
<expertModes gw="0" isec1="99" secvar="F"/>
<geometryOptimization l_f="F" xa="2.00000000" thetad="330.00000000" epsdisp=".00001000" epsforce=".00001000"/>
<ldaU l_linMix="F" mixParam=".050000" spinf="1.000000"/>
<bzIntegration valenceElectrons="144.00000000" mode="hist" fermiSmearingEnergy=".00100000">
<kPointCount count="17" gamma="F"/>
</bzIntegration>
<energyParameterLimits ellow="-1.80000000" elup="1.00000000"/>
</calculationSetup>
<cell>
<symmetryFile filename="sym.out"/>
<bulkLattice scale="1.0000000000" latnam="squ">
<a1 scale="1.0000000000">5.4200000000</a1>
<c scale="1.0000000000">27.0458000000</c>
</bulkLattice>
</cell>
<xcFunctional name="pbe" relativisticCorrections="F"/>
<atomSpecies>
<species name="Fe-1" element="Fe" atomicNumber="26" coreStates="4" magMom="2.20000000" flipSpin="T">
<mtSphere radius="2.29000000" gridPoints="757" logIncrement=".01600000"/>
<atomicCutoffs lmax="8" lnonsphr="6"/>
<energyParameters s="4" p="4" d="3" f="4"/>
<lo type="SCLO" l="0" n="3" eDeriv="0"/>
<lo type="SCLO" l="1" n="3" eDeriv="0"/>
</species>
</atomSpecies>
<atomGroups>
<atomGroup species="Fe-1">
<relPos label=" 1">.0000000000 .0000000000 .0000000000</relPos>
<force calculate="T" relaxXYZ="TTT"/>
</atomGroup>
<atomGroup species="Fe-1">
<relPos label=" 2">1.000/2.000 1.000/2.000 1.000/10.000</relPos>
<relPos label=" 3">1.000/2.000 1.000/2.000 -1.000/10.000</relPos>
<force calculate="T" relaxXYZ="TTT"/>
</atomGroup>
<atomGroup species="Fe-1">
<relPos label=" 4">.0000000000 .0000000000 1.000/5.000</relPos>
<relPos label=" 5">.0000000000 .0000000000 -1.000/5.000</relPos>
<force calculate="T" relaxXYZ="TTT"/>
</atomGroup>
<atomGroup species="Fe-1">
<relPos label=" 6">1.000/2.000 1.000/2.000 3.000/10.000</relPos>
<relPos label=" 7">1.000/2.000 1.000/2.000 -3.000/10.000</relPos>
<force calculate="T" relaxXYZ="TTT"/>
</atomGroup>
<atomGroup species="Fe-1">
<relPos label=" 8">.0000000000 .0000000000 2.000/5.000</relPos>
<relPos label=" 9">.0000000000 .0000000000 -2.000/5.000</relPos>
<force calculate="T" relaxXYZ="TTT"/>
</atomGroup>
</atomGroups>
<output dos="F" band="F" vacdos="F" slice="F" mcd="F">
<checks vchk="F" cdinf="F"/>
<densityOfStates ndir="0" minEnergy="-.50000000" maxEnergy=".50000000" sigma=".01500000"/>
<vacuumDOS layers="0" integ="F" star="F" nstars="0" locx1=".00000" locy1=".00000" locx2=".00000" locy2=".00000" nstm="0" tworkf=".00000"/>
<plotting iplot="F" score="F" plplot="F"/>
<chargeDensitySlicing numkpt="0" minEigenval=".00000000" maxEigenval=".00000000" nnne="0" pallst="F"/>
<specialOutput eonly="F" bmt="F"/>
<magneticCircularDichroism energyLo="-10.00000000" energyUp=".00000000"/>
</output>
</fleurInput>
16 16 T ! nop,nop2,symor
! 1
1 0 0 0.00000
0 1 0 0.00000
0 0 1 0.00000
! 2
-1 0 0 0.00000
0 1 0 0.00000
0 0 1 0.00000
! 3
1 0 0 0.00000
0 -1 0 0.00000
0 0 1 0.00000
! 4
-1 0 0 0.00000
0 -1 0 0.00000
0 0 1 0.00000
! 5
0 -1 0 0.00000
-1 0 0 0.00000
0 0 1 0.00000
! 6
0 -1 0 0.00000
1 0 0 0.00000
0 0 1 0.00000
! 7
0 1 0 0.00000
-1 0 0 0.00000
0 0 1 0.00000
! 8
0 1 0 0.00000
1 0 0 0.00000
0 0 1 0.00000
! 9
1 0 0 0.00000
0 1 0 0.00000
0 0 -1 0.00000
! 10
-1 0 0 0.00000
0 1 0 0.00000
0 0 -1 0.00000
! 11
1 0 0 0.00000
0 -1 0 0.00000
0 0 -1 0.00000
! 12
-1 0 0 0.00000
0 -1 0 0.00000
0 0 -1 0.00000
! 13
0 -1 0 0.00000
-1 0 0 0.00000
0 0 -1 0.00000
! 14
0 -1 0 0.00000
1 0 0 0.00000
0 0 -1 0.00000
! 15
0 1 0 0.00000
-1 0 0 0.00000
0 0 -1 0.00000
! 16
0 1 0 0.00000
1 0 0 0.00000
0 0 -1 0.00000
$test_name="Fleur Fe Kerker XML";
$test_code="Fleur";
%test_requirements=("SOC",0);
$test_stages=1;
$test_desc=<<EOF
Test of the Kerker preconditioner with one step:
1.Generate a starting density and run 3 iterations and compare distance
EOF
;
#juDFT Testscript
jt::copyfile("files/inp.xml",$workdir);
jt::copyfile("files/sym.out",$workdir);
jt::testrun("$executable",$workdir);
#now test output
$result=jt::test_grepexists("$workdir/out","it= 3 is completed");
$result+=jt::test_grepnumber("$workdir/out","distance of charge densitie","3: *([^ ]*)",16.8,0.001);
jt::stageresult($workdir,$result,"1");
......@@ -37,6 +37,7 @@ MODULE m_types_potden
PROCEDURE :: sum_both_spin
procedure :: SpinsToChargeAndMagnetisation
procedure :: ChargeAndMagnetisationToSpins
procedure :: Residual
END TYPE t_potden
CONTAINS
......@@ -91,35 +92,67 @@ CONTAINS
END IF
END SUBROUTINE copy_both_spin
subroutine SpinsToChargeAndMagnetisation( spins, charge_magn )
subroutine SpinsToChargeAndMagnetisation( den )
implicit none
class(t_potden), intent(in) :: spins
type(t_potden), intent(inout) :: charge_magn
charge_magn%mt(:,0:,:, 1) = spins%mt(:,0:,:, 1) + spins%mt(:,0:,:, 2)
charge_magn%mt(:,0:,:, 2) = spins%mt(:,0:,:, 1) - spins%mt(:,0:,:, 2)
charge_magn%pw(:, 1) = spins%pw(:, 1) + spins%pw(:, 2)
charge_magn%pw(:, 2) = spins%pw(:, 1) - spins%pw(:, 2)
charge_magn%vacz(:,:, 1) = spins%vacz(:,:, 1) + spins%vacz(:,:, 2)
charge_magn%vacz(:,:, 2) = spins%vacz(:,:, 1) - spins%vacz(:,:, 2)
charge_magn%vacxy(:,:,:,1) = spins%vacxy(:,:,:,1) + spins%vacxy(:,:,:,2)
charge_magn%vacxy(:,:,:,2) = spins%vacxy(:,:,:,1) - spins%vacxy(:,:,:,2)
class(t_potden), intent(inout) :: den
!type(t_potden), intent(inout) :: charge_magn
type(t_potden) :: copy
copy = den
den%mt(:,0:,:, 1) = copy%mt(:,0:,:, 1) + copy%mt(:,0:,:, 2)
den%mt(:,0:,:, 2) = copy%mt(:,0:,:, 1) - copy%mt(:,0:,:, 2)
den%pw(:, 1) = copy%pw(:, 1) + copy%pw(:, 2)
den%pw(:, 2) = copy%pw(:, 1) - copy%pw(:, 2)
den%vacz(:,:, 1) = copy%vacz(:,:, 1) + copy%vacz(:,:, 2)
den%vacz(:,:, 2) = copy%vacz(:,:, 1) - copy%vacz(:,:, 2)
den%vacxy(:,:,:,1) = copy%vacxy(:,:,:,1) + copy%vacxy(:,:,:,2)
den%vacxy(:,:,:,2) = copy%vacxy(:,:,:,1) - copy%vacxy(:,:,:,2)
end subroutine
subroutine ChargeAndMagnetisationToSpins( charge_magn, spins )
subroutine ChargeAndMagnetisationToSpins( den )
implicit none
class(t_potden), intent(in) :: charge_magn
type(t_potden), intent(inout) :: spins
spins%mt(:,0:,:, 1) = ( charge_magn%mt(:,0:,:, 1) + charge_magn%mt(:,0:,:, 2) ) / 2
spins%mt(:,0:,:, 2) = ( charge_magn%mt(:,0:,:, 1) - charge_magn%mt(:,0:,:, 2) ) / 2
spins%pw(:, 1) = ( charge_magn%pw(:, 1) + charge_magn%pw(:, 2) ) / 2
spins%pw(:, 2) = ( charge_magn%pw(:, 1) - charge_magn%pw(:, 2) ) / 2
spins%vacz(:,:, 1) = ( charge_magn%vacz(:,:, 1) + charge_magn%vacz(:,:, 2) ) / 2
spins%vacz(:,:, 2) = ( charge_magn%vacz(:,:, 1) - charge_magn%vacz(:,:, 2) ) / 2
spins%vacxy(:,:,:,1) = ( charge_magn%vacxy(:,:,:,1) + charge_magn%vacxy(:,:,:,2) ) / 2
spins%vacxy(:,:,:,2) = ( charge_magn%vacxy(:,:,:,1) - charge_magn%vacxy(:,:,:,2) ) / 2
class(t_potden), intent(inout) :: den
!type(t_potden), intent(inout) :: spins
type(t_potden) :: copy
copy = den
den%mt(:,0:,:, 1) = ( copy%mt(:,0:,:, 1) + copy%mt(:,0:,:, 2) ) / 2
den%mt(:,0:,:, 2) = ( copy%mt(:,0:,:, 1) - copy%mt(:,0:,:, 2) ) / 2
den%pw(:, 1) = ( copy%pw(:, 1) + copy%pw(:, 2) ) / 2
den%pw(:, 2) = ( copy%pw(:, 1) - copy%pw(:, 2) ) / 2
den%vacz(:,:, 1) = ( copy%vacz(:,:, 1) + copy%vacz(:,:, 2) ) / 2
den%vacz(:,:, 2) = ( copy%vacz(:,:, 1) - copy%vacz(:,:, 2) ) / 2
den%vacxy(:,:,:,1) = ( copy%vacxy(:,:,:,1) + copy%vacxy(:,:,:,2) ) / 2
den%vacxy(:,:,:,2) = ( copy%vacxy(:,:,:,1) - copy%vacxy(:,:,:,2) ) / 2
end subroutine
subroutine Residual( resDen, outDen, inDen )
implicit none
class(t_potden), intent(in) :: outDen
class(t_potden), intent(in) :: inDen
class(t_potden), intent(inout) :: resDen
resDen%iter = outDen%iter
resDen%potdenType = outDen%potdenType
resDen%mt = outDen%mt - inDen%mt
resDen%pw = outDen%pw - inDen%pw
resDen%vacz = outDen%vacz - inDen%vacz
resDen%vacxy = outDen%vacxy - inDen%vacxy
if( allocated( outDen%pw_w ) .and. allocated( inDen%pw_w ) .and. allocated( resDen%pw_w ) ) then
resDen%pw_w = outDen%pw_w - inDen%pw_w
end if
!if( allocated( outDen%theta_pw ) .and. allocated( inDen%theta_pw ) ) resDen%theta_pw = outDen%theta_pw - inDen%theta_pw
!if( allocated( outDen%theta_vacz ) .and. allocated( inDen%theta_vacz ) ) resDen%theta_vacz = outDen%theta_vacz - inDen%theta_vacz
!if( allocated( outDen%theta_vacxy ) .and. allocated( inDen%theta_vacxy ) ) resDen%theta_vacxy = outDen%theta_vacxy - inDen%theta_vacxy
!if( allocated( outDen%phi_pw ) .and. allocated( inDen%phi_pw ) ) resDen%phi_pw = outDen%phi_pw - inDen%phi_pw
!if( allocated( outDen%phi_vacz ) .and. allocated( inDen%phi_vacz ) ) resDen%phi_vacz = outDen%phi_vacz - inDen%phi_vacz
!if( allocated( outDen%phi_vacxy ) .and. allocated( inDen%phi_vacxy ) ) resDen%phi_vacxy = outDen%phi_vacxy - inDen%phi_vacxy
end subroutine
......@@ -187,4 +220,5 @@ CONTAINS
pd%mmpMat = CMPLX(0.0,0.0)
IF (ALLOCATED(pd%pw_w)) DEALLOCATE(pd%pw_w)
END SUBROUTINE resetPotDen
END MODULE m_types_potden
......@@ -71,7 +71,7 @@ CONTAINS
CALL psqpw(mpi,&
atoms_tmp,sphhar,stars,vacuum,&
DIMENSION,cell,input,sym,oneD,&
qpw,rho,(/0.,0./),.TRUE.,.false.,psq)
qpw,rho,(/0.,0./),.TRUE.,2,psq)
!put pseudo charge on real-space grid
!use v_pot for imaginary part
......
......@@ -22,7 +22,7 @@ module m_mpmom
contains
subroutine mpmom( input, mpi, atoms, sphhar, stars, sym, cell, oneD, qpw, rho, yukawa_residual, qlm )
subroutine mpmom( input, mpi, atoms, sphhar, stars, sym, cell, oneD, qpw, rho, potdenType, qlm )
use m_types
implicit none
......@@ -37,7 +37,7 @@ contains
type(t_atoms), intent(in) :: atoms
real, intent(in) :: rho(:,0:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype)
complex, intent(in) :: qpw(:) !(stars%ng3)
logical, intent(in) :: yukawa_residual
integer, intent(in) :: potdenType
complex, intent(out) :: qlm(-atoms%lmaxd:atoms%lmaxd,0:atoms%lmaxd,atoms%ntype)
integer :: j, jm, lh, mb, mem, mems, n, nd, l, nat, m
......@@ -46,11 +46,11 @@ contains
! multipole moments of original charge density
if ( mpi%irank == 0 ) then
call mt_moments( input, atoms, sphhar, rho(:,:,:), yukawa_residual, qlmo )
call mt_moments( input, atoms, sphhar, rho(:,:,:), potdenType, qlmo )
end if
! multipole moments of the interstitial charge density in the spheres
call pw_moments( input, mpi, stars, atoms, cell, sym, oneD, qpw(:), yukawa_residual, qlmp )
call pw_moments( input, mpi, stars, atoms, cell, sym, oneD, qpw(:), potdenType, qlmp )
if ( mpi%irank == 0 ) then
! see (A14)
......@@ -80,12 +80,12 @@ contains
end subroutine mpmom
subroutine mt_moments( input, atoms, sphhar, rho, yukawa_residual, qlmo )
subroutine mt_moments( input, atoms, sphhar, rho, potdenType, qlmo )
! multipole moments of original charge density
! see (A15) (Coulomb case) or (A17) (Yukawa case)
use m_intgr, only: intgr3
use m_constants, only: sfp_const
use m_constants, only: sfp_const, POTDEN_TYPE_POTYUK
use m_types
use m_DoubleFactorial
use m_SphBessel
......@@ -95,7 +95,7 @@ contains
type(t_sphhar), intent(in) :: sphhar
type(t_atoms), intent(in) :: atoms
real, intent(in) :: rho(: ,0:, :)
logical, intent(in) :: yukawa_residual
integer, intent(in) :: potdenType
complex, intent(out) :: qlmo(-atoms%lmaxd:,0:,:)
integer :: n, ns, jm, nl, l, j, mb, m, nat, i, imax, lmax
......@@ -103,7 +103,7 @@ contains
real :: f( maxval( atoms%jri ) )
real, allocatable, dimension(:,:) :: il, kl
if ( yukawa_residual ) then
if ( potdenType == POTDEN_TYPE_POTYUK ) then
allocate( il(0:atoms%lmaxd, 1:atoms%jmtd), kl(0:atoms%lmaxd, 1:atoms%jmtd) )
end if
......@@ -114,7 +114,7 @@ contains
jm = atoms%jri(n)
imax = atoms%jri(n)
lmax = sphhar%llh(sphhar%nlh(ns), ns)
if ( yukawa_residual ) then
if ( potdenType == POTDEN_TYPE_POTYUK ) then
do concurrent (i = 1:imax)
call ModSphBessel( il(:, i), kl(:, i), input%preconditioning_param * atoms%rmsh(i, n), lmax )
end do
......@@ -122,14 +122,14 @@ contains
do nl = 0, sphhar%nlh(ns)
l = sphhar%llh(nl,ns)
do j = 1, jm
if ( .not. yukawa_residual ) then
if ( potdenType /= POTDEN_TYPE_POTYUK ) then
f(j) = atoms%rmsh(j,n) ** l * rho(j,nl,n)
else
f(j) = il(l, j) * rho(j,nl,n)
end if
end do
call intgr3( f, atoms%rmsh(:,n), atoms%dx(n), jm, fint )
if ( yukawa_residual ) then
if ( potdenType == POTDEN_TYPE_POTYUK ) then
fint = fint * DoubleFactorial( l ) / input%preconditioning_param ** l
end if
do mb = 1, sphhar%nmem(nl,ns)
......@@ -137,7 +137,7 @@ contains
qlmo(m,l,n) = qlmo(m,l,n) + sphhar%clnu(mb,nl,ns) * fint
end do
end do
if ( .not. yukawa_residual ) then
if ( potdenType /= POTDEN_TYPE_POTYUK ) then
qlmo(0,0,n) = qlmo(0,0,n) - atoms%zatom(n) / sfp_const
end if
nat = nat + atoms%neq(n)
......@@ -146,13 +146,13 @@ contains
end subroutine mt_moments
subroutine pw_moments( input, mpi, stars, atoms, cell, sym, oneD, qpw_in, yukawa_residual, qlmp_out )
subroutine pw_moments( input, mpi, stars, atoms, cell, sym, oneD, qpw_in, potdenType, qlmp_out )
! multipole moments of the interstitial charge in the spheres
use m_phasy1
use m_sphbes
use m_od_phasy
use m_constants, only: sfp_const
use m_constants, only: sfp_const, POTDEN_TYPE_POTYUK
use m_types
use m_DoubleFactorial
use m_SphBessel
......@@ -166,7 +166,7 @@ contains
type(t_cell), intent(in) :: cell
type(t_atoms), intent(in) :: atoms
complex, intent(in) :: qpw_in(:)
logical, intent(in) :: yukawa_residual
integer, intent(in) :: potdenType
complex, intent(out) :: qlmp_out(-atoms%lmaxd:,0:,:)
integer :: n, k, l, ll1, lm, ierr(3), m
......@@ -188,7 +188,7 @@ contains
if ( mpi%irank == 0 ) then
! q=0 term: see (A19) (Coulomb case) or (A20) (Yukawa case)
do n = 1, atoms%ntype
if ( .not. yukawa_residual ) then
if ( potdenType /= POTDEN_TYPE_POTYUK ) then
qlmp(0,0,n) = qpw(1) * stars%nstr(1) * atoms%volmts(n) / sfp_const
else
call ModSphBessel( il(0:1), kl(0:1), input%preconditioning_param * atoms%rmt(n), 1 )
......@@ -217,14 +217,14 @@ contains
sk3r = stars%sk3(k) * atoms%rmt(n)
call sphbes( atoms%lmax(n) + 1, sk3r, aj )
rl2 = atoms%rmt(n) ** 2
if ( yukawa_residual ) then
if ( potdenType == POTDEN_TYPE_POTYUK ) then
call ModSphBessel( il(0:atoms%lmax(n)+1), kl(0:atoms%lmax(n)+1), input%preconditioning_param * atoms%rmt(n), atoms%lmax(n) + 1 )
sk3i = nqpw / ( stars%sk3(k) ** 2 + input%preconditioning_param ** 2 ) * rl2
else
sk3i = nqpw / stars%sk3(k)
end if
do l = 0, atoms%lmax(n)
if ( yukawa_residual ) then
if ( potdenType == POTDEN_TYPE_POTYUK ) then
cil = ( stars%sk3(k) * il(l) * aj(l+1) + input%preconditioning_param * il(l+1) * aj(l) ) * ( DoubleFactorial( l ) / input%preconditioning_param ** l ) * sk3i
else
cil = aj(l+1) * sk3i * rl2
......
......@@ -17,7 +17,7 @@ module m_psqpw
contains
subroutine psqpw( mpi, atoms, sphhar, stars, vacuum, dimension, cell, input, sym, oneD, &
& qpw, rho, rht, l_xyav, yukawa_residual, psq )
& qpw, rho, rht, l_xyav, potdenType, psq )
#include"cpp_double.h"
use m_constants
......@@ -46,7 +46,7 @@ contains
complex, intent(in) :: qpw(stars%ng3)
real, intent(in) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype)
real, intent(in) :: rht(vacuum%nmzd,2)
logical, intent(in) :: yukawa_residual
integer, intent(in) :: potdenType
complex, intent(out) :: psq(stars%ng3)
complex :: psint, sa, sl, sm
......@@ -67,7 +67,7 @@ contains
#endif
! Calculate multipole moments
call mpmom( input, mpi, atoms, sphhar, stars, sym, cell, oneD, qpw, rho, yukawa_residual, qlm )
call mpmom( input, mpi, atoms, sphhar, stars, sym, cell, oneD, qpw, rho, potdenType, qlm )
#ifdef CPP_MPI
psq(:) = cmplx( 0.0, 0.0 )
call MPI_BCAST( qpw, size(qpw), CPP_MPI_COMPLEX, 0, mpi%mpi_comm, ierr )
......@@ -82,7 +82,7 @@ contains
! g0 is the prefactor for the q=0 component in (A13)
pn = 0.
do n = 1, atoms%ntype
if ( .not. yukawa_residual ) then
if ( potdenType /= POTDEN_TYPE_POTYUK ) then
do l = 0, min( atoms%ncv(n) - 1, atoms%lmax(n) )
pn(l, n) = DoubleFactorial( atoms%ncv(n) + 1, l ) / ( atoms%rmt(n) ** ( atoms%ncv(n) + 1 ) )
end do
......@@ -100,7 +100,7 @@ contains
! q=0 term: see (A12) (Coulomb case) or (A13) (Yukawa case)
s = 0.
do n = 1, atoms%ntype
if ( .not. yukawa_residual ) then
if ( potdenType /= POTDEN_TYPE_POTYUK ) then
s = s + atoms%neq(n) * real( qlm(0,0,n) )
else
s = s + atoms%neq(n) * real( qlm(0,0,n) ) * g0(n)
......@@ -180,9 +180,9 @@ contains
end if
write( 6, fmt=8000 ) psint
write( 16, fmt=8000 ) psint
8000 FORMAT (/,10x,'integral of pseudo charge density inside the slab='&
8000 format (/,10x,'integral of pseudo charge density inside the slab='&
& ,5x,2f11.6)
if ( .not. input%film .or. yukawa_residual ) return
if ( .not. input%film .or. potdenType == POTDEN_TYPE_POTYUK ) return
! Normalized pseudo density
if ( .not. oneD%odi%d1 ) then
......@@ -206,7 +206,7 @@ contains
psq(1) = psq(1) - fact
write( 6, fmt=8010 ) fact * 1000
write( 16, fmt=8010 ) fact * 1000
8010 FORMAT (/,10x,' 1000 * normalization const. ='&
8010 format (/,10x,' 1000 * normalization const. ='&
& ,5x,2f11.6)
end if ! mpi%irank == 0
......
This diff is collapsed.
......@@ -2,7 +2,7 @@ module m_vmts
contains
subroutine vmts( input, mpi, stars, sphhar, atoms, sym, cell, oneD, vpw, rho, yukawa_residual, vr )
subroutine vmts( input, mpi, stars, sphhar, atoms, sym, cell, oneD, vpw, rho, potdenType, vr )
!-------------------------------------------------------------------------
! This subroutine calculates the lattice harmonics expansion coefficients
......@@ -27,7 +27,7 @@ contains
! termsR.
!
! More information and equations can be found in
! F. Tran, P. Blaha, Phys. Rev. B 83, 235118(2011)
! F. Tran, P. Blaha: Phys. Rev. B 83, 235118(2011)
!-------------------------------------------------------------------------
#include"cpp_double.h"
......@@ -50,7 +50,7 @@ contains
type(t_oneD), intent(in) :: oneD
complex, intent(in) :: vpw(:)!(stars%ng3,input%jspins)
real, intent(in) :: rho(:,0:,:)!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype)
logical, intent(in) :: yukawa_residual
integer, intent(in) :: potdenType
real, intent(out) :: vr(:,0:,:)!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype)
complex :: cp, sm
......@@ -75,12 +75,11 @@ contains
integer :: OMP_GET_NUM_THREADS, OMP_GET_THREAD_NUM
!-------------------------------------------------------------------------
! sphere boundary contribution to the coefficients calculated from the values
! SPHERE BOUNDARY CONTRIBUTION to the coefficients calculated from the values
! of the interstitial Coulomb / Yukawa potential on the sphere boundary
vtl(:,:) = cmplx( 0.0, 0.0 )
#ifdef CPP_MPI
call MPI_BCAST( vpw, size(vpw), CPP_MPI_COMPLEX, 0, mpi, ierr )
#endif
......@@ -105,7 +104,6 @@ contains
call od_phasy( atoms%ntype, stars%ng3, atoms%nat, atoms%lmaxd, atoms%ntype, &
atoms%neq, atoms%lmax, atoms%taual, cell%bmat, stars%kv3, k, oneD%odi, oneD%ods, pylm )
end if
nat = 1
do n = 1, atoms%ntype
call sphbes( atoms%lmax(n), stars%sk3(k) * atoms%rmt(n), sbf )
......@@ -136,14 +134,15 @@ contains
allocate( c_b(n1) )
call MPI_REDUCE( vtl, c_b, n1, CPP_MPI_COMPLEX, MPI_SUM, 0, mpi%mpi_comm, ierr )
if ( mpi%irank == 0 ) vtl = reshape( c_b, (/sphhar%nlhd+1,atoms%ntype/) )
deallocate (c_b)
deallocate( c_b )
#endif
!-------------------------------------------------------------------------
! sphere interior contribution to the coefficients calculated from the
! SPHERE INTERIOR CONTRIBUTION to the coefficients calculated from the
! values of the sphere Coulomb/Yukawa potential on the sphere boundary
if ( yukawa_residual ) then
if ( potdenType == POTDEN_TYPE_POTYUK ) then
allocate( il(0:atoms%lmaxd, 1:atoms%jmtd), kl(0:atoms%lmaxd, 1:atoms%jmtd) )
end if
......@@ -152,14 +151,14 @@ contains
nd = atoms%ntypsy(nat)
imax = atoms%jri(n)
lmax = sphhar%llh(sphhar%nlh(nd), nd)
if ( yukawa_residual ) then
if ( potdenType == POTDEN_TYPE_POTYUK ) then
do concurrent (i = 1:imax)
call ModSphBessel( il(0:,i), kl(0:,i), input%preconditioning_param * atoms%rmsh(i,n), lmax )
end do
end if
do lh = 0, sphhar%nlh(nd)
l = sphhar%llh(lh,nd)
if ( yukawa_residual ) then
if ( potdenType == POTDEN_TYPE_POTYUK ) then
green_1(1:imax) = il(l,1:imax)
green_2(1:imax) = kl(l,1:imax)
green_factor = fpi_const * input%preconditioning_param
......@@ -173,16 +172,18 @@ contains
call intgr2( integrand_1(1:imax), atoms%rmsh(1,n), atoms%dx(n), imax, integral_1(1:imax) )
call intgr2( integrand_2(1:imax), atoms%rmsh(1,n), atoms%dx(n), imax, integral_2(1:imax) )
termsR = integral_2(imax) + ( vtl(lh,n) / green_factor - integral_1(imax) * green_2(imax) ) / green_1(imax)
vr(1:imax,lh,n) = green_factor * ( green_1(1:imax) * ( termsR - integral_2(1:imax) ) &
vr(1:imax,lh,n) = green_factor * ( green_1(1:imax) * ( termsR - integral_2(1:imax) ) &
+ green_2(1:imax) * integral_1(1:imax) )
end do
nat = nat + atoms%neq(n)
end do
if ( yukawa_residual ) then
if ( potdenType == POTDEN_TYPE_POTYUK ) then
deallocate( il, kl )
end if
if ( .not. yukawa_residual ) then
if ( potdenType /= POTDEN_TYPE_POTYUK ) then
do n = 1, atoms%ntype
vr(1:atoms%jri(n),0,n) = vr(1:atoms%jri(n),0,n) - sfp_const * ( 1.0 / atoms%rmsh(1:atoms%jri(n),n) - 1.0 / atoms%rmt(n) ) * atoms%zatom(n)
end do
......
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