Fortran implementation of create_atoms + unittests

This commit is contained in:
Karl Hammond 2022-10-19 09:56:54 -05:00
parent b44e353d4a
commit 9a732ba513
No known key found for this signature in database
4 changed files with 255 additions and 3 deletions

View File

@ -119,11 +119,16 @@ MODULE LIBLAMMPS
PROCEDURE, PRIVATE :: lmp_scatter_atoms_double
GENERIC :: scatter_atoms => lmp_scatter_atoms_int, &
lmp_scatter_atoms_double
!
PROCEDURE, PRIVATE :: lmp_scatter_atoms_subset_int
PROCEDURE, PRIVATE :: lmp_scatter_atoms_subset_double
GENERIC :: scatter_atoms_subset => lmp_scatter_atoms_subset_int, &
lmp_scatter_atoms_subset_double
!
PROCEDURE, PRIVATE :: lmp_create_atoms_int
PROCEDURE, PRIVATE :: lmp_create_atoms_bigbig
GENERIC :: create_atoms => lmp_create_atoms_int, &
lmp_create_atoms_bigbig
!
PROCEDURE :: version => lmp_version
PROCEDURE,NOPASS :: get_os_info => lmp_get_os_info
PROCEDURE,NOPASS :: config_has_mpi_support => lmp_config_has_mpi_support
@ -462,8 +467,13 @@ MODULE LIBLAMMPS
!SUBROUTINE lammps_scatter_subset
!(generic / id, type, and image are special) / requires LAMMPS_BIGBIG
!INTEGER(c_int) FUNCTION lammps_create_atoms
INTEGER(c_int) FUNCTION lammps_create_atoms(handle, n, id, type, x, v, &
image, bexpand) BIND(C)
IMPORT :: c_ptr, c_int
IMPLICIT NONE
TYPE(c_ptr), VALUE :: handle, id, type, x, v, image
INTEGER(c_int), VALUE :: n, bexpand
END FUNCTION lammps_create_atoms
!INTEGER(c_int) FUNCTION lammps_find_pair_neighlist
@ -1484,6 +1494,7 @@ CONTAINS
CALL lammps_free(Cname)
END SUBROUTINE lmp_scatter_atoms_double
! equivalent function to lammps_scatter_atoms_subset (for integers)
SUBROUTINE lmp_scatter_atoms_subset_int(self, name, ids, data)
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*), INTENT(IN) :: name
@ -1508,6 +1519,7 @@ CONTAINS
CALL lammps_free(Cname)
END SUBROUTINE lmp_scatter_atoms_subset_int
! equivalent function to lammps_scatter_atoms_subset (for doubles)
SUBROUTINE lmp_scatter_atoms_subset_double(self, name, ids, data)
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*), INTENT(IN) :: name
@ -1532,6 +1544,83 @@ CONTAINS
CALL lammps_free(Cname)
END SUBROUTINE lmp_scatter_atoms_subset_double
! equivalent function to lammps_create_atoms
SUBROUTINE lmp_create_atoms_int(self, id, type, x, v, image, bexpand)
CLASS(lammps), INTENT(IN) :: self
INTEGER(c_int), DIMENSION(:), TARGET :: id, image
INTEGER(c_int), DIMENSION(:), TARGET :: type
REAL(c_double), DIMENSION(:), TARGET :: x, v
LOGICAL :: bexpand
INTEGER(c_int) :: n, Cbexpand
TYPE(c_ptr) :: Cid, Ctype, Cx, Cv, Cimage
INTEGER(c_int) :: tagint_size, atoms_created
tagint_size = lmp_extract_setting(self, 'tagint')
IF ( tagint_size /= 4_c_int ) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'Unable to create_atoms; your id/image array types are incompatible&
& with LAMMPS_SMALLBIG and LAMMPS_SMALLSMALL [Fortran/create_atoms]')
END IF
n = SIZE(id, KIND=c_int)
IF ( bexpand) THEN
Cbexpand = 1_c_int
ELSE
Cbexpand = 0
END IF
Cid = C_LOC(id(1))
Ctype = C_LOC(type(1))
Cimage = C_LOC(image(1))
Cx = C_LOC(x(1))
Cv = C_LOC(v(1))
atoms_created = lammps_create_atoms(self%handle, n, Cid, Ctype, Cx, Cv, &
Cimage, Cbexpand)
IF ( atoms_created < 0_c_int ) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'error when trying to create atoms [Fortran/create_atoms]')
ELSE IF ( atoms_created /= n ) THEN
CALL lmp_error(self, LMP_ERROR_WARNING + LMP_ERROR_WORLD, &
'atoms created /= atoms asked to create [Fortran/create_atoms]')
END IF
END SUBROUTINE lmp_create_atoms_int
SUBROUTINE lmp_create_atoms_bigbig(self, id, type, x, v, image, bexpand)
CLASS(lammps), INTENT(IN) :: self
INTEGER(c_int64_t), DIMENSION(:), TARGET :: id, image
INTEGER(c_int), DIMENSION(:), TARGET :: type
REAL(c_double), DIMENSION(:), TARGET :: x, v
LOGICAL :: bexpand
INTEGER(c_int) :: n, Cbexpand
TYPE(c_ptr) :: Cid, Ctype, Cx, Cv, Cimage
INTEGER(c_int) :: tagint_size, atoms_created
tagint_size = lmp_extract_setting(self, 'tagint')
IF ( tagint_size /= 8_c_int ) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'Unable to create_atoms; your id/image array types are incompatible&
& with LAMMPS_BIGBIG')
END IF
n = SIZE(id, KIND=c_int)
IF ( bexpand) THEN
Cbexpand = 1_c_int
ELSE
Cbexpand = 0
END IF
Cid = C_LOC(id(1))
Ctype = C_LOC(type(1))
Cimage = C_LOC(image(1))
Cx = C_LOC(x(1))
Cv = C_LOC(v(1))
atoms_created = lammps_create_atoms(self%handle, n, Cid, Ctype, Cx, Cv, &
Cimage, Cbexpand)
IF ( atoms_created < 0_c_int ) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'error when trying to create atoms [Fortran/create_atoms]')
ELSE IF ( atoms_created /= n ) THEN
CALL lmp_error(self, LMP_ERROR_WARNING + LMP_ERROR_WORLD, &
'atoms created /= atoms asked to create [Fortran/create_atoms]')
END IF
END SUBROUTINE lmp_create_atoms_bigbig
! equivalent function to lammps_version
INTEGER FUNCTION lmp_version(self)
CLASS(lammps), INTENT(IN) :: self

