ICODE-ADC/lammps
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

unit test for gather and scatter; char* to const char* in library.*

Browse Source
This commit is contained in:
Karl Hammond
2022-12-03 20:38:42 -06:00
parent 2f321576c5
commit c0345845e8
4 changed files with 231 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files

92
unittest/fortran/test_fortran_gather_scatter.f90
View File

@ -24,13 +24,16 @@ END SUBROUTINE f_lammps_close
SUBROUTINE f_lammps_setup_gather_scatter() BIND(C)
USE LIBLAMMPS
USE keepstuff, ONLY : lmp, big_input, cont_input, more_input
USE keepstuff, ONLY : lmp, big_input, cont_input, more_input, pair_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)
CALL lmp%commands_list(pair_input)
CALL lmp%command('mass 1 1.0')
CALL lmp%command("compute pe all pe/atom")
END SUBROUTINE f_lammps_setup_gather_scatter
FUNCTION f_lammps_gather_atoms_mask(i) BIND(C)
@ -262,3 +265,90 @@ FUNCTION f_lammps_test_gather_bonds_big() BIND(C) RESULT(success)
success = 0_c_int
END IF
END FUNCTION f_lammps_test_gather_bonds_big
FUNCTION f_lammps_gather_pe_atom(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i
REAL(c_double) :: f_lammps_gather_pe_atom
REAL(c_double), DIMENSION(:), ALLOCATABLE :: pe_atom
CALL lmp%gather('c_pe', 1_c_int, pe_atom)
f_lammps_gather_pe_atom = pe_atom(i)
END FUNCTION f_lammps_gather_pe_atom
FUNCTION f_lammps_gather_pe_atom_concat(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i
REAL(c_double) :: f_lammps_gather_pe_atom_concat
REAL(c_double), DIMENSION(:), ALLOCATABLE :: pe_atom
INTEGER(c_int), DIMENSION(:), ALLOCATABLE :: tag
INTEGER :: j
CALL lmp%gather_concat('id', 1_c_int, tag)
CALL lmp%gather_concat('c_pe', 1_c_int, pe_atom)
DO j = 1, SIZE(tag)
IF (tag(j) == i) THEN
f_lammps_gather_pe_atom_concat = pe_atom(j)
EXIT
END IF
END DO
f_lammps_gather_pe_atom_concat = pe_atom(i)
END FUNCTION f_lammps_gather_pe_atom_concat
SUBROUTINE f_lammps_gather_pe_atom_subset(ids, pe) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN) :: ids(2)
REAL(c_double), INTENT(OUT) :: pe(2)
REAL(c_double), DIMENSION(:), ALLOCATABLE :: pe_atom
INTEGER(c_int) :: natoms
natoms = NINT(lmp%get_natoms(), c_int)
CALL lmp%gather_subset('c_pe', 1, ids, pe_atom)
pe(1:natoms) = pe_atom
END SUBROUTINE f_lammps_gather_pe_atom_subset
SUBROUTINE f_lammps_scatter_compute() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL(c_double), DIMENSION(:), ALLOCATABLE :: pe_atom
REAL(c_double) :: swap
CALL lmp%gather('c_pe', 1_c_int, pe_atom)
! swap the computed energy of atoms 1 and 3
swap = pe_atom(1)
pe_atom(1) = pe_atom(3)
pe_atom(3) = swap
CALL lmp%scatter('c_pe', pe_atom) ! push the swap back to LAMMPS
END SUBROUTINE f_lammps_scatter_compute
SUBROUTINE f_lammps_scatter_subset_compute() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), PARAMETER :: ids(2) = [3,1]
REAL(c_double), DIMENSION(:), ALLOCATABLE :: pe_atom
REAL(c_double) :: swap
CALL lmp%gather_subset('c_pe', 1_c_int, ids, pe_atom)
! swap the computed energy of atoms 1 and 3
swap = pe_atom(1)
pe_atom(1) = pe_atom(2)
pe_atom(2) = swap
CALL lmp%scatter_subset('c_pe', ids, pe_atom) ! push the swap back to LAMMPS
END SUBROUTINE f_lammps_scatter_subset_compute

108
unittest/fortran/wrap_gather_scatter.cpp
View File

