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

convert Fortran version of lammps_gather_bonds() test to be similar to C version

Browse Source
This commit is contained in:
Axel Kohlmeyer
2023-02-02 19:10:51 -05:00
parent 5cf1bbff7c
commit 5797ba5bcf
2 changed files with 86 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

117
unittest/fortran/test_fortran_gather_scatter.f90
View File

@ -205,66 +205,113 @@ SUBROUTINE f_lammps_scatter_atoms_subset_mask() BIND(C)
CALL lmp%scatter_atoms_subset('mask', tags, masks) ! push the swap to LAMMPS CALL lmp%scatter_atoms_subset('mask', tags, masks) ! push the swap to LAMMPS
END SUBROUTINE f_lammps_scatter_atoms_subset_mask END SUBROUTINE f_lammps_scatter_atoms_subset_mask
SUBROUTINE f_lammps_setup_gather_bonds() BIND(C) SUBROUTINE f_lammps_setup_gather_topology() BIND(C)
USE LIBLAMMPS USE LIBLAMMPS
USE keepstuff, ONLY : lmp, cont_input, more_input, pair_input USE keepstuff, ONLY : lmp, cont_input, more_input, pair_input
IMPLICIT NONE IMPLICIT NONE
INTERFACE CALL lmp%command('include ${input_dir}/in.fourmol')
SUBROUTINE f_lammps_setup_gather_scatter() BIND(C) CALL lmp%command('run 0 post no')
END SUBROUTINE f_lammps_setup_gather_scatter END SUBROUTINE f_lammps_setup_gather_topology
END INTERFACE
CALL lmp%command('atom_modify map array') FUNCTION f_lammps_test_gather_bonds_small() BIND(C) RESULT(count)
CALL lmp%command('atom_style full')
CALL lmp%command('region simbox block 0 4 0 5 0 4')
CALL lmp%command('create_box 1 simbox bond/types 1 extra/bond/per/atom 2')
CALL lmp%command('create_atoms 1 single 1.0 1.0 ${zpos}')
CALL lmp%commands_list(cont_input)
CALL lmp%commands_list(more_input)
CALL lmp%commands_list(pair_input)
CALL lmp%command('bond_style zero')
CALL lmp%command('bond_coeff *')
CALL lmp%command('create_bonds many all all 1 0.0 1.5')
CALL lmp%command('run 0')
END SUBROUTINE f_lammps_setup_gather_bonds
FUNCTION f_lammps_test_gather_bonds_small() BIND(C) RESULT(success)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_int64_t USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_int64_t
USE LIBLAMMPS USE LIBLAMMPS
USE keepstuff, ONLY : lmp USE keepstuff, ONLY : lmp
IMPLICIT NONE IMPLICIT NONE
INTEGER(c_int) :: success INTEGER :: i, nbonds, size_bigint
INTEGER(c_int) :: count
INTEGER(c_int), DIMENSION(:), ALLOCATABLE, TARGET :: bonds INTEGER(c_int), DIMENSION(:), ALLOCATABLE, TARGET :: bonds
INTEGER(c_int), DIMENSION(:,:), POINTER :: bonds_array INTEGER(c_int), DIMENSION(:,:), POINTER :: bonds_array
INTEGER(c_int), POINTER :: nbonds_small
INTEGER(c_int64_t), POINTER :: nbonds_big
size_bigint = lmp%extract_setting('bigint')
IF (size_bigint == 4) THEN
nbonds_small = lmp%extract_global('nbonds')
nbonds = nbonds_small
ELSE
nbonds_big = lmp%extract_global('nbonds')
nbonds = nbonds_big
END IF
CALL lmp%gather_bonds(bonds) CALL lmp%gather_bonds(bonds)
bonds_array(1:3,1:SIZE(bonds)/3) => bonds bonds_array(1:3,1:SIZE(bonds)/3) => bonds
IF ( ALL(bonds_array(:,1) == [INTEGER(c_int) :: 1,1,3]) & count = 0
.AND. ALL(bonds_array(:,2) == [INTEGER(c_int) :: 1,2,3])) THEN DO i=1, nbonds
success = 1_c_int count = count + check_bond(i, 5, 1, 2, bonds_array)
ELSE count = count + check_bond(i, 3, 1, 3, bonds_array);
success = 0_c_int count = count + check_bond(i, 2, 3, 4, bonds_array);
END IF 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
INTEGER FUNCTION check_bond(idx, batom1, batom2, btype, barray)
IMPLICIT NONE
INTEGER, INTENT(IN) :: idx, batom1, batom2, btype
INTEGER(c_int), DIMENSION(:,:) :: barray
check_bond = 0
IF ((barray(1,idx) == batom1) .AND. (barray(2,idx) == batom2)) THEN
IF (barray(3,idx) == btype) check_bond = 1
END IF
IF ((barray(1,idx) == batom2) .AND. (barray(2,idx) == batom1)) THEN
IF (barray(3,idx) == btype) check_bond = 1
END IF
END FUNCTION check_bond
END FUNCTION f_lammps_test_gather_bonds_small END FUNCTION f_lammps_test_gather_bonds_small
FUNCTION f_lammps_test_gather_bonds_big() BIND(C) RESULT(success) FUNCTION f_lammps_test_gather_bonds_big() BIND(C) RESULT(count)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_int64_t USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_int64_t
USE LIBLAMMPS USE LIBLAMMPS
USE keepstuff, ONLY : lmp USE keepstuff, ONLY : lmp
IMPLICIT NONE IMPLICIT NONE
INTEGER(c_int) :: success INTEGER :: i, nbonds
INTEGER(c_int) :: count
INTEGER(c_int64_t), DIMENSION(:), ALLOCATABLE, TARGET :: bonds INTEGER(c_int64_t), DIMENSION(:), ALLOCATABLE, TARGET :: bonds
INTEGER(c_int64_t), DIMENSION(:,:), POINTER :: bonds_array INTEGER(c_int64_t), DIMENSION(:,:), POINTER :: bonds_array
INTEGER(c_int64_t), POINTER :: nbonds_big
nbonds_big = lmp%extract_global('nbonds')
nbonds = nbonds_big
CALL lmp%gather_bonds(bonds) CALL lmp%gather_bonds(bonds)
bonds_array(1:3,1:SIZE(bonds)/3) => bonds bonds_array(1:3,1:SIZE(bonds)/3) => bonds
IF ( ALL(bonds_array(:,1) == [INTEGER(c_int64_t) :: 1,1,3]) & count = 0
.AND. ALL(bonds_array(:,2) == [INTEGER(c_int64_t) :: 1,2,3])) THEN DO i=1, nbonds
success = 1_c_int count = count + check_bond(i, 5, 1, 2, bonds_array)
ELSE count = count + check_bond(i, 3, 1, 3, bonds_array);
success = 0_c_int count = count + check_bond(i, 2, 3, 4, bonds_array);
END IF 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
INTEGER FUNCTION check_bond(idx, batom1, batom2, btype, barray)
IMPLICIT NONE
INTEGER, INTENT(IN) :: idx, batom1, batom2, btype
INTEGER(c_int64_t), DIMENSION(:,:) :: barray
check_bond = 0
IF ((barray(1,idx) == batom1) .AND. (barray(2,idx) == batom2)) THEN
IF (barray(3,idx) == btype) check_bond = 1
END IF
IF ((barray(1,idx) == batom2) .AND. (barray(2,idx) == batom1)) THEN
IF (barray(3,idx) == btype) check_bond = 1
END IF
END FUNCTION check_bond
END FUNCTION f_lammps_test_gather_bonds_big END FUNCTION f_lammps_test_gather_bonds_big
FUNCTION f_lammps_gather_pe_atom(i) BIND(C) FUNCTION f_lammps_gather_pe_atom(i) BIND(C)