View File

@ -78,6 +78,10 @@ if(CMAKE_Fortran_COMPILER)
target_link_libraries(test_fortran_gather_scatter PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain)
add_test(NAME FortranGatherScatter COMMAND test_fortran_gather_scatter)
add_executable(test_fortran_create_atoms wrap_create_atoms.cpp test_fortran_create_atoms.f90)
target_link_libraries(test_fortran_create_atoms PRIVATE flammps lammps MPI::MPI_Fortran GTest::GTestMain)
add_test(NAME FortranCreateAtoms COMMAND test_fortran_create_atoms)
else()
message(STATUS "Skipping Tests for the LAMMPS Fortran Module: no Fortran compiler")
endif()

View File

@ -0,0 +1,68 @@
FUNCTION f_lammps_with_args() BIND(C)
USE ISO_C_BINDING, ONLY: c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY: lmp
IMPLICIT NONE
TYPE(c_ptr) :: f_lammps_with_args
CHARACTER(len=12), DIMENSION(12), PARAMETER :: args = &
[ CHARACTER(len=12) :: 'liblammps', '-log', 'none', &
'-echo','screen','-nocite','-var','zpos','1.5','-var','x','2']
lmp = lammps(args)
f_lammps_with_args = lmp%handle
END FUNCTION f_lammps_with_args
SUBROUTINE f_lammps_close() BIND(C)
USE ISO_C_BINDING, ONLY: c_null_ptr
USE liblammps
USE keepstuff, ONLY: lmp
IMPLICIT NONE
CALL lmp%close()
lmp%handle = c_null_ptr
END SUBROUTINE f_lammps_close
SUBROUTINE f_lammps_setup_create_atoms() BIND(C)
USE LIBLAMMPS
USE keepstuff, ONLY : lmp, big_input, cont_input, more_input
IMPLICIT NONE
!CALL lmp%command('atom_modify map array')
CALL lmp%commands_list(big_input)
CALL lmp%commands_list(cont_input)
CALL lmp%commands_list(more_input)
END SUBROUTINE f_lammps_setup_create_atoms
SUBROUTINE f_lammps_create_three_atoms() BIND(C)
USE ISO_C_BINDING, ONLY: c_double, c_int, c_int64_t
USE keepstuff, ONLY : lmp, big_input, cont_input, more_input
USE LIBLAMMPS
IMPLICIT NONE
INTEGER(c_int), DIMENSION(3) :: new_ids, new_images, new_types
INTEGER(c_int64_t), DIMENSION(3) :: new_big_ids, new_big_images
REAL(c_double), DIMENSION(9) :: new_x, new_v
LOGICAL :: wrap
INTEGER(c_int) :: tagint_size
new_ids = [4, 6, 5]
new_big_ids = [4, 6, 5]
new_images = [0, 0, 1]
new_big_images = [0, 0, 1]
new_types = [1, 1, 1]
new_x = [ 1.0_c_double, 1.8_c_double, 2.718281828_c_double, &
0.6_c_double, 0.8_c_double, 2.2_c_double, &
1.8_c_double, 0.1_c_double, 1.8_c_double ]
new_v = [ 0.0_c_double, 1.0_c_double, -1.0_c_double, &
0.1_c_double, 0.2_c_double, -0.2_c_double, &
1.0_c_double, -1.0_c_double, 3.0_c_double ]
wrap = .FALSE.
tagint_size = lmp%extract_setting('tagint')
IF ( tagint_size == 4_c_int ) THEN
CALL lmp%create_atoms(new_ids, new_types, new_x, new_v, new_images, wrap)
ELSE
CALL lmp%create_atoms(new_big_ids, new_types, new_x, new_v, &
new_big_images, wrap)
END IF
END SUBROUTINE f_lammps_create_three_atoms
! vim: ts=2 sts=2 sw=2 et

