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

add tests for gathering angles, dihedrals, impropers from fortran

Browse Source
This commit is contained in:
Axel Kohlmeyer
2023-02-02 20:58:47 -05:00
parent 5797ba5bcf
commit 8a0e9f6018
2 changed files with 347 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

312
unittest/fortran/test_fortran_gather_scatter.f90
View File

@ -240,15 +240,15 @@ FUNCTION f_lammps_test_gather_bonds_small() BIND(C) RESULT(count)
count = 0
DO i=1, nbonds
count = count + check_bond(i, 5, 1, 2, bonds_array)
count = count + check_bond(i, 3, 1, 3, bonds_array);
count = count + check_bond(i, 2, 3, 4, bonds_array);
count = count + check_bond(i, 2, 3, 5, bonds_array);
count = count + check_bond(i, 1, 3, 6, bonds_array);
count = count + check_bond(i, 3, 6, 8, bonds_array);
count = count + check_bond(i, 4, 6, 7, bonds_array);
count = count + check_bond(i, 5, 8, 9, bonds_array);
count = count + check_bond(i, 5, 27, 28, bonds_array);
count = count + check_bond(i, 5, 27, 29, bonds_array);
count = count + check_bond(i, 3, 1, 3, bonds_array)
count = count + check_bond(i, 2, 3, 4, bonds_array)
count = count + check_bond(i, 2, 3, 5, bonds_array)
count = count + check_bond(i, 1, 3, 6, bonds_array)
count = count + check_bond(i, 3, 6, 8, bonds_array)
count = count + check_bond(i, 4, 6, 7, bonds_array)
count = count + check_bond(i, 5, 8, 9, bonds_array)
count = count + check_bond(i, 5, 27, 28, bonds_array)
count = count + check_bond(i, 5, 27, 29, bonds_array)
END DO
CONTAINS
@ -286,15 +286,15 @@ FUNCTION f_lammps_test_gather_bonds_big() BIND(C) RESULT(count)
count = 0
DO i=1, nbonds
count = count + check_bond(i, 5, 1, 2, bonds_array)
count = count + check_bond(i, 3, 1, 3, bonds_array);
count = count + check_bond(i, 2, 3, 4, bonds_array);
count = count + check_bond(i, 2, 3, 5, bonds_array);
count = count + check_bond(i, 1, 3, 6, bonds_array);
count = count + check_bond(i, 3, 6, 8, bonds_array);
count = count + check_bond(i, 4, 6, 7, bonds_array);
count = count + check_bond(i, 5, 8, 9, bonds_array);
count = count + check_bond(i, 5, 27, 28, bonds_array);
count = count + check_bond(i, 5, 27, 29, bonds_array);
count = count + check_bond(i, 3, 1, 3, bonds_array)
count = count + check_bond(i, 2, 3, 4, bonds_array)
count = count + check_bond(i, 2, 3, 5, bonds_array)
count = count + check_bond(i, 1, 3, 6, bonds_array)
count = count + check_bond(i, 3, 6, 8, bonds_array)
count = count + check_bond(i, 4, 6, 7, bonds_array)
count = count + check_bond(i, 5, 8, 9, bonds_array)
count = count + check_bond(i, 5, 27, 28, bonds_array)
count = count + check_bond(i, 5, 27, 29, bonds_array)
END DO
CONTAINS
@ -314,6 +314,282 @@ CONTAINS
END FUNCTION f_lammps_test_gather_bonds_big
FUNCTION f_lammps_test_gather_angles_small() BIND(C) RESULT(count)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_int64_t
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER :: i, nangles, size_bigint
INTEGER(c_int) :: count
INTEGER(c_int), DIMENSION(:), ALLOCATABLE, TARGET :: angles
INTEGER(c_int), DIMENSION(:,:), POINTER :: angles_array
INTEGER(c_int), POINTER :: nangles_small
INTEGER(c_int64_t), POINTER :: nangles_big
size_bigint = lmp%extract_setting('bigint')
IF (size_bigint == 4) THEN
nangles_small = lmp%extract_global('nangles')
nangles = nangles_small
ELSE
nangles_big = lmp%extract_global('nangles')
nangles = nangles_big
END IF
CALL lmp%gather_angles(angles)
angles_array(1:4,1:SIZE(angles)/4) => angles
count = 0
DO i=1, nangles
count = count + check_angle(i, 4, 2, 1, 3, angles_array)
count = count + check_angle(i, 4, 1, 3, 5, angles_array)
count = count + check_angle(i, 4, 1, 3, 4, angles_array)
count = count + check_angle(i, 4, 13, 12, 15, angles_array)
count = count + check_angle(i, 4, 13, 12, 14, angles_array)
count = count + check_angle(i, 2, 5, 3, 6, angles_array)
count = count + check_angle(i, 2, 4, 3, 6, angles_array)
count = count + check_angle(i, 3, 3, 6, 7, angles_array)
count = count + check_angle(i, 3, 3, 6, 8, angles_array)
count = count + check_angle(i, 1, 22, 21, 23, angles_array)
END DO
CONTAINS
INTEGER FUNCTION check_angle(idx, aatom1, aatom2, aatom3, atype, aarray)
IMPLICIT NONE
INTEGER, INTENT(IN) :: idx, aatom1, aatom2, aatom3, atype
INTEGER(c_int), DIMENSION(:,:) :: aarray
check_angle = 0
IF ((aarray(1,idx) == aatom1) .AND. (aarray(2,idx) == aatom2) .AND. (aarray(3,idx) == aatom3)) THEN
IF (aarray(4,idx) == atype) check_angle = 1
END IF
IF ((aarray(1,idx) == aatom3) .AND. (aarray(2,idx) == aatom2) .AND. (aarray(3,idx) == aatom1)) THEN
IF (aarray(4,idx) == atype) check_angle = 1
END IF
END FUNCTION check_angle
END FUNCTION f_lammps_test_gather_angles_small
FUNCTION f_lammps_test_gather_angles_big() BIND(C) RESULT(count)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_int64_t
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER :: i, nangles
INTEGER(c_int) :: count
INTEGER(c_int64_t), DIMENSION(:), ALLOCATABLE, TARGET :: angles
INTEGER(c_int64_t), DIMENSION(:,:), POINTER :: angles_array
INTEGER(c_int64_t), POINTER :: nangles_big
nangles_big = lmp%extract_global('nangles')
nangles = nangles_big
CALL lmp%gather_angles(angles)
angles_array(1:4,1:SIZE(angles)/4) => angles
count = 0
DO i=1, nangles
count = count + check_angle(i, 4, 2, 1, 3, angles_array)
count = count + check_angle(i, 4, 1, 3, 5, angles_array)
count = count + check_angle(i, 4, 1, 3, 4, angles_array)
count = count + check_angle(i, 4, 13, 12, 15, angles_array)
count = count + check_angle(i, 4, 13, 12, 14, angles_array)
count = count + check_angle(i, 2, 5, 3, 6, angles_array)
count = count + check_angle(i, 2, 4, 3, 6, angles_array)
count = count + check_angle(i, 3, 3, 6, 7, angles_array)
count = count + check_angle(i, 3, 3, 6, 8, angles_array)
count = count + check_angle(i, 1, 22, 21, 23, angles_array)
END DO
CONTAINS
INTEGER FUNCTION check_angle(idx, aatom1, aatom2, aatom3, atype, aarray)
IMPLICIT NONE
INTEGER, INTENT(IN) :: idx, aatom1, aatom2, aatom3, atype
INTEGER(c_int64_t), DIMENSION(:,:) :: aarray
check_angle = 0
IF ((aarray(1,idx) == aatom1) .AND. (aarray(2,idx) == aatom2) .AND. (aarray(3,idx) == aatom3)) THEN
IF (aarray(4,idx) == atype) check_angle = 1
END IF
IF ((aarray(1,idx) == aatom3) .AND. (aarray(2,idx) == aatom2) .AND. (aarray(3,idx) == aatom1)) THEN
IF (aarray(4,idx) == atype) check_angle = 1
END IF
END FUNCTION check_angle
END FUNCTION f_lammps_test_gather_angles_big
FUNCTION f_lammps_test_gather_dihedrals_small() BIND(C) RESULT(count)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_int64_t
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER :: i, ndihedrals, size_bigint
INTEGER(c_int) :: count
INTEGER(c_int), DIMENSION(:), ALLOCATABLE, TARGET :: dihedrals
INTEGER(c_int), DIMENSION(:,:), POINTER :: dihedrals_array
INTEGER(c_int), POINTER :: ndihedrals_small
INTEGER(c_int64_t), POINTER :: ndihedrals_big
size_bigint = lmp%extract_setting('bigint')
IF (size_bigint == 4) THEN
ndihedrals_small = lmp%extract_global('ndihedrals')
ndihedrals = ndihedrals_small
ELSE
ndihedrals_big = lmp%extract_global('ndihedrals')
ndihedrals = ndihedrals_big
END IF
CALL lmp%gather_dihedrals(dihedrals)
dihedrals_array(1:5,1:SIZE(dihedrals)/5) => dihedrals
count = 0
DO i=1, ndihedrals
count = count + check_dihedral(i, 2, 2, 1, 3, 6, dihedrals_array)
count = count + check_dihedral(i, 2, 2, 1, 3, 4, dihedrals_array)
count = count + check_dihedral(i, 3, 2, 1, 3, 5, dihedrals_array)
count = count + check_dihedral(i, 1, 1, 3, 6, 8, dihedrals_array)
count = count + check_dihedral(i, 1, 1, 3, 6, 7, dihedrals_array)
count = count + check_dihedral(i, 5, 4, 3, 6, 8, dihedrals_array)
count = count + check_dihedral(i, 5, 4, 3, 6, 7, dihedrals_array)
count = count + check_dihedral(i, 5, 16, 10, 12, 13, dihedrals_array)
count = count + check_dihedral(i, 5, 16, 10, 12, 14, dihedrals_array)
count = count + check_dihedral(i, 5, 16, 10, 12, 15, dihedrals_array)
END DO
CONTAINS
INTEGER FUNCTION check_dihedral(idx, datom1, datom2, datom3, datom4, dtype, darray)
IMPLICIT NONE
INTEGER, INTENT(IN) :: idx, datom1, datom2, datom3, datom4, dtype
INTEGER(c_int), DIMENSION(:,:) :: darray
check_dihedral = 0
IF ((darray(1,idx) == datom1) .AND. (darray(2,idx) == datom2) &
.AND. (darray(3,idx) == datom3) .AND. (darray(4,idx) == datom4)) THEN
IF (darray(5,idx) == dtype) check_dihedral = 1
END IF
END FUNCTION check_dihedral
END FUNCTION f_lammps_test_gather_dihedrals_small
FUNCTION f_lammps_test_gather_dihedrals_big() BIND(C) RESULT(count)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_int64_t
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER :: i, ndihedrals
INTEGER(c_int) :: count
INTEGER(c_int64_t), DIMENSION(:), ALLOCATABLE, TARGET :: dihedrals
INTEGER(c_int64_t), DIMENSION(:,:), POINTER :: dihedrals_array
INTEGER(c_int64_t), POINTER :: ndihedrals_big
ndihedrals_big = lmp%extract_global('ndihedrals')
ndihedrals = ndihedrals_big
CALL lmp%gather_dihedrals(dihedrals)
dihedrals_array(1:5,1:SIZE(dihedrals)/5) => dihedrals
count = 0
DO i=1, ndihedrals
count = count + check_dihedral(i, 2, 2, 1, 3, 6, dihedrals_array)
count = count + check_dihedral(i, 2, 2, 1, 3, 4, dihedrals_array)
count = count + check_dihedral(i, 3, 2, 1, 3, 5, dihedrals_array)
count = count + check_dihedral(i, 1, 1, 3, 6, 8, dihedrals_array)
count = count + check_dihedral(i, 1, 1, 3, 6, 7, dihedrals_array)
count = count + check_dihedral(i, 5, 4, 3, 6, 8, dihedrals_array)
count = count + check_dihedral(i, 5, 4, 3, 6, 7, dihedrals_array)
count = count + check_dihedral(i, 5, 16, 10, 12, 13, dihedrals_array)
count = count + check_dihedral(i, 5, 16, 10, 12, 14, dihedrals_array)
count = count + check_dihedral(i, 5, 16, 10, 12, 15, dihedrals_array)
END DO
CONTAINS
INTEGER FUNCTION check_dihedral(idx, datom1, datom2, datom3, datom4, dtype, darray)
IMPLICIT NONE
INTEGER, INTENT(IN) :: idx, datom1, datom2, datom3, datom4, dtype
INTEGER(c_int64_t), DIMENSION(:,:) :: darray
check_dihedral = 0
IF ((darray(1,idx) == datom1) .AND. (darray(2,idx) == datom2) &
.AND. (darray(3,idx) == datom3) .AND. (darray(4,idx) == datom4)) THEN
IF (darray(5,idx) == dtype) check_dihedral = 1
END IF
END FUNCTION check_dihedral
END FUNCTION f_lammps_test_gather_dihedrals_big
FUNCTION f_lammps_test_gather_impropers_small() BIND(C) RESULT(count)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_int64_t
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER :: i, nimpropers, size_bigint
INTEGER(c_int) :: count
INTEGER(c_int), DIMENSION(:), ALLOCATABLE, TARGET :: impropers
INTEGER(c_int), DIMENSION(:,:), POINTER :: impropers_array
INTEGER(c_int), POINTER :: nimpropers_small
INTEGER(c_int64_t), POINTER :: nimpropers_big
size_bigint = lmp%extract_setting('bigint')
IF (size_bigint == 4) THEN
nimpropers_small = lmp%extract_global('nimpropers')
nimpropers = nimpropers_small
ELSE
nimpropers_big = lmp%extract_global('nimpropers')
nimpropers = nimpropers_big
END IF
CALL lmp%gather_impropers(impropers)
impropers_array(1:5,1:SIZE(impropers)/5) => impropers
count = 0
DO i=1, nimpropers
count = count + check_improper(i, 1, 6, 3, 8, 7, impropers_array)
count = count + check_improper(i, 2, 8, 6, 10, 9, impropers_array)
END DO
CONTAINS
INTEGER FUNCTION check_improper(idx, datom1, datom2, datom3, datom4, dtype, darray)
IMPLICIT NONE
INTEGER, INTENT(IN) :: idx, datom1, datom2, datom3, datom4, dtype
INTEGER(c_int), DIMENSION(:,:) :: darray
check_improper = 0
IF ((darray(1,idx) == datom1) .AND. (darray(2,idx) == datom2) &
.AND. (darray(3,idx) == datom3) .AND. (darray(4,idx) == datom4)) THEN
IF (darray(5,idx) == dtype) check_improper = 1
END IF
END FUNCTION check_improper
END FUNCTION f_lammps_test_gather_impropers_small
FUNCTION f_lammps_test_gather_impropers_big() BIND(C) RESULT(count)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_int64_t
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER :: i, nimpropers
INTEGER(c_int) :: count
INTEGER(c_int64_t), DIMENSION(:), ALLOCATABLE, TARGET :: impropers
INTEGER(c_int64_t), DIMENSION(:,:), POINTER :: impropers_array
INTEGER(c_int64_t), POINTER :: nimpropers_big
nimpropers_big = lmp%extract_global('nimpropers')
nimpropers = nimpropers_big
CALL lmp%gather_impropers(impropers)
impropers_array(1:5,1:SIZE(impropers)/5) => impropers
count = 0
DO i=1, nimpropers
count = count + check_improper(i, 1, 6, 3, 8, 7, impropers_array)
count = count + check_improper(i, 2, 8, 6, 10, 9, impropers_array)
END DO
CONTAINS
INTEGER FUNCTION check_improper(idx, datom1, datom2, datom3, datom4, dtype, darray)
IMPLICIT NONE
INTEGER, INTENT(IN) :: idx, datom1, datom2, datom3, datom4, dtype
INTEGER(c_int64_t), DIMENSION(:,:) :: darray
check_improper = 0
IF ((darray(1,idx) == datom1) .AND. (darray(2,idx) == datom2) &
.AND. (darray(3,idx) == datom3) .AND. (darray(4,idx) == datom4)) THEN
IF (darray(5,idx) == dtype) check_improper = 1
END IF
END FUNCTION check_improper
END FUNCTION f_lammps_test_gather_impropers_big
FUNCTION f_lammps_gather_pe_atom(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS

48
unittest/fortran/wrap_gather_scatter.cpp
View File

@ -32,6 +32,12 @@ void f_lammps_scatter_atoms_positions();
void f_lammps_setup_gather_topology();
int f_lammps_test_gather_bonds_small();
int f_lammps_test_gather_bonds_big();
int f_lammps_test_gather_angles_small();
int f_lammps_test_gather_angles_big();
int f_lammps_test_gather_dihedrals_small();
int f_lammps_test_gather_dihedrals_big();
int f_lammps_test_gather_impropers_small();
int f_lammps_test_gather_impropers_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 *);
@ -229,6 +235,39 @@ TEST_F(LAMMPS_gather_scatter, gather_bonds)
#endif
};
TEST_F(LAMMPS_gather_scatter, gather_angles)
{
if (!lammps_has_style(lmp, "atom", "full")) GTEST_SKIP();
f_lammps_setup_gather_topology();
#ifdef LAMMPS_BIGBIG
EXPECT_EQ(f_lammps_test_gather_angles_big(), 10);
#else
EXPECT_EQ(f_lammps_test_gather_angles_small(), 10);
#endif
};
TEST_F(LAMMPS_gather_scatter, gather_dihedrals)
{
if (!lammps_has_style(lmp, "atom", "full")) GTEST_SKIP();
f_lammps_setup_gather_topology();
#ifdef LAMMPS_BIGBIG
EXPECT_EQ(f_lammps_test_gather_dihedrals_big(), 10);
#else
EXPECT_EQ(f_lammps_test_gather_dihedrals_small(), 10);
#endif
};
TEST_F(LAMMPS_gather_scatter, gather_impropers)
{
if (!lammps_has_style(lmp, "atom", "full")) GTEST_SKIP();
f_lammps_setup_gather_topology();
#ifdef LAMMPS_BIGBIG
EXPECT_EQ(f_lammps_test_gather_impropers_big(), 2);
#else
EXPECT_EQ(f_lammps_test_gather_impropers_small(), 2);
#endif
};
TEST_F(LAMMPS_gather_scatter, gather_compute)
{
#ifdef LAMMPS_BIGBIG
@ -238,8 +277,7 @@ TEST_F(LAMMPS_gather_scatter, gather_compute)
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);
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]);
#endif
@ -254,8 +292,7 @@ TEST_F(LAMMPS_gather_scatter, gather_compute_concat)
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);
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]);
#endif
@ -272,8 +309,7 @@ TEST_F(LAMMPS_gather_scatter, gather_compute_subset)
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);
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];