continued ork on extract_compute unit tests

This commit is contained in:
Karl Hammond
2022-09-24 12:04:27 -05:00
parent 69627eee8d
commit 26e269aacd
4 changed files with 25 additions and 98 deletions

View File

@ -61,6 +61,10 @@ if(CMAKE_Fortran_COMPILER)
target_link_libraries(test_fortran_extract_atom PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain)
add_test(NAME FortranExtractAtom COMMAND test_fortran_extract_atom)
add_executable(test_fortran_extract_compute wrap_extract_compute.cpp test_fortran_extract_compute.f90)
target_link_libraries(test_fortran_extract_compute PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain)
add_test(NAME FortranExtractCompute COMMAND test_fortran_extract_compute)
else()
message(STATUS "Skipping Tests for the LAMMPS Fortran Module: no Fortran compiler")
endif()

View File

@ -17,10 +17,10 @@ MODULE keepcompute
'mass 1 2.0' ]
END MODULE keepcompute
FUNCTION f_lammps_with_args() BIND(C, name="f_lammps_with_args")
FUNCTION f_lammps_with_args() BIND(C)
USE ISO_C_BINDING, ONLY: c_ptr
USE liblammps
USE keepatom, ONLY: lmp
USE keepcompute, ONLY: lmp
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_with_args
CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = &
@ -31,10 +31,10 @@ FUNCTION f_lammps_with_args() BIND(C, name="f_lammps_with_args")
f_lammps_with_args = lmp%handle
END FUNCTION f_lammps_with_args
SUBROUTINE f_lammps_close() BIND(C, name="f_lammps_close")
SUBROUTINE f_lammps_close() BIND(C)
USE ISO_C_BINDING, ONLY: c_null_ptr
USE liblammps
USE keepatom, ONLY: lmp
USE keepcompute, ONLY: lmp
IMPLICIT NONE
CALL lmp%close()
@ -43,7 +43,7 @@ END SUBROUTINE f_lammps_close
SUBROUTINE f_lammps_setup_extract_compute () BIND(C)
USE LIBLAMMPS
USE keepatom, ONLY : lmp, demo_input, cont_input, pair_input
USE keepcompute, ONLY : lmp, demo_input, cont_input, pair_input
IMPLICIT NONE
CALL lmp%commands_list(demo_input)
@ -56,94 +56,17 @@ SUBROUTINE f_lammps_setup_extract_compute () BIND(C)
CALL lmp%command("compute 1 all rdf 100") ! global array
CALL lmp%command("compute pairdist all pair/local dist") ! local vector
CALL lmp%command("compute pairlocal all pair/local dist dx dy dz") ! local array
END SUBROUTINE f_lammps_setup_extract_atom
END SUBROUTINE f_lammps_setup_extract_compute
FUNCTION f_lammps_extract_atom_mass () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
USE LIBLAMMPS
USE keepatom, ONLY : lmp
IMPLICIT NONE
REAL(C_double) :: f_lammps_extract_atom_mass
REAL(C_double), DIMENSION(:), POINTER :: mass => NULL()
mass = lmp%extract_atom('mass')
f_lammps_extract_atom_mass = mass(1)
END FUNCTION f_lammps_extract_atom_mass
FUNCTION f_lammps_extract_atom_tag_int (i) BIND(C)
FUNCTION f_lammps_extract_compute_peratom_vector (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepatom, ONLY : lmp
USE keepcompute, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
INTEGER(C_int) :: f_lammps_extract_atom_tag_int
INTEGER(C_int), DIMENSION(:), POINTER :: tag => NULL()
REAL(C_double) :: f_lammps_extract_compute_peratom_vector
REAL(C_double), DIMENSION(:), POINTER :: vector => NULL()
tag = lmp%extract_atom('id')
f_lammps_extract_atom_tag_int = tag(i)
END FUNCTION f_lammps_extract_atom_tag_int
FUNCTION f_lammps_extract_atom_tag_int64 (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int64_t
USE LIBLAMMPS
USE keepatom, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int64_t), INTENT(IN), VALUE :: i
INTEGER(C_int64_t) :: f_lammps_extract_atom_tag_int64
INTEGER(C_int64_t), DIMENSION(:), POINTER :: tag => NULL()
tag = lmp%extract_atom('id')
f_lammps_extract_atom_tag_int64 = tag(i)
END FUNCTION f_lammps_extract_atom_tag_int64
FUNCTION f_lammps_extract_atom_type(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
USE LIBLAMMPS
USE keepatom, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
INTEGER(C_int) :: f_lammps_extract_atom_type
INTEGER(C_int), DIMENSION(:), POINTER :: atype => NULL()
atype = lmp%extract_atom('type')
f_lammps_extract_atom_type = atype(i)
END FUNCTION f_lammps_extract_atom_type
FUNCTION f_lammps_extract_atom_mask(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
USE LIBLAMMPS
USE keepatom, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
INTEGER(C_int) :: f_lammps_extract_atom_mask
INTEGER(C_int), DIMENSION(:), POINTER :: mask => NULL()
mask = lmp%extract_atom('mask')
f_lammps_extract_atom_mask = mask(i)
END FUNCTION f_lammps_extract_atom_mask
SUBROUTINE f_lammps_extract_atom_x (i, x) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepatom, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
REAL(C_double), DIMENSION(3) :: x
REAL(C_double), DIMENSION(:,:), POINTER :: xptr => NULL()
xptr = lmp%extract_atom('x')
x = xptr(:,i)
END SUBROUTINE f_lammps_extract_atom_x
SUBROUTINE f_lammps_extract_atom_v (i, v) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE LIBLAMMPS
USE keepatom, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
REAL(C_double), DIMENSION(3) :: v
REAL(C_double), DIMENSION(:,:), POINTER :: vptr => NULL()
vptr = lmp%extract_atom('v')
v = vptr(:,i)
END SUBROUTINE f_lammps_extract_atom_v
vector = lmp%extract_compute('peratompe', lmp%style%atom, lmp%type%vector)
f_lammps_extract_compute_peratom_vector = vector(i)
END FUNCTION f_lammps_extract_compute_peratom_vector