View File

@ -0,0 +1,91 @@
// unit tests for creating atoms in a LAMMPS instance through the Fortran wrapper
#include "lammps.h"
#include "library.h"
#include "atom.h"
#include <cstdint>
#include <cstdlib>
#include <mpi.h>
#include <string>
#include "gtest/gtest.h"
// prototypes for Fortran reverse wrapper functions
extern "C" {
void *f_lammps_with_args();
void f_lammps_close();
void f_lammps_setup_create_atoms();
void f_lammps_create_three_atoms();
}
class LAMMPS_create_atoms : public ::testing::Test {
protected:
LAMMPS_NS::LAMMPS *lmp;
LAMMPS_create_atoms() = default;
~LAMMPS_create_atoms() override = default;
void SetUp() override
{
::testing::internal::CaptureStdout();
lmp = (LAMMPS_NS::LAMMPS *)f_lammps_with_args();
std::string output = ::testing::internal::GetCapturedStdout();
EXPECT_STREQ(output.substr(0, 8).c_str(), "LAMMPS (");
}
void TearDown() override
{
::testing::internal::CaptureStdout();
f_lammps_close();
std::string output = ::testing::internal::GetCapturedStdout();
EXPECT_STREQ(output.substr(0, 16).c_str(), "Total wall time:");
lmp = nullptr;
}
};
TEST_F(LAMMPS_create_atoms, create_two)
{
f_lammps_setup_create_atoms();
#ifdef LAMMPS_BIGBIG
int64_t *tag, *image;
#else
int *tag, *image;
#endif
int *type;
double **x, **v;
EXPECT_EQ(lmp->atom->nlocal, 3);
tag = lmp->atom->tag;
image = lmp->atom->image;
x = lmp->atom->x;
v = lmp->atom->v;
type = lmp->atom->type;
f_lammps_create_three_atoms();
EXPECT_EQ(lmp->atom->nlocal, 6);
for (int i = 0; i < lmp->atom->nlocal; i++) {
if (tag[i] == 4) {
EXPECT_EQ(image[i],0);
EXPECT_DOUBLE_EQ(x[i][0],1.0);
EXPECT_DOUBLE_EQ(x[i][1],1.8);
EXPECT_DOUBLE_EQ(x[i][2],2.718281828);
EXPECT_DOUBLE_EQ(v[i][0],0.0);
EXPECT_DOUBLE_EQ(v[i][1],1.0);
EXPECT_DOUBLE_EQ(v[i][2],-1.0);
}
if (tag[i] == 5) {
EXPECT_EQ(image[i],1);
EXPECT_DOUBLE_EQ(x[i][0],1.8);
EXPECT_DOUBLE_EQ(x[i][1],0.1);
EXPECT_DOUBLE_EQ(x[i][2],1.8);
EXPECT_DOUBLE_EQ(v[i][0],1.0);
EXPECT_DOUBLE_EQ(v[i][1],-1.0);
EXPECT_DOUBLE_EQ(v[i][2],3.0);
}
if (tag[i] == 6) {
EXPECT_EQ(image[i],0);
EXPECT_DOUBLE_EQ(x[i][0],0.6);
EXPECT_DOUBLE_EQ(x[i][1],0.8);
EXPECT_DOUBLE_EQ(x[i][2],2.2);
EXPECT_DOUBLE_EQ(v[i][0],0.1);
EXPECT_DOUBLE_EQ(v[i][1],0.2);
EXPECT_DOUBLE_EQ(v[i][2],-0.2);
}
}
};