Commit fbd94767 authored by Nicolas Tancogne-Dejean's avatar Nicolas Tancogne-Dejean Committed by Micael Oliveira

Solving the merge conflict with develop.

parents 25d13f19 04267e67
......@@ -21,6 +21,7 @@ AC_DEFUN([ACX_LIBXC], [
acx_libxc_ok=no
acx_libxc_v3=no
acx_libxc_v4=no
acx_libxc_v5=no
dnl Check if the library was given in the command line
dnl if not, use environment variables or defaults
......@@ -48,20 +49,31 @@ dnl The tests
AC_MSG_CHECKING([for libxc])
testprog3="AC_LANG_PROGRAM([],[
use xc_f90_lib_m
use xc_f03_lib_m
implicit none
integer :: major
integer :: minor
integer :: micro
call xc_f90_version(major, minor, micro)])"
call xc_f03_version(major, minor, micro)])"
testprog4="AC_LANG_PROGRAM([],[
use xc_f90_lib_m
use xc_f03_lib_m
implicit none
integer :: major
integer :: minor
integer :: micro
integer :: flags = XC_FLAGS_NEEDS_LAPLACIAN
call xc_f03_version(major, minor, micro)]
write(*,*) flags)"
dnl Note that the f03 suffix of the Fortran 2003 interface has been changed to f90 in Libxc 5.
testprog5="AC_LANG_PROGRAM([],[
use xc_f90_lib_m
implicit none
integer :: major
integer :: minor
integer :: micro
integer :: flags = XC_FLAGS_HAVE_ALL
call xc_f90_version(major, minor, micro)]
write(*,*) flags)"
......@@ -74,22 +86,29 @@ if test ! -z "$LIBS_LIBXC"; then
fi
if test ! -z "$with_libxc_prefix"; then
# static linkage, version 4
# static linkage, version 5
if test x"$acx_libxc_ok" = xno; then
LIBS_LIBXC="$with_libxc_prefix/lib/libxcf90.a $with_libxc_prefix/lib/libxc.a"
LIBS="$LIBS_LIBXC $acx_libxc_save_LIBS"
AC_LINK_IFELSE($testprog5, [acx_libxc_ok=yes; acx_libxc_v5=yes], [])
fi
# static linkage, version 4
if test x"$acx_libxc_ok" = xno; then
LIBS_LIBXC="$with_libxc_prefix/lib/libxcf03.a $with_libxc_prefix/lib/libxc.a"
LIBS="$LIBS_LIBXC $acx_libxc_save_LIBS"
AC_LINK_IFELSE($testprog4, [acx_libxc_ok=yes; acx_libxc_v4=yes], [])
fi
# static linkage, version 3
if test x"$acx_libxc_ok" = xno; then
LIBS_LIBXC="$with_libxc_prefix/lib/libxcf90.a $with_libxc_prefix/lib/libxc.a"
LIBS_LIBXC="$with_libxc_prefix/lib/libxcf03.a $with_libxc_prefix/lib/libxc.a"
LIBS="$LIBS_LIBXC $acx_libxc_save_LIBS"
AC_LINK_IFELSE($testprog3, [acx_libxc_ok=yes; acx_libxc_v3=yes], [])
fi
fi
# dynamic linkage, version 4
# dynamic linkage, version 5
if test x"$acx_libxc_ok" = xno; then
if test ! -z "$with_libxc_prefix"; then
LIBS_LIBXC="-L$with_libxc_prefix/lib"
......@@ -98,6 +117,18 @@ if test x"$acx_libxc_ok" = xno; then
fi
LIBS_LIBXC="$LIBS_LIBXC -lxcf90 -lxc"
LIBS="$LIBS_LIBXC $acx_libxc_save_LIBS"
AC_LINK_IFELSE($testprog5, [acx_libxc_ok=yes; acx_libxc_v5=yes], [])
fi
# dynamic linkage, version 4
if test x"$acx_libxc_ok" = xno; then
if test ! -z "$with_libxc_prefix"; then
LIBS_LIBXC="-L$with_libxc_prefix/lib"
else
LIBS_LIBXC=""
fi
LIBS_LIBXC="$LIBS_LIBXC -lxcf03 -lxc"
LIBS="$LIBS_LIBXC $acx_libxc_save_LIBS"
AC_LINK_IFELSE($testprog4, [acx_libxc_ok=yes; acx_libxc_v4=yes], [])
fi
......@@ -108,7 +139,7 @@ if test x"$acx_libxc_ok" = xno; then
else
LIBS_LIBXC=""
fi
LIBS_LIBXC="$LIBS_LIBXC -lxcf90 -lxc"
LIBS_LIBXC="$LIBS_LIBXC -lxcf03 -lxc"
LIBS="$LIBS_LIBXC $acx_libxc_save_LIBS"
AC_LINK_IFELSE($testprog3, [acx_libxc_ok=yes; acx_libxc_v3=yes], [])
fi
......@@ -125,9 +156,12 @@ fi
AC_MSG_CHECKING([whether libxc version is 3.0])
AC_MSG_RESULT([$acx_libxc_v3])
AC_MSG_CHECKING([whether libxc version is >= 4.0])
AC_MSG_CHECKING([whether libxc version is 4])
AC_MSG_RESULT([$acx_libxc_v4])
AC_MSG_CHECKING([whether libxc version is 5])
AC_MSG_RESULT([$acx_libxc_v5])
if test x"$acx_libxc_v3" = xyes; then
AC_DEFINE(HAVE_LIBXC3, 1, [Defined if you have version 3 of the LIBXC library.])
fi
......@@ -136,6 +170,10 @@ if test x"$acx_libxc_v4" = xyes; then
AC_DEFINE(HAVE_LIBXC4, 1, [Defined if you have version 4 of the LIBXC library.])
fi
if test x"$acx_libxc_v5" = xyes; then
AC_DEFINE(HAVE_LIBXC5, 1, [Defined if you have version 5 of the LIBXC library.])
fi
AC_SUBST(FCFLAGS_LIBXC)
AC_SUBST(LIBS_LIBXC)
FCFLAGS="$acx_libxc_save_FCFLAGS"
......
......@@ -23,9 +23,9 @@
__kernel void ddot_matrix(const int np,
__global double const * restrict xx, const int ldxx,
__global double const * restrict yy, const int ldyy,
__global double * restrict dot, const int lddot){
__global double const * restrict xx, const int ldxx,
__global double const * restrict yy, const int ldyy,
__global double * restrict dot, const int lddot){
int ist = get_global_id(0);
int jst = get_global_id(1);
......@@ -41,15 +41,15 @@ __kernel void ddot_matrix(const int np,
}
__kernel void zdot_matrix(const int np,
__global double2 const * restrict xx, const int ldxx,
__global double2 const * restrict yy, const int ldyy,
__global double2 * restrict dot, const int lddot){
__global double2 const * restrict xx, const int ldxx,
__global double2 const * restrict yy, const int ldyy,
__global double2 * restrict dot, const int lddot){
int ist = get_global_id(0);
int jst = get_global_id(1);
if(ist >= lddot) return;
double2 tmp = (double2) (0.0);
for(int ip = 0; ip < np; ip++){
double2 a1 = xx[(ip<<ldxx) + ist];
......@@ -60,27 +60,28 @@ __kernel void zdot_matrix(const int np,
}
__kernel void zdot_matrix_spinors(const int np,
__global double4 const * restrict xx, const int ldxx,
__global double4 const * restrict yy, const int ldyy,
__global double2 * restrict dot, const int lddot){
const int nst_xx,
const int nst_yy,
__global double2 const * restrict xx, const int ldxx,
__global double2 const * restrict yy, const int ldyy,
__global double2 * restrict dot, const int lddot){
int ist = get_global_id(0);
int jst = get_global_id(1);
if(ist >= lddot) return;
if(ist >= nst_xx || jst >= nst_yy) return;
double2 tmp1 = (double2) (0.0);
double2 tmp2 = (double2) (0.0);
for(int ip = 0; ip < np; ip++){
double4 a1 = xx[(ip<<ldxx) + ist];
double4 a2 = yy[(ip<<ldyy) + jst];
#ifdef CUDA
tmp1 += complex_mul(complex_conj(double2(a1.x, a1.y)), double2(a2.x, a2.y));
tmp2 += complex_mul(complex_conj(double2(a1.z, a1.w)), double2(a2.z, a2.w));
#else
tmp1 += complex_mul(complex_conj((double2)(a1.x, a1.y)), (double2)(a2.x, a2.y));
tmp2 += complex_mul(complex_conj((double2)(a1.z, a1.w)), (double2)(a2.z, a2.w));
#endif
double2 a1 = xx[(ip<<ldxx) + 2*ist];
double2 a2 = yy[(ip<<ldyy) + 2*jst];
double2 b1 = xx[(ip<<ldxx) + 2*ist+1];
double2 b2 = yy[(ip<<ldyy) + 2*jst+1];
tmp1 += complex_mul(complex_conj(a1), a2);
tmp2 += complex_mul(complex_conj(b1), b2);
}
dot[ist + lddot*jst] = tmp1 + tmp2;
}
......
......@@ -471,7 +471,6 @@ noinst_HEADERS += \
hamiltonian/kxc_inc.F90 \
hamiltonian/lasers_inc.F90 \
hamiltonian/lda_u_inc.F90 \
hamiltonian/oct_exchange_inc.F90 \
hamiltonian/projector_inc.F90 \
hamiltonian/scdm_inc.F90 \
hamiltonian/scissor_inc.F90 \
......
......@@ -65,7 +65,7 @@ module global_oct_m
type(conf_t), public :: conf
FLOAT, public, parameter :: r_small = CNST(0.0001)
FLOAT, public, parameter :: R_SMALL = CNST(0.0001)
!> some mathematical constants
FLOAT, public, parameter :: M_Pi = CNST(3.1415926535897932384626433832795029)
......
......@@ -58,9 +58,8 @@ contains
!! principle, unlimited. We take the smallest prime number as table
!! size that is greater or equal than the requested size to reduce
!! collisions.
subroutine iihash_init(h, size)
subroutine iihash_init(h)
type(iihash_t), intent(out) :: h
integer, intent(in) :: size
interface
subroutine iihash_map_init(map)
......
......@@ -280,6 +280,12 @@ contains
#ifdef HAVE_BLUE_GENE_Q
get_config_opts = trim(get_config_opts)//' bluegene/q'
#endif
#ifdef HAVE_LIBXC4
get_config_opts = trim(get_config_opts)//' libxc4'
#endif
#ifdef HAVE_LIBXC5
get_config_opts = trim(get_config_opts)//' libxc5'
#endif
end function get_config_opts
......
......@@ -349,9 +349,8 @@ end subroutine X(orbitalbasis_build)
! ---------------------------------------------------------
!> This routine constructd an empty orbital basis.
! ---------------------------------------------------------
subroutine X(orbitalbasis_build_empty)(this, geo, mesh, kpt, ndim, nstates, verbose)
subroutine X(orbitalbasis_build_empty)(this, mesh, kpt, ndim, nstates, verbose)
type(orbitalbasis_t), intent(inout) :: this
type(geometry_t), target, intent(in) :: geo
type(distributed_t), intent(in) :: kpt
type(mesh_t), target, intent(in) :: mesh
integer, intent(in) :: ndim
......
......@@ -89,7 +89,7 @@ module cube_oct_m
contains
! ---------------------------------------------------------
subroutine cube_init(cube, nn, sb, namespace, fft_type, fft_library, dont_optimize, nn_out, verbose, &
subroutine cube_init(cube, nn, sb, namespace, fft_type, fft_library, dont_optimize, nn_out, &
mpi_grp, need_partition, spacing, tp_enlarge, blocksize)
type(cube_t), intent(out) :: cube
integer, intent(in) :: nn(3)
......@@ -100,7 +100,6 @@ contains
logical, optional, intent(in) :: dont_optimize !< if true, do not optimize grid for FFT
integer, optional, intent(out) :: nn_out(3) !< What are the FFT dims?
!! If optimized, may be different from input nn.
logical, optional, intent(in) :: verbose !< Print info to the screen.
type(mpi_grp_t), optional, intent(in) :: mpi_grp !< The mpi group to be use for cube parallelization
logical, optional, intent(in) :: need_partition !< Should we calculate and store the cube partition?
FLOAT, optional, intent(in) :: spacing(3)
......
......@@ -900,7 +900,7 @@ contains
lsize(1:3) = TOFLOAT(mesh%idx%ll(1:3))
offset(1:3) = TOFLOAT(mesh%idx%nr(1, 1:3) + mesh%idx%enlarge(1:3))
nops = symmetries_number(mesh%sb%symm)
nops = symmetries_number(sb%symm)
do ip = 1, mesh%np
!We use floating point coordinates to check if the symmetric point
......@@ -926,7 +926,7 @@ contains
! iterate over all points that go to this point by a symmetry operation
do iop = 1, nops
srcpoint = symm_op_apply_red(mesh%sb%symm%ops(iop), destpoint)
srcpoint = symm_op_apply_red(sb%symm%ops(iop), destpoint)
!We now come back to what should be an integer, if the symmetric point beloings to the grid
do idim = 1, 3
......@@ -937,7 +937,7 @@ contains
srcpoint = srcpoint + TOFLOAT(int(lsize)/2)
! apply periodic boundary conditions in periodic directions
do idim = 1, mesh%sb%periodic_dim
do idim = 1, sb%periodic_dim
if(nint(srcpoint(idim)) < 0 .or. nint(srcpoint(idim)) >= lsize(idim)) then
srcpoint(idim) = modulo(srcpoint(idim)+M_HALF*SYMPREC, lsize(idim))
end if
......
......@@ -30,18 +30,18 @@ subroutine X(mesh_batch_dotp_matrix)(mesh, aa, bb, dot, symm, reduce)
logical :: use_blas, conj
type(accel_mem_t) :: dot_buffer
type(profile_t), save :: prof_copy, prof_gemmcl, prof, profgemm
#ifdef HAVE_MPI
integer :: wgsize
integer :: local_sizes(3)
integer :: global_sizes(3)
logical :: reduce_
type(profile_t), save :: profcomm
#endif
PUSH_SUB(X(mesh_batch_dotp_matrix))
call profiling_in(prof, "DOTP_BATCH")
#ifdef HAVE_MPI
reduce_ = .true.
if(present(reduce)) reduce_ = reduce
#endif
conj = .false.
call aa%check_compatibility_with(bb, only_check_dim = .true.)
......@@ -141,28 +141,76 @@ subroutine X(mesh_batch_dotp_matrix)(mesh, aa, bb, dot, symm, reduce)
case(BATCH_DEVICE_PACKED)
ASSERT(.not. mesh%use_curvilinear)
call accel_create_buffer(dot_buffer, ACCEL_MEM_WRITE_ONLY, R_TYPE_VAL, aa%nst*bb%nst)
if(aa%dim==1) then
call accel_create_buffer(dot_buffer, ACCEL_MEM_WRITE_ONLY, R_TYPE_VAL, aa%nst*bb%nst)
call profiling_in(prof_gemmcl, "DOTP_BATCH_CL_GEMM")
call X(accel_gemm)(transA = CUBLAS_OP_N, transB = CUBLAS_OP_T, &
M = int(aa%nst, 8), N = int(bb%nst, 8), K = int(mesh%np, 8), alpha = R_TOTYPE(M_ONE), &
A = aa%ff_device, offA = 0_8, lda = int(aa%pack_size(1), 8), &
B = bb%ff_device, offB = 0_8, ldb = int(bb%pack_size(1), 8), beta = R_TOTYPE(M_ZERO), &
C = dot_buffer, offC = 0_8, ldc = int(aa%nst, 8))
call profiling_in(prof_gemmcl, "DOTP_BATCH_CL_GEMM")
call X(accel_gemm)(transA = CUBLAS_OP_N, transB = CUBLAS_OP_T, &
M = int(aa%nst, 8), N = int(bb%nst, 8), K = int(mesh%np, 8), alpha = R_TOTYPE(M_ONE), &
A = aa%ff_device, offA = 0_8, lda = int(aa%pack_size(1), 8), &
B = bb%ff_device, offB = 0_8, ldb = int(bb%pack_size(1), 8), beta = R_TOTYPE(M_ZERO), &
C = dot_buffer, offC = 0_8, ldc = int(aa%nst, 8))
call profiling_count_operations(TOFLOAT(mesh%np)*aa%nst*bb%nst*(R_ADD + R_MUL))
call accel_finish()
call profiling_out(prof_gemmcl)
call profiling_in(prof_copy, 'DOTP_BATCH_COPY')
call accel_read_buffer(dot_buffer, aa%nst*bb%nst, dd)
call profiling_count_transfers(aa%nst*bb%nst, dd(1, 1))
call accel_finish()
call profiling_out(prof_copy)
call accel_release_buffer(dot_buffer)
call profiling_count_operations(TOFLOAT(mesh%np)*aa%nst*bb%nst*(R_ADD + R_MUL))
else
call accel_finish()
call profiling_out(prof_gemmcl)
ASSERT(R_TYPE_VAL == TYPE_CMPLX)
call profiling_in(prof_copy, 'DOTP_BATCH_COPY')
call accel_read_buffer(dot_buffer, aa%nst*bb%nst, dd)
call profiling_count_transfers(aa%nst*bb%nst, dd(1, 1))
call accel_finish()
call profiling_out(prof_copy)
call accel_create_buffer(dot_buffer, ACCEL_MEM_WRITE_ONLY, R_TYPE_VAL, aa%nst*bb%nst)
call accel_release_buffer(dot_buffer)
wgsize = accel_kernel_workgroup_size(zkernel_dot_matrix_spinors)
global_sizes = (/ pad(aa%nst, wgsize/bb%nst), bb%nst, 1 /)
local_sizes = (/ wgsize/bb%nst, bb%nst, 1 /)
ASSERT(accel_buffer_is_allocated(aa%ff_device))
ASSERT(accel_buffer_is_allocated(bb%ff_device))
ASSERT(accel_buffer_is_allocated(dot_buffer))
call profiling_in(prof_gemmcl, "DOTP_BATCH_CL_KERNEL")
call accel_set_kernel_arg(zkernel_dot_matrix_spinors, 0, mesh%np)
call accel_set_kernel_arg(zkernel_dot_matrix_spinors, 1, aa%nst)
call accel_set_kernel_arg(zkernel_dot_matrix_spinors, 2, bb%nst)
call accel_set_kernel_arg(zkernel_dot_matrix_spinors, 3, aa%ff_device)
call accel_set_kernel_arg(zkernel_dot_matrix_spinors, 4, log2(aa%pack_size(1)))
call accel_set_kernel_arg(zkernel_dot_matrix_spinors, 5, bb%ff_device)
call accel_set_kernel_arg(zkernel_dot_matrix_spinors, 6, log2(bb%pack_size(1)))
call accel_set_kernel_arg(zkernel_dot_matrix_spinors, 7, dot_buffer)
call accel_set_kernel_arg(zkernel_dot_matrix_spinors, 8, aa%nst)
call accel_kernel_run(zkernel_dot_matrix_spinors, global_sizes, local_sizes)
call accel_finish()
call profiling_count_operations(TOFLOAT(aa%nst*bb%nst*(mesh%np*(R_ADD + R_MUL)) + R_ADD )) ! check !!
call profiling_out(prof_gemmcl)
call profiling_in(prof_copy, 'DOTP_BATCH_COPY')
call accel_read_buffer(dot_buffer, aa%nst*bb%nst, dd)
call profiling_count_transfers(aa%nst*bb%nst, dd(1, 1))
call accel_finish()
call profiling_out(prof_copy)
call accel_release_buffer(dot_buffer)
end if
do ist = 1, aa%nst
do jst = 1, bb%nst
......@@ -185,13 +233,11 @@ subroutine X(mesh_batch_dotp_matrix)(mesh, aa, bb, dot, symm, reduce)
if(use_blas) call profiling_out(profgemm)
#ifdef HAVE_MPI
if(mesh%parallel_in_domains .and. reduce_) then
call profiling_in(profcomm, "DOTP_BATCH_REDUCE")
call comm_allreduce(mesh%mpi_grp%comm, dd)
call profiling_out(profcomm)
end if
#endif
if(conj) then
do jst = 1, bb%nst
......@@ -315,8 +361,8 @@ subroutine X(mesh_batch_dotp_self)(mesh, aa, dot, reduce)
call profiling_out(profcomm)
end if
do jst = 1, aa%nst
do ist = 1, aa%nst
do ist = 1, aa%nst
do jst = 1, ist
dot(aa%ist(ist), aa%ist(jst)) = dd(ist, jst)
dot(aa%ist(jst), aa%ist(ist)) = R_CONJ(dd(ist, jst))
end do
......
......@@ -329,10 +329,11 @@ end function X(mf_moment)
! ---------------------------------------------------------
!> This subroutine fills a function with randon values.
subroutine X(mf_random)(mesh, ff, shift, seed, normalized)
subroutine X(mf_random)(mesh, ff, pre_shift, post_shift, seed, normalized)
type(mesh_t), intent(in) :: mesh
R_TYPE, intent(out) :: ff(:)
integer, optional, intent(in) :: shift
integer, optional, intent(in) :: pre_shift
integer, optional, intent(in) :: post_shift
integer, optional, intent(in) :: seed
logical, optional, intent(in) :: normalized !< whether generate states should have norm 1, true by default
......@@ -348,13 +349,27 @@ subroutine X(mf_random)(mesh, ff, shift, seed, normalized)
iseed = iseed + seed
end if
if(present(shift)) then
!We skip shift times the seed
call shiftseed(iseed, shift)
if(present(pre_shift)) then
!We skip shift times the seed to compensate for MPI tasks dealing with previous mesh points
call shiftseed(iseed, pre_shift)
#if defined(R_TCOMPLEX)
! for complex wave functions we need to shift twice (real and imag part).
call shiftseed(iseed, pre_shift)
#endif
end if
call quickrnd(iseed, mesh%np, ff(1:mesh%np))
if(present(post_shift)) then
!We skip shift times the seed to compensate for MPI tasks dealing with posteriour mesh points
call shiftseed(iseed, post_shift)
#if defined(R_TCOMPLEX)
! for complex wave functions we need to shift twice (real and imag part).
call shiftseed(iseed, post_shift)
#endif
end if
if(optional_default(normalized, .true.)) then
rr = X(mf_nrm2)(mesh, ff)
call lalg_scal(mesh%np, R_TOTYPE(1.0)/rr, ff)
......
......@@ -327,7 +327,7 @@ contains
! Mark and count ghost points and neighbours
! (set vp%np_ghost_neigh, vp%np_ghost, ghost_flag).
do inode = 1, npart
call iihash_init(ghost_flag(inode), vp%np_local_vec(inode))
call iihash_init(ghost_flag(inode))
end do
do jj = 1, stencil%size
......@@ -608,7 +608,7 @@ contains
! initialize to zero all input
do inode = 1, npart
if (inode /= vp%partno) then
call iihash_init(vp%global(inode),1)
call iihash_init(vp%global(inode))
end if
end do
ii = xbndry_tmp(vp%partno) + np_bndry_tmp(vp%partno)
......@@ -627,8 +627,7 @@ contains
do inode = ip, jp
! Create hash table.
call iihash_init(vp%global(inode), vp%np_local_vec(inode) + &
np_ghost_tmp(inode) + np_bndry_tmp(inode))
call iihash_init(vp%global(inode))
! Insert local points.
do kp = 1, vp%np_local_vec(inode)
call iihash_insert(vp%global(inode), vp%local_vec(vp%xlocal_vec(inode) + kp - 1), kp)
......
......@@ -150,7 +150,7 @@ contains
! processes that are on the same column of the partition map than
! the local process. Note that this implies that there are always
! mpi_grp_in%size possible receivers.
call iihash_init(map_out, mpi_grp_in%size)
call iihash_init(map_out)
do ipart = 1, grp2%size
if (mpi_grp_in%size >= mpi_grp_out%size) then
do ip = 1, n12
......
......@@ -767,9 +767,8 @@ contains
end subroutine submesh_get_cube_dim
!------------------------------------------------------------
subroutine submesh_init_cube_map(sm, db, dim)
subroutine submesh_init_cube_map(sm, dim)
type(submesh_t), intent(inout) :: sm
integer, intent(in) :: db(:)
integer, intent(in) :: dim
integer :: ip, idir
......
......@@ -519,11 +519,9 @@ subroutine X(submesh_batch_dotp_matrix)(this, mm, ss, dot, reduce)
end if
#if defined(HAVE_MPI)
if(optional_default(reduce, .true.) .and. this%mesh%parallel_in_domains) then
call comm_allreduce(this%mesh%mpi_grp%comm, dot, dim = (/mm%nst, ss%nst/))
end if
#endif
POP_SUB(X(submesh_batch_dotp_matrix))
end subroutine X(submesh_batch_dotp_matrix)
......
......@@ -130,10 +130,10 @@ contains
end subroutine volume_read_from_block
logical function volume_in_volume(sb, vol, xx, rr) result(in_vol)
logical function volume_in_volume(sb, vol, xx) result(in_vol)
type(simul_box_t), intent(in) :: sb
type(volume_t), intent(in) :: vol
FLOAT, intent(in) :: xx(:), rr
FLOAT, intent(in) :: xx(:)
logical :: in_partial_volume
integer :: i
......
......@@ -842,7 +842,7 @@ contains
call mesh_r(mesh, ip, rr, origin=geo%catom(ia)%x)
select case(ep%classical_pot)
case(CLASSICAL_POINT)
if(rr < r_small) rr = r_small
if(rr < R_SMALL) rr = R_SMALL
ep%Vclassical(ip) = ep%Vclassical(ip) - geo%catom(ia)%charge/rr
case(CLASSICAL_GAUSSIAN)
select case(geo%catom(ia)%label(1:1)) ! covalent radii
......@@ -853,7 +853,7 @@ contains
case default
rc = CNST(0.7) * P_Ang
end select
if(abs(rr - rc) < r_small) rr = rc + sign(r_small, rr - rc)
if(abs(rr - rc) < R_SMALL) rr = rc + sign(R_SMALL, rr - rc)
ep%Vclassical(ip) = ep%Vclassical(ip) - geo%catom(ia)%charge * (rr**4 - rc**4) / (rr**5 - rc**5)
case default
message(1) = 'Unknown type of classical potential in epot_generate_classical'
......
......@@ -100,14 +100,13 @@ contains
POP_SUB(exchange_operator_nullify)
end subroutine exchange_operator_nullify
subroutine exchange_operator_init(this, namespace, st, sb, der, mc, mesh, omega, alpha, beta)
subroutine exchange_operator_init(this, namespace, st, sb, der, mc, omega, alpha, beta)
type(exchange_operator_t), intent(inout) :: this
type(namespace_t), target, intent(in) :: namespace
type(states_elec_t), intent(in) :: st
type(simul_box_t), intent(in) :: sb
type(derivatives_t), intent(in) :: der
type(multicomm_t), intent(in) :: mc
type(mesh_t), intent(in) :: mesh
FLOAT, intent(in) :: omega, alpha, beta
PUSH_SUB(exchange_operator_init)
......
......@@ -70,9 +70,9 @@ module xc_functl_oct_m
integer :: spin_channels !< XC_UNPOLARIZED | XC_POLARIZED
integer :: flags !< XC_FLAGS_HAVE_EXC + XC_FLAGS_HAVE_VXC + ...
type(XC_F90(pointer_t)) :: conf !< the pointer used to call the library
type(XC_F90(pointer_t)), private :: info !< information about the functional
type(libvdwxc_t) :: libvdwxc !< libvdwxc data for van der Waals functionals