@ -3,6 +3,7 @@
#include "lammps.h"
#include "library.h"
#include "atom.h"
#include <cstdint>
#include <cstdlib>
#include <mpi.h>
@ -26,6 +27,11 @@ void f_lammps_scatter_atoms_positions();
void f_lammps_setup_gather_bonds();
int f_lammps_test_gather_bonds_small();
int f_lammps_test_gather_bonds_big();
double f_lammps_gather_pe_atom(int);
double f_lammps_gather_pe_atom_concat(int);
void f_lammps_gather_pe_atom_subset(int*, double*);
void f_lammps_scatter_compute();
void f_lammps_scatter_subset_compute();
}
using namespace LAMMPS_NS;
@ -216,3 +222,105 @@ TEST_F(LAMMPS_gather_scatter, gather_bonds)
#endif
};
TEST_F(LAMMPS_gather_scatter, gather_compute)
{
#ifdef LAMMPS_BIGBIG
GTEST_SKIP()
#endif
f_lammps_setup_gather_scatter();
lammps_command(lmp, "run 0");
int natoms = lmp->atom->natoms;
int *tag = lmp->atom->tag;
double *pe = (double*) lammps_extract_compute(lmp, "pe", LMP_STYLE_ATOM,
LMP_TYPE_VECTOR);
for (int i = 0; i < natoms; i++)
EXPECT_DOUBLE_EQ(f_lammps_gather_pe_atom(tag[i]), pe[i]);
};
TEST_F(LAMMPS_gather_scatter, gather_compute_concat)
{
#ifdef LAMMPS_BIGBIG
GTEST_SKIP()
#endif
f_lammps_setup_gather_scatter();
lammps_command(lmp, "run 0");
int natoms = lmp->atom->natoms;
int *tag = lmp->atom->tag;
double *pe = (double*) lammps_extract_compute(lmp, "pe", LMP_STYLE_ATOM,
LMP_TYPE_VECTOR);
for (int i = 0; i < natoms; i++)
EXPECT_DOUBLE_EQ(f_lammps_gather_pe_atom(tag[i]), pe[i]);
};
TEST_F(LAMMPS_gather_scatter, gather_compute_subset)
{
f_lammps_setup_gather_scatter();
lammps_command(lmp, "run 0");
int ids[2] = {3, 1};
int *tag = lmp->atom->tag;
double pe[2] = {0.0, 0.0};
int nlocal = lammps_extract_setting(lmp, "nlocal");
double *pa_pe = (double*) lammps_extract_compute(lmp, "pe", LMP_STYLE_ATOM,
LMP_TYPE_VECTOR);
for (int i = 0; i < nlocal; i++) {
if(tag[i] == ids[0]) pe[0] = pa_pe[i];
if(tag[i] == ids[1]) pe[1] = pa_pe[i];
}
double ftn_pe[2];
f_lammps_gather_pe_atom_subset(ids, ftn_pe);
EXPECT_DOUBLE_EQ(ftn_pe[0], pe[0]);
EXPECT_DOUBLE_EQ(ftn_pe[1], pe[1]);
};
TEST_F(LAMMPS_gather_scatter, scatter_compute)
{
#ifdef LAMMPS_BIGBIG
GTEST_SKIP();
#endif
f_lammps_setup_gather_scatter();
int natoms = lmp->atom->natoms;
double *pe = new double[natoms];
lammps_command(lmp, "run 0");
lammps_gather(lmp, "c_pe", 1, 1, pe);
double *old_pe = new double[natoms];
for (int i = 0; i < natoms; i++)
old_pe[i] = pe[i];
EXPECT_DOUBLE_EQ(pe[0], old_pe[0]);
EXPECT_DOUBLE_EQ(pe[1], old_pe[1]);
EXPECT_DOUBLE_EQ(pe[2], old_pe[2]);
f_lammps_scatter_compute();
lammps_gather(lmp, "c_pe", 1, 1, pe);
EXPECT_DOUBLE_EQ(pe[0], old_pe[2]);
EXPECT_DOUBLE_EQ(pe[1], old_pe[1]);
EXPECT_DOUBLE_EQ(pe[2], old_pe[0]);
delete[] old_pe;
delete[] pe;
};
TEST_F(LAMMPS_gather_scatter, scatter_subset_compute)
{
#ifdef LAMMPS_BIGBIG
GTEST_SKIP();
#endif
f_lammps_setup_gather_scatter();
int natoms = lmp->atom->natoms;
double *pe = new double[natoms];
lammps_command(lmp, "run 0");
lammps_gather(lmp, "c_pe", 1, 1, pe);
double *old_pe = new double[natoms];
for (int i = 0; i < natoms; i++)
old_pe[i] = pe[i];
EXPECT_DOUBLE_EQ(pe[0], old_pe[0]);
EXPECT_DOUBLE_EQ(pe[1], old_pe[1]);
EXPECT_DOUBLE_EQ(pe[2], old_pe[2]);
f_lammps_scatter_subset_compute();
lammps_gather(lmp, "c_pe", 1, 1, pe);
EXPECT_DOUBLE_EQ(pe[0], old_pe[2]);
EXPECT_DOUBLE_EQ(pe[1], old_pe[1]);
EXPECT_DOUBLE_EQ(pe[2], old_pe[0]);
delete[] old_pe;
delete[] pe;
};