Commit 6645cae4 authored by Miriam Hinzen's avatar Miriam Hinzen

Merge branch 'kerker' into 'develop'

Merge branch kerker into develop

See merge request fleur/fleur!6
parents dbcba7f2 107ac463
......@@ -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=(/&
......
......@@ -146,7 +146,8 @@
input%pallst = .false. ; obsolete%lwb = .false. ; vacuum%starcoeff = .false.
input%strho = .false. ; input%l_f = .false. ; atoms%l_geo(:) = .true.
noco%l_noco = noco%l_ss ; input%jspins = 1
input%itmax = 9 ; input%maxiter = 99 ; input%imix = 7 ; input%alpha = 0.05 ; input%minDistance = 0.0
input%itmax = 9 ; input%maxiter = 99 ; input%imix = 7 ; input%alpha = 0.05
input%preconditioning_param = 0.0 ; input%minDistance = 0.0
input%spinf = 2.0 ; obsolete%lepr = 0 ; input%coretail_lmax = 0
sliceplot%kk = 0 ; sliceplot%nnne = 0 ; vacuum%nstars = 0 ; vacuum%nstm = 0
input%isec1 = 99 ; nu = 5 ; vacuum%layerd = 1 ; iofile = 6
......
......@@ -330,6 +330,7 @@ SUBROUTINE r_inpXML(&
END SELECT
input%alpha = evaluateFirstOnly(xmlGetAttributeValue('/fleurInput/calculationSetup/scfLoop/@alpha'))
input%preconditioning_param = evaluateFirstOnly(xmlGetAttributeValue('/fleurInput/calculationSetup/scfLoop/@preconditioning_param'))
input%spinf = evaluateFirstOnly(xmlGetAttributeValue('/fleurInput/calculationSetup/scfLoop/@spinf'))
! Get parameters for core electrons
......
......@@ -573,7 +573,7 @@
8061 FORMAT (6x,i3,9x,i3,6x,i2,7x,f6.2,7x,f6.2)
END IF
input%preconditioning_param = 0.0
chform = '(5x,l1,'//chntype//'f6.2)'
! chform = '(5x,l1,23f6.2)'
......
......@@ -168,8 +168,8 @@ SUBROUTINE w_inpXML(&
110 FORMAT(' <cutoffs Kmax="',f0.8,'" Gmax="',f0.8,'" GmaxXC="',f0.8,'" numbands="',i0,'"/>')
WRITE (fileNum,110) input%rkmax,stars%gmaxInit,xcpot%gmaxxc,input%gw_neigd
! <scfLoop itmax="9" maxIterBroyd="99" imix="Anderson" alpha="0.05" spinf="2.00"/>
120 FORMAT(' <scfLoop itmax="',i0,'" minDistance="',f0.8,'" maxIterBroyd="',i0,'" imix="',a,'" alpha="',f0.8,'" spinf="',f0.8,'"/>')
! <scfLoop itmax="9" maxIterBroyd="99" imix="Anderson" alpha="0.05" preconditioning_param="0.0" spinf="2.00"/>
120 FORMAT(' <scfLoop itmax="',i0,'" minDistance="',f0.8,'" maxIterBroyd="',i0,'" imix="',a,'" alpha="',f0.8,'" preconditioning_param="',f3.1,'" spinf="',f0.8,'"/>')
SELECT CASE (input%imix)
CASE (1)
mixingScheme='straight'
......@@ -182,7 +182,7 @@ SUBROUTINE w_inpXML(&
CASE DEFAULT
mixingScheme='errorUnknownMixing'
END SELECT
WRITE (fileNum,120) input%itmax,input%minDistance,input%maxiter,TRIM(mixingScheme),input%alpha,input%spinf
WRITE (fileNum,120) input%itmax,input%minDistance,input%maxiter,TRIM(mixingScheme),input%alpha,input%preconditioning_param,input%spinf
! <coreElectrons ctail="T" frcor="F" kcrel="0"/>
130 FORMAT(' <coreElectrons ctail="',l1,'" frcor="',l1,'" kcrel="',i0,'" coretail_lmax="',i0,'"/>')
......
......@@ -537,6 +537,7 @@
<xsd:attribute default="99" name="maxIterBroyd" type="xsd:nonNegativeInteger" use="optional"/>
<xsd:attribute name="imix" type="MixingEnum" use="required"/>
<xsd:attribute name="alpha" type="xsd:string" use="required"/>
<xsd:attribute default="0.0" name="preconditioning_param" type="xsd:string" use="optional"/>
<xsd:attribute default="2.0" name="spinf" type="xsd:string" use="optional"/>
<xsd:attribute default="0.0" name="minDistance" type="xsd:string" use="optional"/>
<xsd:attribute name="maxTimeToStartIter" type="xsd:string" use="optional"/>
......
......@@ -799,10 +799,11 @@
<xsd:attribute name="itmax" type="xsd:positiveInteger" use="required"/>
<xsd:attribute default="99" name="maxIterBroyd" type="xsd:nonNegativeInteger" use="optional"/>
<xsd:attribute name="imix" type="MixingEnum" use="required"/>
<xsd:attribute name="alpha" type="xsd:double" use="required"/>
<xsd:attribute default="2.0" name="spinf" type="xsd:double" use="optional"/>
<xsd:attribute default="0.0" name="minDistance" type="xsd:double" use="optional"/>
<xsd:attribute name="maxTimeToStartIter" type="xsd:double" use="optional"/>
<xsd:attribute name="alpha" type="xsd:string" use="required"/>
<xsd:attribute default="0.0" name="preconditioning_param" type="xsd:string" use="optional"/>
<xsd:attribute default="2.0" name="spinf" type="xsd:string" use="optional"/>
<xsd:attribute default="0.0" name="minDistance" type="xsd:string" use="optional"/>
<xsd:attribute name="maxTimeToStartIter" type="xsd:string" use="optional"/>
</xsd:complexType>
<xsd:complexType name="VacDOSType">
......
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -76,7 +76,7 @@ CONTAINS
! Types, these variables contain a lot of data!
TYPE(t_input) :: input
TYPE(t_field) :: field
TYPE(t_field) :: field, field2
TYPE(t_dimension):: DIMENSION
TYPE(t_atoms) :: atoms
TYPE(t_sphhar) :: sphhar
......@@ -119,6 +119,8 @@ CONTAINS
oneD,coreSpecInput,wann,l_opti)
CALL timestop("Initialization")
if( input%preconditioning_param /= 0 .and. input%film ) call juDFT_error('Currently no preconditioner for films', calledby = 'fleur' )
IF (l_opti) CALL optional(mpi,atoms,sphhar,vacuum,dimension,&
stars,input,sym,cell,sliceplot,obsolete,xcpot,noco,oneD)
......@@ -236,13 +238,13 @@ CONTAINS
!---< gwf
CALL timestart("generation of potential")
CALL vgen(hybrid,field,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,&
sym,obsolete,cell, oneD,sliceplot,mpi ,results,noco,inDen,vTot,vx,vCoul)
CALL vgen( hybrid, field, input, xcpot, DIMENSION, atoms, sphhar, stars, vacuum, &
sym, obsolete, cell, oneD, sliceplot, mpi, results, noco, inDen, vTot, vx, &
vCoul )
CALL timestop("generation of potential")
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,ierr)
#endif
......@@ -251,7 +253,6 @@ CONTAINS
forcetheoloop:DO WHILE(forcetheo%next_job(it==input%itmax,noco))
CALL timestart("generation of hamiltonian and diagonalization (total)")
CALL timestart("eigen")
vTemp = vTot
......@@ -418,19 +419,21 @@ CONTAINS
CALL forcetheo%postprocess()
CALL enpara%mix(mpi,atoms,vacuum,input,vTot%mt(:,0,:,:),vtot%vacz)
IF (mpi%irank.EQ.0) THEN
field2 = field
! ----> mix input and output densities
CALL timestart("mixing")
CALL mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,hybrid,archiveType,inDen,outDen,results)
CALL mix( field2, xcpot, dimension, obsolete, sliceplot, mpi, &
stars, atoms, sphhar, vacuum, input, sym, cell, noco, &
oneD, hybrid, archiveType, inDen, outDen, results )
CALL timestop("mixing")
if( mpi%irank == 0 ) then
WRITE (6,FMT=8130) it
WRITE (16,FMT=8130) it
8130 FORMAT (/,5x,'******* it=',i3,' is completed********',/,/)
WRITE(*,*) "Iteration:",it," Distance:",results%last_distance
CALL timestop("Iteration")
!+t3e
ENDIF ! mpi%irank.EQ.0
end if ! mpi%irank.EQ.0
#ifdef CPP_MPI
......
......@@ -250,6 +250,7 @@
CALL MPI_BCAST(input%jspins,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%n_u,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%lmaxd,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
call MPI_BCAST( input%preconditioning_param, 1, MPI_DOUBLE, 0, mpi%mpi_comm, ierr )
#endif
CALL ylmnorm_init(atoms%lmaxd)
!
......
This diff is collapsed.
......@@ -4,7 +4,9 @@
! 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:
......@@ -16,8 +18,11 @@ CONTAINS
!! 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(hybrid,field,input,xcpot,DIMENSION, atoms,sphhar,stars,&
vacuum,sym,obsolete,cell,oneD,sliceplot,mpi, results,noco,den,vTot,vx,vCoul)
SUBROUTINE vgen( hybrid, field, input, xcpot, DIMENSION, atoms, sphhar, stars, &
vacuum, sym, obsolete, cell, oneD, sliceplot, mpi, results, noco, &
den, vTot, vx, vCoul )
USE m_rotate_int_den_to_local
USE m_bfield
USE m_vgen_coulomb
......@@ -28,71 +33,72 @@ CONTAINS
USE m_mpi_bc_potden
#endif
IMPLICIT NONE
TYPE(t_results),INTENT(INOUT) :: results
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_hybrid),INTENT(IN) :: hybrid
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_obsolete),INTENT(IN) :: obsolete
TYPE(t_sliceplot),INTENT(IN) :: sliceplot
TYPE(t_input),INTENT(IN) :: input
TYPE(t_field),INTENT(INOUT) :: field !efield can be modified
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
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_results), INTENT(INOUT) :: results
CLASS(t_xcpot), INTENT(IN) :: xcpot
TYPE(t_hybrid), INTENT(IN) :: hybrid
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_obsolete), INTENT(IN) :: obsolete
TYPE(t_sliceplot), INTENT(IN) :: sliceplot
TYPE(t_input), INTENT(IN) :: input
TYPE(t_field), INTENT(INOUT) :: field !efield can be modified
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_noco), INTENT(IN) :: noco
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(INOUT) :: den
TYPE(t_potden),INTENT(INOUT) :: vTot,vx,vCoul
! ..
TYPE(t_potden), INTENT(INOUT) :: vTot,vx,vCoul
TYPE(t_potden) :: workden,denRot
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()
ALLOCATE(vx%pw_w,vTot%pw_w,mold=vTot%pw)
ALLOCATE(vCoul%pw_w(SIZE(den%pw,1),1))
ALLOCATE( vx%pw_w, vTot%pw_w, mold=vTot%pw )
ALLOCATE( vCoul%pw_w(SIZE(den%pw,1),1) )
CALL workDen%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,0)
CALL workDen%init( stars, atoms, sphhar, vacuum, input%jspins, noco%l_noco, 0 )
!sum up both spins in den into workden
CALL den%sum_both_spin(workden)
CALL den%sum_both_spin( workden )
CALL vgen_coulomb(1,mpi,DIMENSION,oneD,input,field,vacuum,sym,stars,cell,sphhar,atoms,workden,vCoul,results)
CALL vgen_coulomb( 1, mpi, DIMENSION, oneD, input, field, vacuum, sym, stars, cell, &
sphhar, atoms, workden, vCoul, results )
CALL vCoul%copy_both_spin(vTot)
CALL vCoul%copy_both_spin( vTot )
IF (noco%l_noco) THEN
CALL denRot%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,0)
CALL denRot%init( stars, atoms, sphhar, vacuum, input%jspins, noco%l_noco, 0 )
denRot=den
CALL rotate_int_den_to_local(DIMENSION,sym,stars,atoms,sphhar,vacuum,cell,input,&
noco,oneD,denRot)
CALL rotate_int_den_to_local( DIMENSION, sym, stars, atoms, sphhar, vacuum, cell, input, &
noco, oneD, denRot )
ENDIF
call vgen_xcpot(hybrid,input,xcpot,DIMENSION, atoms,sphhar,stars,&
vacuum,sym, obsolete,cell,oneD,sliceplot,mpi,noco,den,denRot,vTot,vx,results)
call vgen_xcpot( hybrid, input, xcpot, DIMENSION, atoms, sphhar, stars, &
vacuum, sym, obsolete, cell, oneD, sliceplot, mpi, noco, den, denRot, vTot, vx, results )
!ToDo, check if this is needed for more potentials as well...
CALL vgen_finalize(atoms,stars,vacuum,sym,noco,input,vTot,denRot)
DEALLOCATE(vcoul%pw_w,vx%pw_w)
CALL vgen_finalize( atoms, stars, vacuum, sym, noco, input, vTot, denRot )
DEALLOCATE( vcoul%pw_w, vx%pw_w )
CALL bfield(input,noco,atoms,field,vTot)
CALL bfield( input, noco, atoms, field, vTot )
! broadcast potentials
#ifdef CPP_MPI
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,vTot)
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,vCoul)
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,vx)
CALL mpi_bc_potden( mpi, stars, sphhar, atoms, input, vacuum, oneD, noco, vTot )
CALL mpi_bc_potden( mpi, stars, sphhar, atoms, input, vacuum, oneD, noco, vCoul )
CALL mpi_bc_potden( mpi, stars, sphhar, atoms, input, vacuum, oneD, noco, vx )
#endif
END SUBROUTINE vgen
END MODULE m_vgen
......@@ -29,6 +29,8 @@ math/differentiate.f90
math/fft2d.F90
math/fft3d.f90
math/fft_interface.F90
math/SphBessel.f90
math/DoubleFactorial.f90
)
if (FLEUR_USE_FFTMKL)
set(fleur_F90 ${fleur_F90} math/mkl_dfti.f90)
......
module m_DoubleFactorial
implicit none
contains
real(kind=8) function DoubleFactorial( n_upper, n_lower )
! calculates ( 2 * n_upper + 1 ) !! / ( 2 * n_lower + 1 ) !! or just ( 2 * n_upper + 1 ) !!, if n_lower is not present
integer :: n_upper
integer, optional :: n_lower
integer :: i, i_lower
i_lower = 1
if( present(n_lower) ) i_lower = n_lower + 1
DoubleFactorial = 1.
do i = i_lower, n_upper
DoubleFactorial = DoubleFactorial * ( 2 * i + 1 )
end do
end function DoubleFactorial
end module m_DoubleFactorial
!--------------------------------------------------------------------------------
! 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_SphBessel
!-------------------------------------------------------------------------
! SphBessel calculates spherical Bessel functions of the first,
! second and third kind (Bessel, Neumann and Hankel functions).
! ModSphBessel calculates modified spherical Bessel functions
! of the first and second kind.
!
! jl : spherical Bessel function of the first kind (Bessel)
! nl : spherical Bessel function of the second kind (Neumann)
! hl : spherical Bessel function of the third kind (Hankel)
! il : modified spherical Bessel function of the first kind
! kl : modified spherical Bessel function of the second kind
!
! z : Bessel functions are calculated for this value
! lmax: Bessel functions are calculated for all the indices l
! from 0 to lmax
!
! intent(in):
! z : complex or real scalar
! lmax: integer
!
! intent(out):
! * SphBessel( jl, nl, hl, z, lmax )
! jl: complex or real, dimension(0:lmax)
! nl: complex or real, dimension(0:lmax)
! hl: complex, dimension(0:lmax)
! * ModSphBessel( il, kl, z, lmax )
! il: complex or real, dimension(0:lmax)
! kl: complex or real, dimension(0:lmax)
!
! All subroutines are pure and therefore can be called for a range of
! z-values concurrently, f.e. this way:
! allocate( il(0:lmax, size(z)), kl(0:lmax, size(z)) )
! do concurrent (i = 1: size(z))
! call ModSphBessel( il(:,i), kl(:,i), z(i), lmax )
! end do
!
! details on implementation:
! For |z| <= 1 the taylor expansions of jl and nl are used.
! For |z| > 1 the explicit expressions for hl(+), hl(-) are used.
! For modified spherical Bessel functions il and kl the relations
! il(z) = I^{-l} * jl(I*z)
! kl(z) = -I^{l} * hl(I*z)
! are used.
!
! authors:
! originally written by R. Zeller (1990)
! modernised and extended by M. Hinzen (2016)
!-------------------------------------------------------------------------
implicit none
complex, parameter :: CI = (0.0, 1.0)
interface SphBessel
module procedure :: SphBesselComplex, SphBesselReal
end interface
interface ModSphBessel
! variant Complex2 takes workspace as an argument.
! this is not possible for the subroutine working on reals.
module procedure :: ModSphBesselComplex, ModSphBesselReal, ModSphBesselComplex2
end interface
contains
pure subroutine SphBesselComplex ( jl, nl, hl, z, lmax )
complex, intent(in) :: z
integer, intent(in) :: lmax
complex, dimension(0:lmax), intent(out) :: jl, nl, hl
complex :: termj, termn, z2, zj, zn
real :: rl, rn
real, dimension(0:lmax) :: rnm
integer :: l, m, n
zj = 1.0
zn = 1.0 / z
z2 = z * z
jl(:) = 1.0
nl(:) = 1.0
if ( abs( z ) < lmax + 1.0 ) then
SERIAL_L_LOOP: do l = 0, lmax
rl = l + l
termj = 1.0
termn = 1.0
EXPANSION: do n = 1, 25
rn = n + n
termj = -termj / ( rl + rn + 1.0 ) / rn * z2
termn = termn / ( rl - rn + 1.0 ) / rn * z2
jl(l) = jl(l) + termj
nl(l) = nl(l) + termn
end do EXPANSION
jl(l) = jl(l) * zj
nl(l) = -nl(l) * zn
hl(l) = jl(l) + nl(l) * CI
zj = zj * z / ( rl + 3.0 )
zn = zn / z * ( rl + 1.0 )
end do SERIAL_L_LOOP
end if
rnm(:) = 1.0
PARALLEL_L_LOOP: do concurrent (l = 0: lmax)
if ( abs( z ) >= l + 1.0 ) then
hl(l) = 0.0
nl(l) = 0.0
SERIAL_M_LOOP: do m = 0, l
hl(l) = hl(l) + (-1) ** m * rnm(l)
nl(l) = nl(l) + rnm(l)
rnm(l) = rnm(l) / ( m + 1.0 ) * ( l * ( l + 1 ) - m * ( m + 1 ) ) / ( CI * ( z + z ) )
end do SERIAL_M_LOOP
hl(l) = hl(l) * (-CI) ** l * exp( CI * z ) / ( CI * z )
nl(l) = nl(l) * CI ** l * exp( -CI * z ) / ( -CI * z )
jl(l) = ( hl(l) + nl(l) ) / 2.0
nl(l) = ( hl(l) - jl(l) ) * (-CI)
end if
end do PARALLEL_L_LOOP
end subroutine SphBesselComplex
pure subroutine SphBesselReal ( jl, nl, hl, x, lmax )
real, intent(in) :: x
integer, intent(in) :: lmax
real, dimension(0:lmax), intent(out) :: jl, nl
complex, dimension(0:lmax), intent(out) :: hl
complex, dimension(0:lmax) :: jl_complex, nl_complex
complex :: z
z = x ! internal conversion from real to complex
call SphBesselComplex( jl_complex, nl_complex, hl, z, lmax )
jl = jl_complex ! internal conversion from complex to real
nl = nl_complex ! internal conversion from complex to real
end subroutine SphBesselReal
pure subroutine ModSphBesselComplex ( il, kl, z, lmax )
complex, intent(in) :: z
integer, intent(in) :: lmax
complex, dimension(0:lmax), intent(out) :: il, kl
complex, dimension(0:lmax) :: nl
integer :: l
call SphBesselComplex( il, nl, kl, CI * z, lmax )
do l = 0, lmax
il(l) = (-CI) ** l * il(l)
kl(l) = - CI ** l * kl(l)
end do
end subroutine ModSphBesselComplex
!another implementation of ModSphBesselComplex, where nl is allocated outside for performance reasons
pure subroutine ModSphBesselComplex2 ( il, kl, nl, z, lmax )
complex, intent(in) :: z
integer, intent(in) :: lmax
complex, dimension(0:lmax), intent(out) :: il, kl, nl
integer :: l
call SphBesselComplex( il, nl, kl, CI * z, lmax )
do l = 0, lmax
il(l) = (-CI) ** l * il(l)
kl(l) = - CI ** l * kl(l)
end do
end subroutine ModSphBesselComplex2
pure subroutine ModSphBesselReal ( il, kl, x, lmax )
real, intent(in) :: x
integer, intent(in) :: lmax
real, dimension(0:lmax), intent(out) :: il, kl
complex, dimension(0:lmax) :: jl, nl, hl
integer :: l
complex :: z
z = CI * x
call SphBesselComplex( jl, nl, hl, z, lmax )
do l = 0, lmax
il(l) = (-CI) ** l * jl(l)
kl(l) = - CI ** l * hl(l)
end do
end subroutine ModSphBesselReal
end module m_SphBessel
......@@ -11,6 +11,7 @@ if (${FLEUR_USE_MPI})
mpi/mpi_bc_st.F90
mpi/mpi_bc_pot.F90
mpi/mpi_col_den.F90
mpi/mpi_reduce_potden.F90
mpi/mpi_make_groups.F90
mpi/mpi_dist_forcetheorem.F90
)
......
!--------------------------------------------------------------------------------
! 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_mpi_reduce_potden
CONTAINS
SUBROUTINE mpi_reduce_potden( mpi, stars, sphhar, atoms, input, vacuum, oneD, noco, potden )
! It is assumed that, if some quantity is allocated for some mpi rank, that it is also allocated on mpi rank 0.
#include"cpp_double.h"
USE m_types
USE m_constants
USE m_juDFT
IMPLICIT NONE
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_input), INTENT(IN) :: input
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_potden), INTENT(INOUT) :: potden
INCLUDE 'mpif.h'
INTEGER :: n
INTEGER :: ierr(3)
REAL, ALLOCATABLE :: r_b(:)
EXTERNAL CPP_BLAS_scopy,CPP_BLAS_ccopy,MPI_REDUCE
! reduce pw
n = stars%ng3 * size( potden%pw, 2 )
allocate( r_b(n) )
call MPI_REDUCE( potden%pw, r_b, n, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, mpi%mpi_comm, ierr )
if( mpi%irank == 0 ) call CPP_BLAS_ccopy( n, r_b, 1, potden%pw, 1 )
deallocate( r_b )
! reduce mt
n = atoms%jmtd * ( sphhar%nlhd + 1 ) * atoms%ntype * input%jspins
allocate( r_b(n) )
call MPI_REDUCE( potden%mt, r_b, n, MPI_DOUBLE, MPI_SUM, 0, mpi%mpi_comm, ierr )
if( mpi%irank == 0 ) call CPP_BLAS_scopy( n, r_b, 1, potden%mt, 1 )
deallocate( r_b )
! reduce pw_w
if( allocated( potden%pw_w ) ) then
n = stars%ng3 * size( potden%pw_w, 2 )
allocate( r_b(n) )
call MPI_REDUCE( potden%pw_w, r_b, n, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, mpi%mpi_comm, ierr )
if( mpi%irank == 0 ) call CPP_BLAS_ccopy( n, r_b, 1, potden%pw_w, 1 )
deallocate( r_b )
end if
! reduce vacz
if( allocated( potden%vacz ) ) then
n = vacuum%nmzd * 2 * size( potden%vacz, 3 )
allocate( r_b(n) )
call MPI_REDUCE( potden%vacz, r_b, n, MPI_DOUBLE, MPI_SUM, 0, mpi%mpi_comm, ierr )
if( mpi%irank == 0 ) call CPP_BLAS_scopy( n, r_b, 1, potden%vacz, 1 )
deallocate( r_b )
end if
! reduce vacxy
if( allocated( potden%vacxy ) ) then
n = vacuum%nmzxyd * ( stars%ng2 - 1 ) * 2 * size( potden%vacxy, 4 )
allocate( r_b(n) )
call MPI_REDUCE( potden%vacxy, r_b, n, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, mpi%mpi_comm, ierr )
if( mpi%irank == 0 ) call CPP_BLAS_ccopy( n, r_b, 1, potden%vacxy, 1 )
deallocate( r_b )
end if
! reduce mmpMat
if( allocated( potden%mmpMat ) ) then
n = size( potden%mmpMat, 1 ) * size( potden%mmpMat, 2 ) * size( potden%mmpMat, 3 ) * size( potden%mmpMat, 4 )
allocate( r_b(n) )
call MPI_REDUCE( potden%mmpMat, r_b, n, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, mpi%mpi_comm, ierr )
if( mpi%irank == 0 ) call CPP_BLAS_ccopy( n, r_b, 1, potden%mmpMat, 1 )
deallocate( r_b )
end if
END SUBROUTINE mpi_reduce_potden
END MODULE m_mpi_reduce_potden
......@@ -160,7 +160,8 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,cell,atoms,enpara,stars,vacuum,di
! Calculate Coulomb potential for overall density (+including external potential)
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,overallVCoul)
CALL vgen_coulomb( 1, mpi, DIMENSION, oneD, input, field, vacuum, sym, stars, cell, &