convert Fortran version of lammps_gather_bonds() test to be similar to C version
This commit is contained in:
Axel Kohlmeyer
@ -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
|
||||
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 keepstuff, ONLY : lmp, cont_input, more_input, pair_input
|
||||
IMPLICIT NONE
|
||||
|
||||
INTERFACE
|
||||
SUBROUTINE f_lammps_setup_gather_scatter() BIND(C)
|
||||
END SUBROUTINE f_lammps_setup_gather_scatter
|
||||
END INTERFACE
|
||||
CALL lmp%command('include ${input_dir}/in.fourmol')
|
||||
CALL lmp%command('run 0 post no')
|
||||
END SUBROUTINE f_lammps_setup_gather_topology
|
||||
|
||||
CALL lmp%command('atom_modify map array')
|
||||
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)
|
||||
FUNCTION f_lammps_test_gather_bonds_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(c_int) :: success
|
||||
INTEGER :: i, nbonds, size_bigint
|
||||
INTEGER(c_int) :: count
|
||||
INTEGER(c_int), DIMENSION(:), ALLOCATABLE, TARGET :: bonds
|
||||
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)
|
||||
bonds_array(1:3,1:SIZE(bonds)/3) => bonds
|
||||
IF ( ALL(bonds_array(:,1) == [INTEGER(c_int) :: 1,1,3]) &
|
||||
.AND. ALL(bonds_array(:,2) == [INTEGER(c_int) :: 1,2,3])) THEN
|
||||
success = 1_c_int
|
||||
ELSE
|
||||
success = 0_c_int
|
||||
END IF
|
||||
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);
|
||||
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
|
||||
|
||||
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 LIBLAMMPS
|
||||
USE keepstuff, ONLY : lmp
|
||||
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(:,:), POINTER :: bonds_array
|
||||
INTEGER(c_int64_t), POINTER :: nbonds_big
|
||||
|
||||
nbonds_big = lmp%extract_global('nbonds')
|
||||
nbonds = nbonds_big
|
||||
CALL lmp%gather_bonds(bonds)
|
||||
bonds_array(1:3,1:SIZE(bonds)/3) => bonds
|
||||
IF ( ALL(bonds_array(:,1) == [INTEGER(c_int64_t) :: 1,1,3]) &
|
||||
.AND. ALL(bonds_array(:,2) == [INTEGER(c_int64_t) :: 1,2,3])) THEN
|
||||
success = 1_c_int
|
||||
ELSE
|
||||
success = 0_c_int
|
||||
END IF
|
||||
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);
|
||||
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
|
||||
|
||||
FUNCTION f_lammps_gather_pe_atom(i) BIND(C)
|
||||
|
||||
@ -29,7 +29,7 @@ int f_lammps_gather_atoms_subset_mask(int);
|
||||
double f_lammps_gather_atoms_subset_position(int, int);
|
||||
void f_lammps_scatter_atoms_masks();
|
||||
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_big();
|
||||
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)
|
||||
{
|
||||
if (!lammps_has_style(lmp, "atom", "full")) GTEST_SKIP();
|
||||
f_lammps_setup_gather_bonds();
|
||||
f_lammps_setup_gather_topology();
|
||||
#ifdef LAMMPS_BIGBIG
|
||||
EXPECT_EQ(f_lammps_test_gather_bonds_big(), 1);
|
||||
EXPECT_EQ(f_lammps_test_gather_bonds_big(), 10);
|
||||
#else
|
||||
EXPECT_EQ(f_lammps_test_gather_bonds_small(), 1);
|
||||
EXPECT_EQ(f_lammps_test_gather_bonds_small(), 10);
|
||||
#endif
|
||||
};
|
||||
|
||||
|
||||
Reference in New Issue
Block a user