8
unittest/fortran/wrap_gather_scatter.cpp
View File

@ -29,7 +29,7 @@ int f_lammps_gather_atoms_subset_mask(int);
double f_lammps_gather_atoms_subset_position(int, int); double f_lammps_gather_atoms_subset_position(int, int);
void f_lammps_scatter_atoms_masks(); void f_lammps_scatter_atoms_masks();
void f_lammps_scatter_atoms_positions(); void f_lammps_scatter_atoms_positions();
void f_lammps_setup_gather_bonds(); void f_lammps_setup_gather_topology();
int f_lammps_test_gather_bonds_small(); int f_lammps_test_gather_bonds_small();
int f_lammps_test_gather_bonds_big(); int f_lammps_test_gather_bonds_big();
double f_lammps_gather_pe_atom(int); double f_lammps_gather_pe_atom(int);
@ -221,11 +221,11 @@ TEST_F(LAMMPS_gather_scatter, scatter_atoms_subset_mask)
TEST_F(LAMMPS_gather_scatter, gather_bonds) TEST_F(LAMMPS_gather_scatter, gather_bonds)
{ {
if (!lammps_has_style(lmp, "atom", "full")) GTEST_SKIP(); if (!lammps_has_style(lmp, "atom", "full")) GTEST_SKIP();
f_lammps_setup_gather_bonds(); f_lammps_setup_gather_topology();
#ifdef LAMMPS_BIGBIG #ifdef LAMMPS_BIGBIG
EXPECT_EQ(f_lammps_test_gather_bonds_big(), 1); EXPECT_EQ(f_lammps_test_gather_bonds_big(), 10);
#else #else
EXPECT_EQ(f_lammps_test_gather_bonds_small(), 1); EXPECT_EQ(f_lammps_test_gather_bonds_small(), 10);
#endif #endif
}; };